@@ -808,7 +808,11 @@ val rindex_neg : string -> char -> int
808
808
809
809
val rindex_opt : string -> char -> int option
810
810
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
812
816
813
817
val no_char : string -> char -> int -> int -> bool
814
818
@@ -1174,18 +1178,25 @@ let is_valid_module_file (s : string) =
1174
1178
| _ -> false )
1175
1179
| _ -> false
1176
1180
1181
+ type check_result =
1182
+ | Good
1183
+ | Invalid_module_name
1184
+ | Suffix_mismatch
1177
1185
(* *
1178
1186
TODO: move to another module
1179
1187
Make {!Ext_filename} not stateful
1180
1188
*)
1181
- let is_valid_source_name name =
1189
+ let is_valid_source_name name : check_result =
1182
1190
match check_any_suffix_case_then_chop name [
1183
1191
" .ml" ;
1184
1192
" .re" ;
1185
1193
" .mli" ; " .mll" ; " .rei"
1186
1194
] 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
1189
1200
1190
1201
(* * TODO: can be improved to return a positive integer instead *)
1191
1202
let rec unsafe_no_char x ch i len =
@@ -6482,16 +6493,24 @@ let print_arrays file_array oc offset =
6482
6493
6483
6494
let handle_list_files dir (s : Ext_json.t array ) loc_start loc_end : Ext_file_pp.interval list * _ =
6484
6495
if Ext_array. is_empty s then
6485
- begin
6496
+ begin (* * detect files to be populated later *)
6486
6497
let files_array = Bsb_dir. readdir dir in
6487
6498
let dyn_file_array = String_vec. make (Array. length files_array) in
6488
6499
let files =
6489
6500
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
6495
6514
) String_map. empty files_array in
6496
6515
[{Ext_file_pp. loc_start ;
6497
6516
loc_end; action = (`print (print_arrays dyn_file_array))}],
@@ -6577,10 +6596,16 @@ and parsing_source (dir_index : int) cwd (x : Ext_json.t )
6577
6596
(* * We should avoid temporary files *)
6578
6597
sources :=
6579
6598
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 ->
6582
6601
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
6584
6609
) String_map. empty file_array;
6585
6610
globbed_dirs := [dir]
6586
6611
)
@@ -6664,7 +6689,7 @@ and parsing_sources dir_index cwd (sources : Ext_json.t ) =
6664
6689
6665
6690
6666
6691
6667
-
6692
+
6668
6693
end
6669
6694
module Bs_hash_stubs
6670
6695
= struct
0 commit comments