Skip to content

Commit 14d7144

Browse files
committed
fix #1143
1 parent 2934a3f commit 14d7144

File tree

11 files changed

+163
-54
lines changed

11 files changed

+163
-54
lines changed

jscomp/bin/all_ounit_tests.ml

Lines changed: 17 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -1727,7 +1727,11 @@ val rindex_neg : string -> char -> int
17271727

17281728
val rindex_opt : string -> char -> int option
17291729

1730-
val is_valid_source_name : string -> bool
1730+
type check_result =
1731+
| Good | Invalid_module_name | Suffix_mismatch
1732+
1733+
val is_valid_source_name :
1734+
string -> check_result
17311735

17321736
val no_char : string -> char -> int -> int -> bool
17331737

@@ -2093,18 +2097,25 @@ let is_valid_module_file (s : string) =
20932097
| _ -> false )
20942098
| _ -> false
20952099

2100+
type check_result =
2101+
| Good
2102+
| Invalid_module_name
2103+
| Suffix_mismatch
20962104
(**
20972105
TODO: move to another module
20982106
Make {!Ext_filename} not stateful
20992107
*)
2100-
let is_valid_source_name name =
2108+
let is_valid_source_name name : check_result =
21012109
match check_any_suffix_case_then_chop name [
21022110
".ml";
21032111
".re";
21042112
".mli"; ".mll"; ".rei"
21052113
] with
2106-
| None -> false
2107-
| Some x -> is_valid_module_file x
2114+
| None -> Suffix_mismatch
2115+
| Some x ->
2116+
if is_valid_module_file x then
2117+
Good
2118+
else Invalid_module_name
21082119

21092120
(** TODO: can be improved to return a positive integer instead *)
21102121
let rec unsafe_no_char x ch i len =
@@ -12030,12 +12041,12 @@ let suites =
1203012041

1203112042
__LOC__ >:: begin fun _ ->
1203212043
OUnit.assert_bool __LOC__ @@
12033-
List.for_all Ext_string.is_valid_source_name
12044+
List.for_all (fun x -> Ext_string.is_valid_source_name x = Good)
1203412045
["x.ml"; "x.mli"; "x.re"; "x.rei"; "x.mll";
1203512046
"A_x.ml"; "ab.ml"; "a_.ml"; "a__.ml";
1203612047
"ax.ml"];
1203712048
OUnit.assert_bool __LOC__ @@ not @@
12038-
List.exists Ext_string.is_valid_source_name
12049+
List.exists (fun x -> Ext_string.is_valid_source_name x = Good)
1203912050
[".re"; ".rei";"..re"; "..rei"; "..ml"; ".mll~";
1204012051
"...ml"; "_.mli"; "_x.ml"; "__.ml"; "__.rei";
1204112052
".#hello.ml"; ".#hello.rei"; "a-.ml"; "a-b.ml"; "-a-.ml"

jscomp/bin/bsb.ml

Lines changed: 39 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -808,7 +808,11 @@ val rindex_neg : string -> char -> int
808808

809809
val rindex_opt : string -> char -> int option
810810

811-
val is_valid_source_name : string -> bool
811+
type check_result =
812+
| Good | Invalid_module_name | Suffix_mismatch
813+
814+
val is_valid_source_name :
815+
string -> check_result
812816

813817
val no_char : string -> char -> int -> int -> bool
814818

@@ -1174,18 +1178,25 @@ let is_valid_module_file (s : string) =
11741178
| _ -> false )
11751179
| _ -> false
11761180

1181+
type check_result =
1182+
| Good
1183+
| Invalid_module_name
1184+
| Suffix_mismatch
11771185
(**
11781186
TODO: move to another module
11791187
Make {!Ext_filename} not stateful
11801188
*)
1181-
let is_valid_source_name name =
1189+
let is_valid_source_name name : check_result =
11821190
match check_any_suffix_case_then_chop name [
11831191
".ml";
11841192
".re";
11851193
".mli"; ".mll"; ".rei"
11861194
] with
1187-
| None -> false
1188-
| Some x -> is_valid_module_file x
1195+
| None -> Suffix_mismatch
1196+
| Some x ->
1197+
if is_valid_module_file x then
1198+
Good
1199+
else Invalid_module_name
11891200

11901201
(** TODO: can be improved to return a positive integer instead *)
11911202
let rec unsafe_no_char x ch i len =
@@ -6482,16 +6493,24 @@ let print_arrays file_array oc offset =
64826493

