Add an early error when compiling different modules with mismatching …

…-for-pack (#1391)

If module A is built with -for-pack X and module B with -for-pack Y and
A uses B, this will trigger when building A (with ocamlopt) rather than
when linking, or when building some further module using both A and B.

Changes

@@ -96,6 +96,10 @@ Working version
 - #10911: Improve the location reported by parenthesized assert expressions
   (Fabian Hemmer, review by Gabriel Scherer)
 
+- #1391, #7645, #3922: Add an early error when compiling different
+  modules with mismatching -for-pack
+  (Pierre Chambart and Vincent Laviron, review by Mark Shinwell)
+
 ### Internal/compiler-libs changes:
 - #11027: Separate typing counter-examples from type_pat into retype_pat;
   type_pat is no longer in CPS.

asmcomp/asmpackager.ml

@@ -232,6 +232,7 @@ let build_package_cmx members cmxfile =
       ui_force_link =
           List.exists (fun info -> info.ui_force_link) units;
       ui_export_info;
+      ui_for_pack = None;
     } in
   Compilenv.write_unit_info pkg_infos cmxfile
 

file_formats/cmx_format.mli

@@ -45,7 +45,8 @@ type unit_infos =
     mutable ui_apply_fun: int list;       (* Apply functions needed *)
     mutable ui_send_fun: int list;        (* Send functions needed *)
     mutable ui_export_info: export_info;
-    mutable ui_force_link: bool }         (* Always linked *)
+    mutable ui_force_link: bool;          (* Always linked *)
+    mutable ui_for_pack: string option }  (* Part of a pack *)
 
 (* Each .a library has a matching .cmxa file that provides the following
    infos on the library: *)

middle_end/compilenv.ml

@@ -28,6 +28,7 @@ type error =
     Not_a_unit_info of string
   | Corrupted_unit_info of string
   | Illegal_renaming of string * string * string
+  | Mismatching_for_pack of string * string * string * string option
 
 exception Error of error
 
@@ -86,7 +87,8 @@ let current_unit =
     ui_apply_fun = [];
     ui_send_fun = [];
     ui_force_link = false;
-    ui_export_info = default_ui_export_info }
+    ui_export_info = default_ui_export_info;
+    ui_for_pack = None }
 
 let concat_symbol unitname id =
   unitname ^ "." ^ id
@@ -120,6 +122,7 @@ let reset ?packname name =
   current_unit.ui_apply_fun <- [];
   current_unit.ui_send_fun <- [];
   current_unit.ui_force_link <- !Clflags.link_everything;
+  current_unit.ui_for_pack <- packname;
   Hashtbl.clear exported_constants;
   structured_constants := structured_constants_empty;
   current_unit.ui_export_info <- default_ui_export_info;
