Skip to content

Commit f6d33bd

Browse files
bobzhangbobzhang
committed
Fix regression of genType.import && add better stack trace support in the compiler debug mode
1 parent bc9c87c commit f6d33bd

26 files changed

+796
-875
lines changed

‎jscomp/build_tests/case3/.gitignore

+2-1
Original file line numberDiff line numberDiff line change
@@ -23,4 +23,5 @@ lib/bs
2323
*.mliast
2424
.vscode
2525
.merlin
26-
.bsb.lock
26+
.bsb.lock
27+
*.bs.js

‎jscomp/build_tests/case3/input.js

+14-1
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,16 @@
1+
//@ts-check
2+
13
var p = require("child_process");
4+
var fs = require("fs");
5+
var path = require("path");
6+
var assert = require("assert");
7+
p.spawnSync(`bsb`, {
8+
encoding: "utf8",
9+
cwd: __dirname,
10+
stdio: [0, 1, 2]
11+
});
12+
13+
var o = fs.readFileSync(path.join(__dirname, "src", "hello.bs.js"), "ascii");
14+
assert.ok(/HelloGen.f/.test(o))
15+
216

3-
var o = p.spawnSync(`bsb`, { encoding: "utf8", cwd: __dirname });

‎jscomp/build_tests/case3/src/hello.re

+3
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
2+
[@genType.import "hh"]
3+
external f : int => int = "f";

‎jscomp/build_tests/hyphen2/input.js

+1-1
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,3 @@
11
var p = require('child_process')
22

3-
p.execSync(`bsb`)
3+
p.execSync(`bsb`,{cwd:__dirname,stdio:[0,1,2]})

‎jscomp/common/bs_warnings.ml

+1-2
Original file line numberDiff line numberDiff line change
@@ -43,8 +43,7 @@ let warning_formatter = Format.err_formatter
4343

4444
let print_string_warning (loc : Location.t) x =
4545
if loc.loc_ghost then
46-
Format.fprintf warning_formatter "File %s@."
47-
(Js_config.get_current_file ())
46+
Format.fprintf warning_formatter "File %s@." !Location.input_name
4847
else
4948
Location.print warning_formatter loc ;
5049
Format.fprintf warning_formatter "@{<error>Warning@}: %s@." x

‎jscomp/common/js_config.ml

+2-7
Original file line numberDiff line numberDiff line change
@@ -71,19 +71,14 @@ let no_builtin_ppx_mli = ref false
7171

7272
(** TODO: will flip the option when it is ready *)
7373
let no_warn_unimplemented_external = ref false
74-
let current_file = ref ""
74+
7575
let debug_file = ref ""
7676

77-
let set_current_file f = current_file := f
78-
let get_current_file () = !current_file
7977

80-
let iset_debug_file _ = ()
8178
let set_debug_file f = debug_file := f
82-
let get_debug_file () = !debug_file
83-
8479

8580
let is_same_file () =
86-
!debug_file <> "" && !debug_file = !current_file
81+
!debug_file <> "" && !debug_file = !Location.input_name
8782

8883
let tool_name = "BuckleScript"
8984

‎jscomp/common/js_config.mli

+2-5
Original file line numberDiff line numberDiff line change
@@ -73,14 +73,11 @@ val get_check_div_by_zero : unit -> bool
7373

7474

7575

76-
(** Debugging utilies *)
77-
val set_current_file : string -> unit
78-
val get_current_file : unit -> string
7976

8077

81-
val iset_debug_file : string -> unit
78+
8279
val set_debug_file : string -> unit
83-
val get_debug_file : unit -> string
80+
8481

8582
val is_same_file : unit -> bool
8683

‎jscomp/core/bs_conditional_initial.ml

+2-2
Original file line numberDiff line numberDiff line change
@@ -25,9 +25,9 @@
2525

2626
let setup_env () =
2727
#if undefined BS_RELEASE_BUILD then
28+
Printexc.record_backtrace true;
2829
(match Ext_sys.getenv_opt "BS_DEBUG_FILE" with
29-
| None ->
30-
Js_config.set_debug_file "caml_obj.ml"
30+
| None -> ()
3131
| Some s ->
3232
Js_config.set_debug_file s
3333
);

‎jscomp/core/js_cmj_load.ml

