#5832: patch to improve 'wrong file naming' error messages.
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@13618 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02master
parent
fd82bbded5
commit
2bbf91ca42
|
@ -17,7 +17,7 @@ open Misc
|
|||
open Cmx_format
|
||||
|
||||
type error =
|
||||
Illegal_renaming of string * string
|
||||
Illegal_renaming of string * string * string
|
||||
| Forward_reference of string * string
|
||||
| Wrong_for_pack of string * string
|
||||
| Linking_error
|
||||
|
@ -36,14 +36,14 @@ type pack_member =
|
|||
pm_name: string;
|
||||
pm_kind: pack_member_kind }
|
||||
|
||||
let read_member_info pack_path file =
|
||||
let read_member_info pack_path file = (
|
||||
let name =
|
||||
String.capitalize(Filename.basename(chop_extensions file)) in
|
||||
let kind =
|
||||
if Filename.check_suffix file ".cmx" then begin
|
||||
let (info, crc) = Compilenv.read_unit_info file in
|
||||
if info.ui_name <> name
|
||||
then raise(Error(Illegal_renaming(file, info.ui_name)));
|
||||
then raise(Error(Illegal_renaming(name, file, info.ui_name)));
|
||||
if info.ui_symbol <>
|
||||
(Compilenv.current_unit_infos()).ui_symbol ^ "__" ^ info.ui_name
|
||||
then raise(Error(Wrong_for_pack(file, pack_path)));
|
||||
|
@ -53,6 +53,7 @@ let read_member_info pack_path file =
|
|||
end else
|
||||
PM_intf in
|
||||
{ pm_file = file; pm_name = name; pm_kind = kind }
|
||||
)
|
||||
|
||||
(* Check absence of forward references *)
|
||||
|
||||
|
@ -187,9 +188,9 @@ let package_files ppf files targetcmx =
|
|||
open Format
|
||||
|
||||
let report_error ppf = function
|
||||
Illegal_renaming(file, id) ->
|
||||
fprintf ppf "Wrong file naming: %a@ contains the code for@ %s"
|
||||
Location.print_filename file id
|
||||
Illegal_renaming(name, file, id) ->
|
||||
fprintf ppf "Wrong file naming: %a@ contains the code for @ %s when %s was expected"
|
||||
Location.print_filename file name id
|
||||
| Forward_reference(file, ident) ->
|
||||
fprintf ppf "Forward reference to %s in file %a" ident
|
||||
Location.print_filename file
|
||||
|
|
|
@ -16,7 +16,7 @@
|
|||
val package_files: Format.formatter -> string list -> string -> unit
|
||||
|
||||
type error =
|
||||
Illegal_renaming of string * string
|
||||
Illegal_renaming of string * string * string
|
||||
| Forward_reference of string * string
|
||||
| Wrong_for_pack of string * string
|
||||
| Linking_error
|
||||
|
|
|
@ -20,7 +20,7 @@ open Cmx_format
|
|||
type error =
|
||||
Not_a_unit_info of string
|
||||
| Corrupted_unit_info of string
|
||||
| Illegal_renaming of string * string
|
||||
| Illegal_renaming of string * string * string
|
||||
|
||||
exception Error of error
|
||||
|
||||
|
@ -114,7 +114,7 @@ let read_library_info filename =
|
|||
let cmx_not_found_crc =
|
||||
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000"
|
||||
|
||||
let get_global_info global_ident =
|
||||
let get_global_info global_ident = (
|
||||
let modname = Ident.name global_ident in
|
||||
if modname = current_unit.ui_name then
|
||||
Some current_unit
|
||||
|
@ -128,7 +128,7 @@ let get_global_info global_ident =
|
|||
find_in_path_uncap !load_path (modname ^ ".cmx") in
|
||||
let (ui, crc) = read_unit_info filename in
|
||||
if ui.ui_name <> modname then
|
||||
raise(Error(Illegal_renaming(ui.ui_name, filename)));
|
||||
raise(Error(Illegal_renaming(modname, ui.ui_name, filename)));
|
||||
(Some ui, crc)
|
||||
with Not_found ->
|
||||
(None, cmx_not_found_crc) in
|
||||
|
@ -137,6 +137,7 @@ let get_global_info global_ident =
|
|||
Hashtbl.add global_infos_table modname infos;
|
||||
infos
|
||||
end
|
||||
)
|
||||
|
||||
let cache_unit_info ui =
|
||||
Hashtbl.add global_infos_table ui.ui_name (Some ui)
|
||||
|
@ -231,6 +232,6 @@ let report_error ppf = function
|
|||
| Corrupted_unit_info filename ->
|
||||
fprintf ppf "Corrupted compilation unit description@ %a"
|
||||
Location.print_filename filename
|
||||
| Illegal_renaming(modname, filename) ->
|
||||
fprintf ppf "%a@ contains the description for unit@ %s"
|
||||
Location.print_filename filename modname
|
||||
| Illegal_renaming(name, modname, filename) ->
|
||||
fprintf ppf "%a@ contains the description for unit @ %s when %s was expected"
|
||||
Location.print_filename filename name modname
|
||||
|
|
|
@ -74,7 +74,7 @@ val read_library_info: string -> library_infos
|
|||
type error =
|
||||
Not_a_unit_info of string
|
||||
| Corrupted_unit_info of string
|
||||
| Illegal_renaming of string * string
|
||||
| Illegal_renaming of string * string * string
|
||||
|
||||
exception Error of error
|
||||
|
||||
|
|
|
@ -21,7 +21,7 @@ type error =
|
|||
Forward_reference of string * Ident.t
|
||||
| Multiple_definition of string * Ident.t
|
||||
| Not_an_object_file of string
|
||||
| Illegal_renaming of string * string
|
||||
| Illegal_renaming of string * string * string
|
||||
| File_not_found of string
|
||||
|
||||
exception Error of error
|
||||
|
@ -91,7 +91,7 @@ type pack_member =
|
|||
pm_name: string;
|
||||
pm_kind: pack_member_kind }
|
||||
|
||||
let read_member_info file =
|
||||
let read_member_info file = (
|
||||
let name =
|
||||
String.capitalize(Filename.basename(chop_extensions file)) in
|
||||
let kind =
|
||||
|
@ -105,7 +105,7 @@ let read_member_info file =
|
|||
seek_in ic compunit_pos;
|
||||
let compunit = (input_value ic : compilation_unit) in
|
||||
if compunit.cu_name <> name
|
||||
then raise(Error(Illegal_renaming(file, compunit.cu_name)));
|
||||
then raise(Error(Illegal_renaming(name, file, compunit.cu_name)));
|
||||
close_in ic;
|
||||
PM_impl compunit
|
||||
with x ->
|
||||
|
@ -114,6 +114,7 @@ let read_member_info file =
|
|||
end else
|
||||
PM_intf in
|
||||
{ pm_file = file; pm_name = name; pm_kind = kind }
|
||||
)
|
||||
|
||||
(* Read the bytecode from a .cmo file.
|
||||
Write bytecode to channel [oc].
|
||||
|
@ -269,8 +270,8 @@ let report_error ppf = function
|
|||
| Not_an_object_file file ->
|
||||
fprintf ppf "%a is not a bytecode object file"
|
||||
Location.print_filename file
|
||||
| Illegal_renaming(file, id) ->
|
||||
fprintf ppf "Wrong file naming: %a@ contains the code for@ %s"
|
||||
Location.print_filename file id
|
||||
| Illegal_renaming(name, file, id) ->
|
||||
fprintf ppf "Wrong file naming: %a@ contains the code for @ %s when %s was expected"
|
||||
Location.print_filename file name id
|
||||
| File_not_found file ->
|
||||
fprintf ppf "File %s not found" file
|
||||
|
|
|
@ -19,7 +19,7 @@ type error =
|
|||
Forward_reference of string * Ident.t
|
||||
| Multiple_definition of string * Ident.t
|
||||
| Not_an_object_file of string
|
||||
| Illegal_renaming of string * string
|
||||
| Illegal_renaming of string * string * string
|
||||
| File_not_found of string
|
||||
|
||||
exception Error of error
|
||||
|
|
|
@ -54,7 +54,7 @@ let used_constructors :
|
|||
let prefixed_sg = Hashtbl.create 113
|
||||
|
||||
type error =
|
||||
| Illegal_renaming of string * string
|
||||
| Illegal_renaming of string * string * string
|
||||
| Inconsistent_import of string * string * string
|
||||
| Need_recursive_types of string * string
|
||||
|
||||
|
@ -289,7 +289,7 @@ let check_consistency filename crcs =
|
|||
|
||||
(* Reading persistent structures from .cmi files *)
|
||||
|
||||
let read_pers_struct modname filename =
|
||||
let read_pers_struct modname filename = (
|
||||
let cmi = read_cmi filename in
|
||||
let name = cmi.cmi_name in
|
||||
let sign = cmi.cmi_sign in
|
||||
|
@ -304,9 +304,9 @@ let read_pers_struct modname filename =
|
|||
ps_comps = comps;
|
||||
ps_crcs = crcs;
|
||||
ps_filename = filename;
|
||||
ps_flags = flags } in
|
||||
ps_flags = flags } in
|
||||
if ps.ps_name <> modname then
|
||||
raise(Error(Illegal_renaming(ps.ps_name, filename)));
|
||||
raise(Error(Illegal_renaming(modname, ps.ps_name, filename)));
|
||||
check_consistency filename ps.ps_crcs;
|
||||
List.iter
|
||||
(function Rectypes ->
|
||||
|
@ -315,6 +315,7 @@ let read_pers_struct modname filename =
|
|||
ps.ps_flags;
|
||||
Hashtbl.add persistent_structures modname (Some ps);
|
||||
ps
|
||||
)
|
||||
|
||||
let find_pers_struct name =
|
||||
if name = "*predef*" then raise Not_found;
|
||||
|
@ -1507,9 +1508,9 @@ let env_of_only_summary env_from_summary env =
|
|||
open Format
|
||||
|
||||
let report_error ppf = function
|
||||
| Illegal_renaming(modname, filename) -> fprintf ppf
|
||||
"Wrong file naming: %a@ contains the compiled interface for@ %s"
|
||||
Location.print_filename filename modname
|
||||
| Illegal_renaming(name, modname, filename) -> fprintf ppf
|
||||
"Wrong file naming: %a@ contains the compiled interface for @ %s when %s was expected"
|
||||
Location.print_filename filename name modname
|
||||
| Inconsistent_import(name, source1, source2) -> fprintf ppf
|
||||
"@[<hov>The files %a@ and %a@ \
|
||||
make inconsistent assumptions@ over interface %s@]"
|
||||
|
|
|
@ -159,7 +159,7 @@ val env_of_only_summary : (summary -> Subst.t -> t) -> t -> t
|
|||
(* Error report *)
|
||||
|
||||
type error =
|
||||
| Illegal_renaming of string * string
|
||||
| Illegal_renaming of string * string * string
|
||||
| Inconsistent_import of string * string * string
|
||||
| Need_recursive_types of string * string
|
||||
|
||||
|
|
Loading…
Reference in New Issue