@@ -808,7 +808,11 @@ val rindex_neg : string -> char -> int
808808
809809val 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
813817val 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 *)
11911202let rec unsafe_no_char x ch i len =
@@ -6478,20 +6489,28 @@ let print_arrays file_array oc offset =
64786489 p_str " ]"
64796490
64806491
6481-
6492+ let warning_unused_file : _ format = " WARNING: file %s under %s is ignored due to that it is not a valid module name "
64826493
64836494let 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 warning_unused_file
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 warning_unused_file
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+
66686693end
66696694module Bs_hash_stubs
66706695= struct
0 commit comments