+1-1
Original file line numberDiff line numberDiff line change
@@ -43,7 +43,7 @@ let find_cmj file : string * Js_cmj_format.t =
4343
| exception _
4444
->
4545
Ext_log.warn __LOC__
46-
"@[%s corrupted in database, when looking %s while compiling %s please update @]" file target (Js_config.get_current_file ()) ;
46+
"@[%s corrupted in database, when looking %s while compiling %s please update @]" file target !Location.input_name ;
4747
Js_cmj_format.no_pure_dummy; (* FIXME *)
4848
| v -> v
4949
(* see {!Js_packages_info.string_of_module_id} *)

‎jscomp/core/js_implementation.ml

+19-40
Original file line numberDiff line numberDiff line change
@@ -28,12 +28,12 @@ let print_if ppf flag printer arg =
2828

2929

3030

31-
let after_parsing_sig ppf sourcefile outputprefix ast =
31+
let after_parsing_sig ppf outputprefix ast =
3232
if !Js_config.binary_ast then
3333
begin
3434
Binary_ast.write_ast
3535
Mli
36-
~fname:sourcefile
36+
~sourcefile:!Location.input_name
3737
~output:(outputprefix ^ if !Js_config.is_reason then Literals.suffix_reiast else Literals.suffix_mliast)
3838
(* to support relocate to another directory *)
3939
ast
@@ -46,7 +46,7 @@ let after_parsing_sig ppf sourcefile outputprefix ast =
4646

4747
if Js_config.get_diagnose () then
4848
Format.fprintf Format.err_formatter "Building %s@." !Location.input_name;
49-
let modulename = module_of_filename ppf sourcefile outputprefix in
49+
let modulename = module_of_filename ppf !Location.input_name outputprefix in
5050
Lam_compile_env.reset () ;
5151
let initial_env = Compmisc.initial_env () in
5252
Env.set_unit_name modulename;
@@ -74,30 +74,28 @@ let after_parsing_sig ppf sourcefile outputprefix ast =
7474
#else
7575
let sg = Env.save_signature ?check_exists:(if !Js_config.force_cmi then None else Some ()) sg modulename (outputprefix ^ ".cmi") in
7676
#end
77-
Typemod.save_signature modulename tsg outputprefix sourcefile
77+
Typemod.save_signature modulename tsg outputprefix !Location.input_name
7878
initial_env sg ;
7979
end
8080
end
8181
let interface ppf sourcefile outputprefix =
82-
Js_config.set_current_file sourcefile ;
8382
Compmisc.init_path false;
8483
Ocaml_parse.parse_interface ppf sourcefile
8584
|> print_if ppf Clflags.dump_parsetree Printast.interface
8685
|> print_if ppf Clflags.dump_source Pprintast.signature
87-
|> after_parsing_sig ppf sourcefile outputprefix
86+
|> after_parsing_sig ppf outputprefix
8887

89-
let interface_mliast ppf sourcefile outputprefix =
90-
Js_config.set_current_file sourcefile ;
88+
let interface_mliast ppf fname outputprefix =
9189
Compmisc.init_path false;
92-
Binary_ast.read_ast Mli sourcefile
90+
Binary_ast.read_ast Mli fname
9391
|> print_if ppf Clflags.dump_parsetree Printast.interface
9492
|> print_if ppf Clflags.dump_source Pprintast.signature
95-
|> after_parsing_sig ppf sourcefile outputprefix
93+
|> after_parsing_sig ppf outputprefix
9694

97-
let after_parsing_impl ppf sourcefile outputprefix ast =
95+
let after_parsing_impl ppf outputprefix ast =
9896

9997
if !Js_config.binary_ast then
100-
Binary_ast.write_ast ~fname:sourcefile
98+
Binary_ast.write_ast ~sourcefile:!Location.input_name
10199
Ml ~output:(outputprefix ^
102100
if !Js_config.is_reason then Literals.suffix_reast else Literals.suffix_mlast
103101
)
@@ -109,14 +107,14 @@ let after_parsing_impl ppf sourcefile outputprefix ast =
109107

