diff options
| -rw-r--r-- | VERSION | 2 | ||||
| -rw-r--r-- | driver/compile.ml | 23 | ||||
| -rw-r--r-- | driver/optcompile.ml | 25 | ||||
| -rw-r--r-- | typing/env.ml | 12 | ||||
| -rw-r--r-- | typing/env.mli | 3 | ||||
| -rw-r--r-- | utils/warnings.ml | 4 | ||||
| -rw-r--r-- | utils/warnings.mli | 1 |
7 files changed, 54 insertions, 16 deletions
@@ -1,4 +1,4 @@ -3.11+dev18 Private_abbrevs+natdynlink+lazy_patterns+fscanf debug (2008-09-27) +3.11+dev19 Private_abbrevs+natdynlink+lazy_patterns+fscanf debug (2008-10-06) # The version string is the first line of this file. # It must be in the format described in stdlib/sys.mli diff --git a/driver/compile.ml b/driver/compile.ml index 3cf2c749e..4e2d8566e 100644 --- a/driver/compile.ml +++ b/driver/compile.ml @@ -48,6 +48,27 @@ let initial_env () = with Not_found -> fatal_error "cannot open pervasives.cmi" +(* Note: this function is duplicated in optcompile.ml *) +let check_unit_name ppf filename name = + try + begin match name.[0] with + | 'A'..'Z' -> () + | _ -> + Location.print_warning (Location.in_file filename) ppf + (Warnings.Bad_module_name name); + raise Exit; + end; + for i = 1 to String.length name - 1 do + match name.[i] with + | 'A'..'Z' | 'a'..'z' | '0'..'9' | '_' | '\'' -> () + | _ -> + Location.print_warning (Location.in_file filename) ppf + (Warnings.Bad_module_name name); + raise Exit; + done; + with Exit -> () +;; + (* Compile a .mli file *) let interface ppf sourcefile outputprefix = @@ -55,6 +76,7 @@ let interface ppf sourcefile outputprefix = init_path (); let modulename = String.capitalize(Filename.basename(chop_extension_if_any sourcefile)) in + check_unit_name ppf sourcefile modulename; Env.set_unit_name modulename; let inputfile = Pparse.preprocess sourcefile in try @@ -86,6 +108,7 @@ let implementation ppf sourcefile outputprefix = init_path (); let modulename = String.capitalize(Filename.basename(chop_extension_if_any sourcefile)) in + check_unit_name ppf sourcefile modulename; Env.set_unit_name modulename; let inputfile = Pparse.preprocess sourcefile in let env = initial_env() in diff --git a/driver/optcompile.ml b/driver/optcompile.ml index 31ef4e187..0aa947953 100644 --- a/driver/optcompile.ml +++ b/driver/optcompile.ml @@ -43,7 +43,28 @@ let initial_env () = then Env.initial else Env.open_pers_signature "Pervasives" Env.initial with Not_found -> - fatal_error "cannot open Pervasives.cmi" + fatal_error "cannot open pervasives.cmi" + +(* Note: this function is duplicated in compile.ml *) +let check_unit_name ppf filename name = + try + begin match name.[0] with + | 'A'..'Z' -> () + | _ -> + Location.print_warning (Location.in_file filename) ppf + (Warnings.Bad_module_name name); + raise Exit; + end; + for i = 1 to String.length name - 1 do + match name.[i] with + | 'A'..'Z' | 'a'..'z' | '0'..'9' | '_' | '\'' -> () + | _ -> + Location.print_warning (Location.in_file filename) ppf + (Warnings.Bad_module_name name); + raise Exit; + done; + with Exit -> () +;; (* Compile a .mli file *) @@ -52,6 +73,7 @@ let interface ppf sourcefile outputprefix = init_path (); let modulename = String.capitalize(Filename.basename(chop_extension_if_any sourcefile)) in + check_unit_name ppf sourcefile modulename; Env.set_unit_name modulename; let inputfile = Pparse.preprocess sourcefile in try @@ -86,6 +108,7 @@ let implementation ppf sourcefile outputprefix = init_path (); let modulename = String.capitalize(Filename.basename(chop_extension_if_any sourcefile)) in + check_unit_name ppf sourcefile modulename; Env.set_unit_name modulename; let inputfile = Pparse.preprocess sourcefile in let env = initial_env() in diff --git a/typing/env.ml b/typing/env.ml index 04efba3d5..05f489613 100644 --- a/typing/env.ml +++ b/typing/env.ml @@ -28,7 +28,6 @@ type error = | Illegal_renaming of string * string | Inconsistent_import of string * string * string | Need_recursive_types of string * string - | Bad_module_name of string exception Error of error @@ -203,15 +202,6 @@ let reset_cache () = Consistbl.clear crc_units let set_unit_name name = - begin match name.[0] with - | 'A'..'Z' -> () - | _ -> raise (Error (Bad_module_name name)) - end; - for i = 1 to String.length name - 1 do - match name.[i] with - | 'A'..'Z' | 'a'..'z' | '0'..'9' | '_' | '\'' -> () - | _ -> raise (Error (Bad_module_name name)) - done; current_unit := name (* Lookup by identifier *) @@ -870,5 +860,3 @@ let report_error ppf = function fprintf ppf "@[<hov>Unit %s imports from %s, which uses recursive types.@ %s@]" import export "The compilation flag -rectypes is required" - | Bad_module_name (modname) -> fprintf ppf - "Invalid source file name: \"%s\" is not a valid module name." modname diff --git a/typing/env.mli b/typing/env.mli index e35bb3182..8f00972a6 100644 --- a/typing/env.mli +++ b/typing/env.mli @@ -84,7 +84,7 @@ val enter_cltype: string -> cltype_declaration -> t -> Ident.t * t (* Initialize the cache of in-core module interfaces. *) val reset_cache: unit -> unit -(* Check and remember the name of the current compilation unit. *) +(* Remember the name of the current compilation unit. *) val set_unit_name: string -> unit (* Read, save a signature to/from a file *) @@ -134,7 +134,6 @@ type error = | Illegal_renaming of string * string | Inconsistent_import of string * string * string | Need_recursive_types of string * string - | Bad_module_name of string exception Error of error diff --git a/utils/warnings.ml b/utils/warnings.ml index 74bb4b918..858bd1172 100644 --- a/utils/warnings.ml +++ b/utils/warnings.ml @@ -38,6 +38,7 @@ type t = (* A is all *) | Camlp4 of string | All_clauses_guarded | Useless_record_with + | Bad_module_name of string | Unused_var of string (* Y *) | Unused_var_strict of string (* Z *) ;; @@ -65,6 +66,7 @@ let letter = function (* 'a' is all *) | Nonreturning_statement | Camlp4 _ | Useless_record_with + | Bad_module_name _ | All_clauses_guarded -> 'x' | Unused_var _ -> 'y' | Unused_var_strict _ -> 'z' @@ -156,6 +158,8 @@ let message = function | Useless_record_with -> "this record is defined by a `with' expression,\n\ but no fields are borrowed from the original." + | Bad_module_name (modname) -> + "bad source file name: \"" ^ modname ^ "\" is not a valid module name." ;; let nerrors = ref 0;; diff --git a/utils/warnings.mli b/utils/warnings.mli index cb55f8c60..1610b3c3a 100644 --- a/utils/warnings.mli +++ b/utils/warnings.mli @@ -38,6 +38,7 @@ type t = (* A is all *) | Camlp4 of string | All_clauses_guarded | Useless_record_with + | Bad_module_name of string | Unused_var of string (* Y *) | Unused_var_strict of string (* Z *) ;; |