Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Print warnings on the warnings formatter in the couple of places that don't 

Except the OCAMLPARAM stuff, as that runs before the command line
warning settings are even parsed, so while they are reported using the
normal warnings code, they don't look like normal warnings.
master
Valentin Gatien-Baron 2018-07-15 15:00:47 -04:00
parent 47eeff4bac
commit 0444eac687
11 changed files with 48 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
bytecomp/bytelibrarian.ml
View File

@ -55,7 +55,7 @@ let add_ccobjs l =
lib_dllibs := !lib_dllibs @ l.lib_dllibs
end
let copy_object_file ppf oc name =
let copy_object_file oc name =
let file_name =
try
find_in_path !load_path name
@ -68,7 +68,7 @@ let copy_object_file ppf oc name =
let compunit_pos = input_binary_int ic in
seek_in ic compunit_pos;
let compunit = (input_value ic : compilation_unit) in
Bytelink.check_consistency ppf file_name compunit;
Bytelink.check_consistency file_name compunit;
copy_compunit ic oc compunit;
close_in ic;
[compunit]
@ -77,7 +77,7 @@ let copy_object_file ppf oc name =
let toc_pos = input_binary_int ic in
seek_in ic toc_pos;
let toc = (input_value ic : library) in
List.iter (Bytelink.check_consistency ppf file_name) toc.lib_units;
List.iter (Bytelink.check_consistency file_name) toc.lib_units;
add_ccobjs toc;
List.iter (copy_compunit ic oc) toc.lib_units;
close_in ic;
@ -88,14 +88,14 @@ let copy_object_file ppf oc name =
End_of_file -> close_in ic; raise(Error(Not_an_object_file file_name))
| x -> close_in ic; raise x
let create_archive ppf file_list lib_name =
let create_archive file_list lib_name =
let outchan = open_out_bin lib_name in
try
output_string outchan cma_magic_number;
let ofs_pos_toc = pos_out outchan in
output_binary_int outchan 0;
let units =
List.flatten(List.map (copy_object_file ppf outchan) file_list) in
List.flatten(List.map (copy_object_file outchan) file_list) in
let toc =
{ lib_units = units;
lib_custom = !Clflags.custom_runtime;

2
bytecomp/bytelibrarian.mli
View File

@ -22,7 +22,7 @@
content table = list of compilation units
*)
val create_archive: Format.formatter -> string list -> string -> unit
val create_archive: string list -> string -> unit
type error =
File_not_found of string

38
bytecomp/bytelink.ml
View File