110108
if Js_config.get_diagnose () then
111109
Format.fprintf Format.err_formatter "Building %s@." !Location.input_name;
112-
let modulename = Compenv.module_of_filename ppf sourcefile outputprefix in
110+
let modulename = Compenv.module_of_filename ppf !Location.input_name outputprefix in
113111
Lam_compile_env.reset () ;
114112
let env = Compmisc.initial_env() in
115113
Env.set_unit_name modulename;
116-
try
114+
117115
let (typedtree, coercion, finalenv, current_signature) =
118116
ast
119-
|> Typemod.type_implementation_more ?check_exists:(if !Js_config.force_cmi then None else Some ()) sourcefile outputprefix modulename env
117+
|> Typemod.type_implementation_more ?check_exists:(if !Js_config.force_cmi then None else Some ()) !Location.input_name outputprefix modulename env
120118
|> print_if ppf Clflags.dump_typedtree
121119
(fun fmt (ty,co,_,_) -> Printtyped.implementation_with_coercion fmt (ty,co))
122120
in
@@ -134,46 +132,27 @@ let after_parsing_impl ppf sourcefile outputprefix ast =
134132
#end
135133
->
136134
ignore (print_if ppf Clflags.dump_rawlambda Printlambda.lambda lambda);
137-
try
138135
Lam_compile_main.lambda_as_module
139136
finalenv
140-
outputprefix lambda with
141-
| e ->
142-
(* Save to a file instead so that it will not scare user *)
143-
(if Js_config.get_diagnose () then
144-
begin
145-
let file = "bsc.dump" in
146-
Ext_pervasives.with_file_as_chan file
147-
(fun ch -> output_string ch @@
148-
Printexc.raw_backtrace_to_string (Printexc.get_raw_backtrace ()));
149-
Ext_log.err __LOC__
150-
"Compilation fatal error, stacktrace saved into %s when compiling %s"
151-
file sourcefile;
152-
end;
153-
raise e)
137+
outputprefix lambda
154138
);
155139

156140
end;
157141
Stypes.dump (Some (outputprefix ^ ".annot"));
158-
with x ->
159-
Stypes.dump (Some (outputprefix ^ ".annot"));
160-
raise x
161142
end
162143
let implementation ppf sourcefile outputprefix =
163144
Compmisc.init_path false;
164-
Js_config.set_current_file sourcefile ;
165145
Ocaml_parse.parse_implementation ppf sourcefile
166146
|> print_if ppf Clflags.dump_parsetree Printast.implementation
167147
|> print_if ppf Clflags.dump_source Pprintast.structure
168-
|> after_parsing_impl ppf sourcefile outputprefix
148+
|> after_parsing_impl ppf outputprefix
169149

170-
let implementation_mlast ppf sourcefile outputprefix =
150+
let implementation_mlast ppf fname outputprefix =
171151
Compmisc.init_path false;
172-
Js_config.set_current_file sourcefile ;
173-
Binary_ast.read_ast Ml sourcefile
152+
Binary_ast.read_ast Ml fname
174153
|> print_if ppf Clflags.dump_parsetree Printast.implementation
175154
|> print_if ppf Clflags.dump_source Pprintast.structure
176-
|> after_parsing_impl ppf sourcefile outputprefix
155+
|> after_parsing_impl ppf outputprefix
177156

178157

179158

@@ -209,5 +188,5 @@ let implementation_map ppf sourcefile outputprefix =
209188
ml_ast
210189
|> print_if ppf Clflags.dump_parsetree Printast.implementation
211190
|> print_if ppf Clflags.dump_source Pprintast.structure
212-
|> after_parsing_impl ppf sourcefile outputprefix
191+
|> after_parsing_impl ppf outputprefix
213192

‎jscomp/core/js_implementation.mli

+7-2
Original file line numberDiff line numberDiff line change
@@ -39,11 +39,16 @@ val interface : Format.formatter -> string -> string -> unit
3939

4040
val interface_mliast : Format.formatter -> string -> string -> unit
4141

42-
val after_parsing_sig : Format.formatter -> string -> string -> Parsetree.signature -> unit
4342

44-
val after_parsing_impl : Format.formatter -> string -> string -> Parsetree.structure -> unit
43+
44+
val after_parsing_impl :
45+
Format.formatter ->
46+
string ->
47+
Parsetree.structure ->
48+
unit
4549
(** [after_parsing_impl ppf sourcefile outputprefix ast ]
4650
Make sure you need run {!Compmisc.init_path} for set up
51+
Used in eval
4752
*)
4853

4954
val implementation : Format.formatter -> string -> string -> unit

‎jscomp/core/js_pass_debug.ml

