#5832: patch to improve 'wrong file naming' error messages.

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@13618 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
master
Alain Frisch 2013-04-29 14:57:38 +00:00
parent fd82bbded5
commit 2bbf91ca42
8 changed files with 33 additions and 29 deletions

View File

@ -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

View 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

View File

@ -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

View File

@ -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

View File

@ -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

View 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

View File

@ -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@]"

View File

@ -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