@@ -192,6 +195,16 @@ let get_global_info global_ident = (
             let (ui, crc) = read_unit_info filename in
             if ui.ui_name <> modname then
               raise(Error(Illegal_renaming(modname, ui.ui_name, filename)));
+            (* Linking to a compilation unit expected to go into a
+               pack (ui_for_pack = Some ...) is possible only from
+               inside the same pack, but it is perfectly ok to link to
+               an unit outside of the pack. *)
+            (match ui.ui_for_pack, current_unit.ui_for_pack with
+             | None, _ -> ()
+             | Some p1, Some p2 when String.equal p1 p2 -> ()
+             | Some p1, p2 ->
+               raise (Error (Mismatching_for_pack
+                               (filename, p1, current_unit.ui_name, p2))));
             (Some ui, Some crc)
           with Not_found ->
             let warn = Warnings.No_cmx_file modname in
@@ -439,6 +452,14 @@ let report_error ppf = function
       fprintf ppf "%a@ contains the description for unit\
                    @ %s when %s was expected"
         Location.print_filename filename name modname
+  | Mismatching_for_pack(filename, pack_1, current_unit, None) ->
+      fprintf ppf "%a@ was built with -for-pack %s, but the \
+                   @ current unit %s is not"
+        Location.print_filename filename pack_1 current_unit
+  | Mismatching_for_pack(filename, pack_1, current_unit, Some pack_2) ->
+      fprintf ppf "%a@ was built with -for-pack %s, but the \
+                   @ current unit %s is built with -for-pack %s"
+        Location.print_filename filename pack_1 current_unit pack_2
 
 let () =
   Location.register_error_of_exn

middle_end/compilenv.mli

@@ -151,6 +151,7 @@ type error =
     Not_a_unit_info of string
   | Corrupted_unit_info of string
   | Illegal_renaming of string * string * string
+  | Mismatching_for_pack of string * string * string * string option
 
 exception Error of error
 

testsuite/tests/lib-dynlink-native/main.ml

@@ -95,99 +95,91 @@ flags = "-shared"
 all_modules = "packed1.cmx"
 **************************** ocamlopt.byte
 flags = ""
-module = "packed1_client.ml"
-***************************** ocamlopt.byte
-module = ""
-program = "packed1_client.so"
-flags = "-shared"
-all_modules = "packed1_client.cmx"
-****************************** ocamlopt.byte
-flags = ""
 module = "pack_client.ml"
-******************************* ocamlopt.byte
+***************************** ocamlopt.byte
 module = ""
 program = "pack_client.so"
 flags = "-shared"
 all_modules = "pack_client.cmx"
-******************************** ocamlopt.byte
+****************************** ocamlopt.byte
 flags = ""
 module = "plugin_ref.ml"
-********************************* ocamlopt.byte
+******************************* ocamlopt.byte
 module = ""
 program = "plugin_ref.so"
 flags = "-shared"
 all_modules = "plugin_ref.cmx"
-********************************** ocamlopt.byte
+******************************** ocamlopt.byte
 flags = ""
 module = "plugin_high_arity.ml"
-*********************************** ocamlopt.byte
+********************************* ocamlopt.byte
 module = ""
 program = "plugin_high_arity.so"
 flags = "-shared"
 all_modules = "plugin_high_arity.cmx"
-************************************ ocamlopt.byte
+********************************** ocamlopt.byte
 flags = "-ccopt ${shared_library_cflags}"
 module = "factorial.c"
-************************************* ocamlopt.byte
+*********************************** ocamlopt.byte
 flags = ""
 module = "plugin_ext.ml"
-************************************** ocamlopt.byte
+************************************ ocamlopt.byte
 module = ""
 program = "plugin_ext.so"
 flags = "-shared"
 all_modules = "factorial.${objext} plugin_ext.cmx"
-*************************************** ocamlopt.byte
+************************************* ocamlopt.byte
 module = "plugin_simple.ml"
 flags = ""
-**************************************** ocamlopt.byte
+************************************** ocamlopt.byte
 module = ""
 program = "plugin_simple.so"
 flags = "-shared"
 all_modules = "plugin_simple.cmx"
-**************************************** ocamlopt.byte
+************************************** ocamlopt.byte
 module = "bug.ml"
 flags = ""
-***************************************** ocamlopt.byte
+*************************************** ocamlopt.byte
 module = ""
 program = "bug.so"
 flags = "-shared"
 all_modules = "bug.cmx"
-***************************************** ocamlopt.byte
+*************************************** ocamlopt.byte
 module = "plugin_thread.ml"
 flags = ""
-****************************************** ocamlopt.byte
+**************************************** ocamlopt.byte
 module = ""
 program = "plugin_thread.so"
 flags = "-shared"
 all_modules = "plugin_thread.cmx"
-******************************************* ocamlopt.byte
+***************************************** ocamlopt.byte
 program = "plugin4_unix.so"
 all_modules = "unix.cmxa plugin4.cmx"
-******************************************** ocamlopt.byte
+****************************************** ocamlopt.byte
 flags = ""
 compile_only = "true"
 all_modules = "a.ml b.ml c.ml main.ml"
-********************************************* ocamlopt.byte
+******************************************* ocamlopt.byte
 module = ""
 compile_only = "false"
 flags = "-shared"
 program = "a.so"
 all_modules = "a.cmx"
-********************************************** ocamlopt.byte
+******************************************** ocamlopt.byte
 program = "b.so"
 all_modules = "b.cmx"
-*********************************************** ocamlopt.byte
+********************************************* ocamlopt.byte
 program = "c.so"
 all_modules = "c.cmx"
-************************************************ ocamlopt.byte
+********************************************** ocamlopt.byte
 program = "mylib.cmxa"
 flags = "-a"
 all_modules = "plugin.cmx plugin2.cmx"
-************************************************* ocamlopt.byte
+*********************************************** ocamlopt.byte
 program = "mylib.so"
 flags = "-shared -linkall"
 all_modules = "mylib.cmxa"
-************************************************** ocamlopt.byte
+************************************************ ocamlopt.byte
 program = "${test_build_directory}/main.exe"
 libraries = "unix threads dynlink"
 flags = "-linkall"
@@ -202,9 +194,9 @@ We thus do not check compiler output. This was not done either before the
 test was ported to ocamltest.
 *)
 
-*************************************************** run
+************************************************* run
 arguments = "plugin.so plugin2.so plugin_thread.so"
-**************************************************** check-program-output
+************************************************** check-program-output
 *)
 
 let () =

tools/objinfo.ml

@@ -180,7 +180,11 @@ let print_cmx_infos (ui, crc) =
   printf "Currying functions:%a\n" pr_funs ui.ui_curry_fun;
   printf "Apply functions:%a\n" pr_funs ui.ui_apply_fun;
   printf "Send functions:%a\n" pr_funs ui.ui_send_fun;
-  printf "Force link: %s\n" (if ui.ui_force_link then "YES" else "no")
+  printf "Force link: %s\n" (if ui.ui_force_link then "YES" else "no");
+  printf "For pack: %s\n"
+    (match ui.ui_for_pack with
+     | None -> "no"
+     | Some pack -> "YES: " ^ pack)
 
 let print_cmxa_infos (lib : Cmx_format.library_infos) =
   printf "Extra C object files:";