+1-1
Original file line numberDiff line numberDiff line change
@@ -41,7 +41,7 @@ let dump name (prog : J.program) =
4141
incr log_counter ;
4242
Ext_log.dwarn ~__POS__ "\n@[[TIME:]%s: %f@]@." name (Sys.time () *. 1000.);
4343
Ext_pervasives.with_file_as_chan
44-
(Ext_filename.new_extension (Js_config.get_current_file())
44+
(Ext_filename.new_extension !Location.input_name
4545
(Printf.sprintf ".%02d.%s.jsx" !log_counter name)
4646
) (fun chan -> Js_dump_program.dump_program prog chan )
4747
end in

‎jscomp/core/lam_compile_main.ml

+2-2
Original file line numberDiff line numberDiff line change
@@ -121,7 +121,7 @@ let _d = fun env s lam ->
121121
#if undefined BS_RELEASE_BUILD then
122122
Lam_util.dump env s lam ;
123123
Ext_log.dwarn ~__POS__ "START CHECKING PASS %s@." s;
124-
ignore @@ Lam_check.check (Js_config.get_current_file ()) lam;
124+
ignore @@ Lam_check.check !Location.input_name lam;
125125
Ext_log.dwarn ~__POS__ "FINISH CHECKING PASS %s@." s;
126126
#end
127127
lam
@@ -198,7 +198,7 @@ let compile
198198
|> (fun lam ->
199199
let () =
200200
Ext_log.dwarn ~__POS__ "Before coercion: %a@." Lam_stats.print meta in
201-
Lam_check.check (Js_config.get_current_file ()) lam
201+
Lam_check.check !Location.input_name lam
202202
)
203203
#end
204204
in

‎jscomp/core/ocaml_options.ml

+2-8
Original file line numberDiff line numberDiff line change
@@ -264,13 +264,6 @@ let print_version_string () =
264264
let print_standard_library () =
265265
print_string Bs_conditional_initial.standard_library; print_newline(); exit 0
266266

267-
let print_version_and_library compiler =
268-
Printf.printf "The OCaml %s, version " compiler;
269-
print_string bs_version_string; print_newline();
270-
print_string "Standard library directory: ";
271-
print_string Bs_conditional_initial.standard_library; print_newline();
272-
exit 0
273-
274267
let ocaml_options =
275268
let set r () = r := true in
276269
let unset r () = r := false in
@@ -309,7 +302,8 @@ let ocaml_options =
309302
let _strict_formats = set Clflags.strict_formats in
310303
let _unsafe = set Clflags.fast in
311304
(* let _unsafe_string = set unsafe_string in *)
312-
let _v () = print_version_and_library "compiler" in
305+
(* let _v () = print_version_and_library "compiler" in *)
306+
let _v = print_version_string in
313307
let _version = print_version_string in
314308
let _vnum = print_version_string in
315309
let _w = (Warnings.parse_options false) in

‎jscomp/core/ocaml_parse.ml

+3-1
Original file line numberDiff line numberDiff line change
@@ -46,7 +46,9 @@ let parse_implementation ppf sourcefile =
4646

4747
let parse_implementation_from_string str =
4848
let lb = Lexing.from_string str in
49-
Location.init lb "//toplevel//";
49+
let fname = "//toplevel//" in
50+
Location.input_name := fname;
51+
Location.init lb fname;
5052
Ppx_entry.rewrite_implementation (Parse.implementation lb)
5153

5254

‎jscomp/depends/binary_ast.ml

+2-2
Original file line numberDiff line numberDiff line change
@@ -46,7 +46,7 @@ let magic_sep_char = '\n'
4646
1. for performance , easy skipping and calcuate the length
4747
2. cut dependency, otherwise its type is {!Ast_extract.String_set.t}
4848
*)
49-
let write_ast (type t) ~(fname : string) ~output (kind : t Ml_binary.kind) ( pt : t) : unit =
49+
let write_ast (type t) ~(sourcefile : string) ~output (kind : t Ml_binary.kind) ( pt : t) : unit =
5050
let oc = open_out_bin output in
5151
let output_set = Ast_extract.read_parse_and_extract kind pt in
5252
let buf = Ext_buffer.create 1000 in
@@ -59,6 +59,6 @@ let write_ast (type t) ~(fname : string) ~output (kind : t Ml_binary.kind) ( pt
5959
) output_set ;
6060
output_binary_int oc (Ext_buffer.length buf);
6161
Ext_buffer.output_buffer oc buf;
62-
Ml_binary.write_ast kind fname pt oc;
62+
Ml_binary.write_ast kind sourcefile pt oc;
6363
close_out oc
6464

‎jscomp/depends/binary_ast.mli

+1-1
Original file line numberDiff line numberDiff line change
@@ -43,5 +43,5 @@ val magic_sep_char : char
4343
Use case cat - | fan -printer -impl -
4444
redirect the standard input to fan
4545
*)
46-
val write_ast : fname:string -> output:string -> 'a Ml_binary.kind -> 'a -> unit
46+
val write_ast : sourcefile:string -> output:string -> 'a Ml_binary.kind -> 'a -> unit
4747

0 commit comments

Comments
 (0)