64836494
let handle_list_files dir (s : Ext_json.t array) loc_start loc_end : Ext_file_pp.interval list * _ =
64846495
if Ext_array.is_empty s then
6485-
begin
6496+
begin (** detect files to be populated later *)
64866497
let files_array = Bsb_dir.readdir dir in
64876498
let dyn_file_array = String_vec.make (Array.length files_array) in
64886499
let files =
64896500
Array.fold_left (fun acc name ->
6490-
if Ext_string.is_valid_source_name name then begin
6491-
let new_acc = Binary_cache.map_update ~dir acc name in
6492-
String_vec.push name dyn_file_array ;
6493-
new_acc
6494-
end else acc
6501+
match Ext_string.is_valid_source_name name with
6502+
| Good -> begin
6503+
let new_acc = Binary_cache.map_update ~dir acc name in
6504+
String_vec.push name dyn_file_array ;
6505+
new_acc
6506+
end
6507+
| Invalid_module_name ->
6508+
print_endline
6509+
(Printf.sprintf "file %s under %s is ignored due to that it is not a valid module name"
6510+
name dir
6511+
) ;
6512+
acc
6513+
| Suffix_mismatch -> acc
64956514
) String_map.empty files_array in
64966515
[{Ext_file_pp.loc_start ;
64976516
loc_end; action = (`print (print_arrays dyn_file_array))}],
@@ -6577,10 +6596,16 @@ and parsing_source (dir_index : int) cwd (x : Ext_json.t )
65776596
(** We should avoid temporary files *)
65786597
sources :=
65796598
Array.fold_left (fun acc name ->
6580-
if Ext_string.is_valid_source_name name
6581-
then
6599+
match Ext_string.is_valid_source_name name with
6600+
| Good ->
65826601
Binary_cache.map_update ~dir acc name
6583-
else acc
6602+
| Invalid_module_name ->
6603+
print_endline
6604+
(Printf.sprintf "file %s under %s is ignored due to that it is not a valid module name"
6605+
name dir
6606+
) ;
6607+
acc
6608+
| Suffix_mismatch -> acc
65846609
) String_map.empty file_array;
65856610
globbed_dirs := [dir]
65866611
)
@@ -6664,7 +6689,7 @@ and parsing_sources dir_index cwd (sources : Ext_json.t ) =
66646689

66656690

66666691

6667-
6692+
66686693
end
66696694
module Bs_hash_stubs
66706695
= struct

jscomp/bin/bsb_helper.ml

Lines changed: 15 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -446,7 +446,11 @@ val rindex_neg : string -> char -> int
446446

447447
val rindex_opt : string -> char -> int option
448448

449-
val is_valid_source_name : string -> bool
449+
type check_result =
450+
| Good | Invalid_module_name | Suffix_mismatch
451+
452+
val is_valid_source_name :
453+
string -> check_result
450454

451455
val no_char : string -> char -> int -> int -> bool
452456

@@ -812,18 +816,25 @@ let is_valid_module_file (s : string) =
812816
| _ -> false )
813817
| _ -> false
814818

819+
type check_result =
820+
| Good
821+
| Invalid_module_name
822+
| Suffix_mismatch
815823
(**
816824
TODO: move to another module
817825
Make {!Ext_filename} not stateful
818826
*)
819-
let is_valid_source_name name =
827+
let is_valid_source_name name : check_result =
820828
match check_any_suffix_case_then_chop name [
821829
".ml";
822830
".re";
823831
".mli"; ".mll"; ".rei"
824832
] with
825-
| None -> false
826-
| Some x -> is_valid_module_file x
833+
| None -> Suffix_mismatch
834+
| Some x ->
835+
if is_valid_module_file x then
836+
Good
837+
else Invalid_module_name
827838

828839
(** TODO: can be improved to return a positive integer instead *)
829840
let rec unsafe_no_char x ch i len =

jscomp/bin/bsdep.ml

Lines changed: 15 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -22484,7 +22484,11 @@ val rindex_neg : string -> char -> int
2248422484

2248522485
val rindex_opt : string -> char -> int option
2248622486

22487-
val is_valid_source_name : string -> bool
22487+
type check_result =
22488+
| Good | Invalid_module_name | Suffix_mismatch
22489+
22490+
val is_valid_source_name :
22491+
string -> check_result
2248822492

2248922493
val no_char : string -> char -> int -> int -> bool
2249022494

@@ -22850,18 +22854,25 @@ let is_valid_module_file (s : string) =
2285022854
| _ -> false )
2285122855
| _ -> false
2285222856

22857+
type check_result =
22858+
| Good
22859+
| Invalid_module_name
22860+
| Suffix_mismatch
2285322861
(**
2285422862
TODO: move to another module
2285522863
Make {!Ext_filename} not stateful
2285622864
*)
22857-
let is_valid_source_name name =
22865+
let is_valid_source_name name : check_result =
2285822866
match check_any_suffix_case_then_chop name [
2285922867
".ml";
2286022868
".re";
2286122869
".mli"; ".mll"; ".rei"
2286222870
] with
22863-
| None -> false
22864-
| Some x -> is_valid_module_file x
22871+
| None -> Suffix_mismatch
22872+
| Some x ->
22873+
if is_valid_module_file x then
22874+
Good
22875+
else Invalid_module_name
2286522876

2286622877
(** TODO: can be improved to return a positive integer instead *)
2286722878
let rec unsafe_no_char x ch i len =

jscomp/bin/bsppx.ml

Lines changed: 15 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -4277,7 +4277,11 @@ val rindex_neg : string -> char -> int
42774277

42784278
val rindex_opt : string -> char -> int option
42794279

4280-
val is_valid_source_name : string -> bool
4280+
type check_result =
4281+
| Good | Invalid_module_name | Suffix_mismatch
4282+
4283+
val is_valid_source_name :
4284+
string -> check_result
42814285

42824286
val no_char : string -> char -> int -> int -> bool
42834287

@@ -4643,18 +4647,25 @@ let is_valid_module_file (s : string) =
46434647
| _ -> false )
46444648
| _ -> false
46454649

4650+
type check_result =
4651+
| Good
4652+
| Invalid_module_name
4653+
| Suffix_mismatch
46464654
(**
46474655
TODO: move to another module
46484656
Make {!Ext_filename} not stateful
46494657
*)
4650-
let is_valid_source_name name =
4658+
let is_valid_source_name name : check_result =
46514659
match check_any_suffix_case_then_chop name [
46524660
".ml";
46534661
".re";
46544662
".mli"; ".mll"; ".rei"
46554663
] with
4656-
| None -> false
4657-
| Some x -> is_valid_module_file x
4664+
| None -> Suffix_mismatch
4665+
| Some x ->
4666+
if is_valid_module_file x then
4667+
Good
4668+
else Invalid_module_name
46584669

46594670
(** TODO: can be improved to return a positive integer instead *)
46604671
let rec unsafe_no_char x ch i len =

jscomp/bin/whole_compiler.ml

Lines changed: 15 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -20458,7 +20458,11 @@ val rindex_neg : string -> char -> int
2045820458

2045920459
val rindex_opt : string -> char -> int option
2046020460

20461-
val is_valid_source_name : string -> bool
20461+
type check_result =
20462+
| Good | Invalid_module_name | Suffix_mismatch
20463+
20464+
val is_valid_source_name :
20465+
string -> check_result
2046220466

2046320467
val no_char : string -> char -> int -> int -> bool
2046420468

@@ -20824,18 +20828,25 @@ let is_valid_module_file (s : string) =
2082420828
| _ -> false )
2082520829
| _ -> false
2082620830

20831+
type check_result =
20832+
| Good
20833+
| Invalid_module_name
20834+
| Suffix_mismatch
2082720835
(**
2082820836
TODO: move to another module
2082920837
Make {!Ext_filename} not stateful
2083020838
*)
20831-
let is_valid_source_name name =
20839+
let is_valid_source_name name : check_result =
2083220840
match check_any_suffix_case_then_chop name [
2083320841
".ml";
2083420842
".re";
2083520843
".mli"; ".mll"; ".rei"
2083620844
] with
20837-
| None -> false
20838-
| Some x -> is_valid_module_file x
20845+
| None -> Suffix_mismatch
20846+
| Some x ->
20847+
if is_valid_module_file x then
20848+
Good
20849+
else Invalid_module_name
2083920850

2084020851
(** TODO: can be improved to return a positive integer instead *)
2084120852
let rec unsafe_no_char x ch i len =

jscomp/bsb/bsb_build_ui.ml

Lines changed: 23 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -99,16 +99,24 @@ let print_arrays file_array oc offset =
9999

100100
let handle_list_files dir (s : Ext_json.t array) loc_start loc_end : Ext_file_pp.interval list * _ =
101101
if Ext_array.is_empty s then
102-
begin
102+
begin (** detect files to be populated later *)
103103
let files_array = Bsb_dir.readdir dir in
104104
let dyn_file_array = String_vec.make (Array.length files_array) in
105105
let files =
106106
Array.fold_left (fun acc name ->
107-
if Ext_string.is_valid_source_name name then begin
108-
let new_acc = Binary_cache.map_update ~dir acc name in
109-
String_vec.push name dyn_file_array ;
110-
new_acc
111-
end else acc
107+
match Ext_string.is_valid_source_name name with
108+
| Good -> begin
109+
let new_acc = Binary_cache.map_update ~dir acc name in
110+
String_vec.push name dyn_file_array ;
111+
new_acc
112+
end
113+
| Invalid_module_name ->
114+
print_endline
115+
(Printf.sprintf "file %s under %s is ignored due to that it is not a valid module name"
116+
name dir
117+
) ;
118+
acc
119+
| Suffix_mismatch -> acc
112120
) String_map.empty files_array in
113121
[{Ext_file_pp.loc_start ;
114122
loc_end; action = (`print (print_arrays dyn_file_array))}],
@@ -194,10 +202,16 @@ and parsing_source (dir_index : int) cwd (x : Ext_json.t )
194202
(** We should avoid temporary files *)
195203
sources :=
196204
Array.fold_left (fun acc name ->
197-
if Ext_string.is_valid_source_name name
198-
then
205+
match Ext_string.is_valid_source_name name with
206+
| Good ->
199207
Binary_cache.map_update ~dir acc name
200-
else acc
208+
| Invalid_module_name ->
209+
print_endline
210+
(Printf.sprintf "file %s under %s is ignored due to that it is not a valid module name"
211+
name dir
212+
) ;
213+
acc
214+
| Suffix_mismatch -> acc
201215
) String_map.empty file_array;
202216
globbed_dirs := [dir]
203217
)
@@ -281,4 +295,3 @@ and parsing_sources dir_index cwd (sources : Ext_json.t ) =
281295

282296

283297

284-

0 commit comments

Comments
 (0)