@ -169,7 +169,7 @@ let crc_interfaces = Consistbl.create ()
let interfaces = ref ([] : string list)
let implementations_defined = ref ([] : (string * string) list)
let check_consistency ppf file_name cu =
let check_consistency file_name cu =
begin try
List.iter
(fun (name, crco) ->
@ -186,7 +186,7 @@ let check_consistency ppf file_name cu =
end;
begin try
let source = List.assoc cu.cu_name !implementations_defined in
Location.print_warning (Location.in_file file_name) ppf
Location.prerr_warning (Location.in_file file_name)
(Warnings.Multiple_definition(cu.cu_name,
Location.show_filename file_name,
Location.show_filename source))
@ -208,8 +208,8 @@ let debug_info = ref ([] : (int * Instruct.debug_event list * string list) list)
(* Link in a compilation unit *)
let link_compunit ppf output_fun currpos_fun inchan file_name compunit =
check_consistency ppf file_name compunit;
let link_compunit output_fun currpos_fun inchan file_name compunit =
check_consistency file_name compunit;
seek_in inchan compunit.cu_pos;
let code_block = LongString.input_bytes inchan compunit.cu_codesize in
Symtable.patch_object code_block compunit.cu_reloc;
@ -230,10 +230,10 @@ let link_compunit ppf output_fun currpos_fun inchan file_name compunit =
(* Link in a .cmo file *)
let link_object ppf output_fun currpos_fun file_name compunit =
let link_object output_fun currpos_fun file_name compunit =
let inchan = open_in_bin file_name in
try
link_compunit ppf output_fun currpos_fun inchan file_name compunit;
link_compunit output_fun currpos_fun inchan file_name compunit;
close_in inchan
with
Symtable.Error msg ->
@ -243,14 +243,14 @@ let link_object ppf output_fun currpos_fun file_name compunit =
(* Link in a .cma file *)
let link_archive ppf output_fun currpos_fun file_name units_required =
let link_archive output_fun currpos_fun file_name units_required =
let inchan = open_in_bin file_name in
try
List.iter
(fun cu ->
let name = file_name ^ "(" ^ cu.cu_name ^ ")" in
try
link_compunit ppf output_fun currpos_fun inchan name cu
link_compunit output_fun currpos_fun inchan name cu
with Symtable.Error msg ->
raise(Error(Symbol_error(name, msg))))
units_required;
@ -259,11 +259,11 @@ let link_archive ppf output_fun currpos_fun file_name units_required =
(* Link in a .cmo or .cma file *)
let link_file ppf output_fun currpos_fun = function
let link_file output_fun currpos_fun = function
Link_object(file_name, unit) ->
link_object ppf output_fun currpos_fun file_name unit
link_object output_fun currpos_fun file_name unit
| Link_archive(file_name, units) ->
link_archive ppf output_fun currpos_fun file_name units
link_archive output_fun currpos_fun file_name units
(* Output the debugging information *)
(* Format is:
@ -298,7 +298,7 @@ let make_absolute file =
(* Create a bytecode executable file *)
let link_bytecode ppf tolink exec_name standalone =
let link_bytecode tolink exec_name standalone =
(* Avoid the case where the specified exec output file is the same as
one of the objects to be linked *)
List.iter (function
@ -343,7 +343,7 @@ let link_bytecode ppf tolink exec_name standalone =
end;
let output_fun = output_bytes outchan
and currpos_fun () = pos_out outchan - start_code in
List.iter (link_file ppf output_fun currpos_fun) tolink;
List.iter (link_file output_fun currpos_fun) tolink;
if check_dlls then Dll.close_all_dlls();
(* The final STOP instruction *)
output_byte outchan Opcodes.opSTOP;
@ -444,7 +444,7 @@ let output_cds_file outfile =
(* Output a bytecode executable as a C file *)
let link_bytecode_as_c ppf tolink outfile =
let link_bytecode_as_c tolink outfile =
let outchan = open_out outfile in
begin try
(* The bytecode *)
@ -464,7 +464,7 @@ let link_bytecode_as_c ppf tolink outfile =
output_code_string outchan code;
currpos := !currpos + Bytes.length code
and currpos_fun () = !currpos in
List.iter (link_file ppf output_fun currpos_fun) tolink;
List.iter (link_file output_fun currpos_fun) tolink;
(* The final STOP instruction *)
Printf.fprintf outchan "\n0x%x};\n\n" Opcodes.opSTOP;
(* The table of global data *)
@ -565,7 +565,7 @@ let fix_exec_name name =
(* Main entry point (build a custom runtime if needed) *)
let link ppf objfiles output_name =
let link objfiles output_name =
let objfiles =
if !Clflags.nopervasives then objfiles
else if !Clflags.output_c_object then "stdlib.cma" :: objfiles
@ -584,7 +584,7 @@ let link ppf objfiles output_name =
(* put user's opts first *)
Clflags.dllibs := !lib_dllibs @ !Clflags.dllibs; (* put user's DLLs first *)
if not !Clflags.custom_runtime then
link_bytecode ppf tolink output_name true
link_bytecode tolink output_name true
else if not !Clflags.output_c_object then begin
let bytecode_name = Filename.temp_file "camlcode" "" in
let prim_name =
@ -593,7 +593,7 @@ let link ppf objfiles output_name =
else
Filename.temp_file "camlprim" ".c" in
try
link_bytecode ppf tolink bytecode_name false;
link_bytecode tolink bytecode_name false;
let poc = open_out prim_name in
(* note: builds will not be reproducible if the C code contains macros
such as __FILE__. *)
@ -646,7 +646,7 @@ let link ppf objfiles output_name =
else basename ^ Config.ext_obj
in
try
link_bytecode_as_c ppf tolink c_file;
link_bytecode_as_c tolink c_file;
if not (Filename.check_suffix output_name ".c") then begin
temps := c_file :: !temps;
if Ccomp.compile_file ~output:obj_file ?stable_name c_file <> 0 then

5
bytecomp/bytelink.mli
View File

@ -15,11 +15,10 @@
(* Link .cmo files and produce a bytecode executable. *)
val link : Format.formatter -> string list -> string -> unit
val link : string list -> string -> unit
val reset : unit -> unit
val check_consistency:
Format.formatter -> string -> Cmo_format.compilation_unit -> unit
val check_consistency: string -> Cmo_format.compilation_unit -> unit
val extract_crc_interfaces: unit -> (string * Digest.t option) list

20
bytecomp/bytepackager.ml
View File

@ -132,11 +132,11 @@ let read_member_info file = (
Accumulate relocs, debug info, etc.
Return size of bytecode. *)
let rename_append_bytecode ppf packagename oc mapping defined ofs prefix subst
let rename_append_bytecode packagename oc mapping defined ofs prefix subst
objfile compunit =
let ic = open_in_bin objfile in
try
Bytelink.check_consistency ppf objfile compunit;
Bytelink.check_consistency objfile compunit;
List.iter
(rename_relocation packagename objfile mapping defined ofs)
compunit.cu_reloc;
@ -161,7 +161,7 @@ let rename_append_bytecode ppf packagename oc mapping defined ofs prefix subst
(* Same, for a list of .cmo and .cmi files.
Return total size of bytecode. *)
let rec rename_append_bytecode_list ppf packagename oc mapping defined ofs
let rec rename_append_bytecode_list packagename oc mapping defined ofs
prefix subst =
function
[] ->
@ -169,15 +169,15 @@ let rec rename_append_bytecode_list ppf packagename oc mapping defined ofs
| m :: rem ->
match m.pm_kind with
| PM_intf ->
rename_append_bytecode_list ppf packagename oc mapping defined ofs
rename_append_bytecode_list packagename oc mapping defined ofs
prefix subst rem
| PM_impl compunit ->
let size =
rename_append_bytecode ppf packagename oc mapping defined ofs
rename_append_bytecode packagename oc mapping defined ofs
prefix subst m.pm_file compunit in
let id = Ident.create_persistent m.pm_name in
let root = Path.Pident (Ident.create_persistent prefix) in
rename_append_bytecode_list ppf packagename oc mapping (id :: defined)
rename_append_bytecode_list packagename oc mapping (id :: defined)
(ofs + size) prefix
(Subst.add_module id (Path.Pdot (root, Ident.name id, Path.nopos))
subst)
@ -206,7 +206,7 @@ let build_global_target oc target_name members mapping pos coercion =
(* Build the .cmo file obtained by packaging the given .cmo files. *)
let package_object_files ppf files targetfile targetname coercion =
let package_object_files files targetfile targetname coercion =
let members =
map_left_right read_member_info files in
let required_globals =
@ -241,7 +241,7 @@ let package_object_files ppf files targetfile targetname coercion =
let pos_depl = pos_out oc in
output_binary_int oc 0;
let pos_code = pos_out oc in
let ofs = rename_append_bytecode_list ppf targetname oc mapping [] 0
let ofs = rename_append_bytecode_list targetname oc mapping [] 0
targetname Subst.identity members in
build_global_target oc targetname members mapping ofs coercion;
let pos_debug = pos_out oc in
@ -278,7 +278,7 @@ let package_object_files ppf files targetfile targetname coercion =
(* The entry point *)
let package_files ppf initial_env files targetfile =
let package_files initial_env files targetfile =
let files =
List.map
(fun f ->
@ -291,7 +291,7 @@ let package_files ppf initial_env files targetfile =
try
let coercion =
Typemod.package_units initial_env files targetcmi targetname in
package_object_files ppf files targetfile targetname coercion
package_object_files files targetfile targetname coercion
with x ->
remove_file targetfile; raise x

2
bytecomp/bytepackager.mli
View File

@ -16,7 +16,7 @@
(* "Package" a set of .cmo files into one .cmo file having the
original compilation units as sub-modules. *)
val package_files: Format.formatter -> Env.t -> string list -> string -> unit
val package_files: Env.t -> string list -> string -> unit
type error =
Forward_reference of string * Ident.t

4
driver/compmisc.ml
View File

@ -57,11 +57,11 @@ let initial_env () =
~initially_opened_module
~open_implicit_modules:(List.rev !Clflags.open_modules)
let read_color_env ppf =
let read_color_env () =
try
match Clflags.parse_color_setting (Sys.getenv "OCAML_COLOR") with
| None ->
Location.print_warning Location.none ppf
Location.prerr_warning Location.none
(Warnings.Bad_env_variable
("OCAML_COLOR",
"expected \"auto\", \"always\" or \"never\""));

2
driver/compmisc.mli
View File

@ -16,4 +16,4 @@
val init_path : ?dir:string -> bool -> unit
val initial_env : unit -> Env.t
val read_color_env : Format.formatter -> unit
val read_color_env : unit -> unit

9
driver/main.ml
View File

@ -134,7 +134,7 @@ let main () =
try
readenv ppf Before_args;
Clflags.parse_arguments anonymous usage;
Compmisc.read_color_env ppf;
Compmisc.read_color_env ();
begin try
Compenv.process_deferred_actions
(ppf,
@ -162,8 +162,7 @@ let main () =
if !make_archive then begin
Compmisc.init_path false;
Bytelibrarian.create_archive ppf
(Compenv.get_objfiles ~with_ocamlparam:false)
Bytelibrarian.create_archive (Compenv.get_objfiles ~with_ocamlparam:false)
(extract_output !output_name);
Warnings.check_fatal ();
end
@ -171,7 +170,7 @@ let main () =
Compmisc.init_path false;
let extracted_output = extract_output !output_name in
let revd = get_objfiles ~with_ocamlparam:false in
Bytepackager.package_files ppf (Compmisc.initial_env ())
Bytepackager.package_files (Compmisc.initial_env ())
revd (extracted_output);
Warnings.check_fatal ();
end
@ -193,7 +192,7 @@ let main () =
default_output !output_name
in
Compmisc.init_path false;
Bytelink.link ppf (get_objfiles ~with_ocamlparam:true) target;
Bytelink.link (get_objfiles ~with_ocamlparam:true) target;
Warnings.check_fatal ();
end;
with x ->

2
driver/optmain.ml
View File

@ -247,7 +247,7 @@ let main () =
"<options> Compute dependencies \
(use 'ocamlopt -depend -help' for details)"];
Clflags.parse_arguments anonymous usage;
Compmisc.read_color_env ppf;
Compmisc.read_color_env ();
if !gprofile && not Config.profiling then
fatal "Profiling with \"gprof\" is not supported on this platform.";
begin try

4
middle_end/middle_end.ml
View File

@ -45,11 +45,11 @@ let middle_end ppf ~prefixname ~backend
end)
in
let warning_set = ref WarningSet.empty in
let flambda_warning_printer loc _fmt w =
let flambda_warning_printer loc ppf w =
let elt = loc, w in
if not (WarningSet.mem elt !warning_set) then begin
warning_set := WarningSet.add elt !warning_set;
previous_warning_printer loc !Location.formatter_for_warnings w
previous_warning_printer loc ppf w
end;
in
Misc.protect_refs