+21 -2

.depend

reviewed

··· 114 114 utils/lazy_backtrack.cmx : \ 115 115 utils/lazy_backtrack.cmi 116 116 utils/lazy_backtrack.cmi : 117 117 + utils/linkdeps.cmo : \ 118 118 + utils/misc.cmi \ 119 119 + utils/linkdeps.cmi 120 120 + utils/linkdeps.cmx : \ 121 121 + utils/misc.cmx \ 122 122 + utils/linkdeps.cmi 123 123 + utils/linkdeps.cmi : 117 124 utils/load_path.cmo : \ 118 125 utils/misc.cmi \ 119 126 utils/local_store.cmi \ ··· 2020 2027 utils/misc.cmi \ 2021 2028 parsing/location.cmi \ 2022 2029 utils/load_path.cmi \ 2030 2030 + utils/linkdeps.cmi \ 2023 2031 bytecomp/emitcode.cmi \ 2024 2032 utils/config.cmi \ 2025 2033 file_formats/cmo_format.cmi \ ··· 2030 2038 utils/misc.cmx \ 2031 2039 parsing/location.cmx \ 2032 2040 utils/load_path.cmx \ 2041 2041 + utils/linkdeps.cmx \ 2033 2042 bytecomp/emitcode.cmx \ 2034 2043 utils/config.cmx \ 2035 2044 file_formats/cmo_format.cmi \ 2036 2045 utils/clflags.cmx \ 2037 2046 bytecomp/bytelink.cmx \ 2038 2047 bytecomp/bytelibrarian.cmi 2039 2039 - bytecomp/bytelibrarian.cmi : 2048 2048 + bytecomp/bytelibrarian.cmi : \ 2049 2049 + utils/linkdeps.cmi 2040 2050 bytecomp/bytelink.cmo : \ 2041 2051 bytecomp/symtable.cmi \ 2042 2052 bytecomp/opcodes.cmi \ 2043 2053 utils/misc.cmi \ 2044 2054 parsing/location.cmi \ 2045 2055 utils/load_path.cmi \ 2056 2056 + utils/linkdeps.cmi \ 2046 2057 bytecomp/instruct.cmi \ 2047 2058 bytecomp/emitcode.cmi \ 2048 2059 bytecomp/dll.cmi \ ··· 2059 2070 utils/misc.cmx \ 2060 2071 parsing/location.cmx \ 2061 2072 utils/load_path.cmx \ 2073 2073 + utils/linkdeps.cmx \ 2062 2074 bytecomp/instruct.cmx \ 2063 2075 bytecomp/emitcode.cmx \ 2064 2076 bytecomp/dll.cmx \ ··· 2072 2084 bytecomp/bytelink.cmi : \ 2073 2085 bytecomp/symtable.cmi \ 2074 2086 utils/misc.cmi \ 2087 2087 + utils/linkdeps.cmi \ 2075 2088 file_formats/cmo_format.cmi 2076 2089 bytecomp/bytepackager.cmo : \ 2077 2090 parsing/unit_info.cmi \ ··· 2426 2439 utils/misc.cmi \ 2427 2440 parsing/location.cmi \ 2428 2441 utils/load_path.cmi \ 2442 2442 + utils/linkdeps.cmi \ 2429 2443 middle_end/flambda/export_info.cmi \ 2430 2444 utils/config.cmi \ 2431 2445 middle_end/compilenv.cmi \ ··· 2439 2453 utils/misc.cmx \ 2440 2454 parsing/location.cmx \ 2441 2455 utils/load_path.cmx \ 2456 2456 + utils/linkdeps.cmx \ 2442 2457 middle_end/flambda/export_info.cmx \ 2443 2458 utils/config.cmx \ 2444 2459 middle_end/compilenv.cmx \ ··· 2448 2463 utils/ccomp.cmx \ 2449 2464 asmcomp/asmlink.cmx \ 2450 2465 asmcomp/asmlibrarian.cmi 2451 2451 - asmcomp/asmlibrarian.cmi : 2466 2466 + asmcomp/asmlibrarian.cmi : \ 2467 2467 + utils/linkdeps.cmi 2452 2468 asmcomp/asmlink.cmo : \ 2453 2469 asmcomp/thread_sanitizer.cmi \ 2454 2470 lambda/runtimedef.cmi \ ··· 2456 2472 utils/misc.cmi \ 2457 2473 parsing/location.cmi \ 2458 2474 utils/load_path.cmi \ 2475 2475 + utils/linkdeps.cmi \ 2459 2476 asmcomp/emitaux.cmi \ 2460 2477 asmcomp/emit.cmi \ 2461 2478 utils/consistbl.cmi \ ··· 2475 2492 utils/misc.cmx \ 2476 2493 parsing/location.cmx \ 2477 2494 utils/load_path.cmx \ 2495 2495 + utils/linkdeps.cmx \ 2478 2496 asmcomp/emitaux.cmx \ 2479 2497 asmcomp/emit.cmx \ 2480 2498 utils/consistbl.cmx \ ··· 2489 2507 asmcomp/asmlink.cmi 2490 2508 asmcomp/asmlink.cmi : \ 2491 2509 utils/misc.cmi \ 2510 2510 + utils/linkdeps.cmi \ 2492 2511 file_formats/cmx_format.cmi 2493 2512 asmcomp/asmpackager.cmo : \ 2494 2513 parsing/unit_info.cmi \

+3

Changes

reviewed

··· 37 37 38 38 ### Compiler user-interface and warnings: 39 39 40 40 + * #12084: Check link order when creating archive and when using ocamlopt 41 41 + (Hugo Heuzard, review by Stefan Muenzel and Sébastien Hinderer) 42 42 + 40 43 ### Internal/compiler-libs changes: 41 44 42 45 - #12896: Simplify the compilation of custom bytecode runtimes by explicitly

+1

Makefile

reviewed

··· 75 75 ccomp.mli ccomp.ml \ 76 76 warnings.mli warnings.ml \ 77 77 consistbl.mli consistbl.ml \ 78 78 + linkdeps.mli linkdeps.ml \ 78 79 strongly_connected_components.mli strongly_connected_components.ml \ 79 80 targetint.mli targetint.ml \ 80 81 int_replace_polymorphic_compare.mli int_replace_polymorphic_compare.ml \

+24 -8

asmcomp/asmlibrarian.ml

reviewed

··· 22 22 type error = 23 23 File_not_found of string 24 24 | Archiver_error of string 25 25 + | Link_error of Linkdeps.error 25 26 26 27 exception Error of error 27 28 ··· 44 45 The linker, which is the only one that reads .cmxa files, does not 45 46 need the approximation. *) 46 47 info.ui_export_info <- default_ui_export_info; 47 47 - (Filename.chop_suffix filename ".cmx" ^ ext_obj, (info, crc)) 48 48 + filename, (info, crc) 48 49 49 50 let create_archive file_list lib_name = 50 51 let archive_name = Filename.remove_extension lib_name ^ ext_lib in ··· 54 55 ~exceptionally:(fun () -> remove_file lib_name; remove_file archive_name) 55 56 (fun () -> 56 57 output_string outchan cmxa_magic_number; 57 57 - let (objfile_list, descr_list) = 58 58 - List.split (List.map read_info file_list) in 59 59 - List.iter2 60 60 - (fun file_name (unit, crc) -> 58 58 + let units = List.map read_info file_list in 59 59 + let objfiles = List.map (fun (filename,_) -> 60 60 + Filename.chop_suffix filename ".cmx" ^ ext_obj) 61 61 + units in 62 62 + List.iter 63 63 + (fun (file_name, (unit, crc)) -> 61 64 Asmlink.check_consistency file_name unit crc) 62 62 - file_list descr_list; 65 65 + units; 66 66 + let ldeps = Linkdeps.create ~complete:false in 67 67 + List.iter 68 68 + (fun (filename, (unit, _crc)) -> 69 69 + Linkdeps.add ldeps 70 70 + ~filename ~compunit:unit.ui_name 71 71 + ~provides:unit.ui_defines 72 72 + ~requires:(List.map fst unit.ui_imports_cmx)) 73 73 + (List.rev units); 74 74 + (match Linkdeps.check ldeps with 75 75 + | None -> () 76 76 + | Some e -> raise (Error (Link_error e))); 63 77 let infos = 64 64 - { lib_units = descr_list; 78 78 + { lib_units = List.map snd units; 65 79 lib_ccobjs = !Clflags.ccobjs; 66 80 lib_ccopts = !Clflags.all_ccopts } in 67 81 output_value outchan infos; 68 68 - if Ccomp.create_archive archive_name objfile_list <> 0 82 82 + if Ccomp.create_archive archive_name objfiles <> 0 69 83 then raise(Error(Archiver_error archive_name)); 70 84 ) 71 85 ··· 77 91 fprintf ppf "Cannot find file %a" Style.inline_code name 78 92 | Archiver_error name -> 79 93 fprintf ppf "Error while creating the library %a" Style.inline_code name 94 94 + | Link_error e -> 95 95 + Linkdeps.report_error ~print_filename:Location.print_filename ppf e 80 96 81 97 let () = 82 98 Location.register_error_of_exn

+1

asmcomp/asmlibrarian.mli

reviewed

··· 22 22 type error = 23 23 File_not_found of string 24 24 | Archiver_error of string 25 25 + | Link_error of Linkdeps.error 25 26 26 27 exception Error of error 27 28

+23 -68

asmcomp/asmlink.ml

reviewed

··· 25 25 type error = 26 26 | File_not_found of filepath 27 27 | Not_an_object_file of filepath 28 28 - | Missing_implementations of (modname * string list) list 29 28 | Inconsistent_interface of modname * filepath * filepath 30 29 | Inconsistent_implementation of modname * filepath * filepath 31 30 | Assembler_error of filepath 32 31 | Linking_error of int 33 33 - | Multiple_definition of modname * filepath * filepath 34 32 | Missing_cmx of filepath * modname 33 33 + | Link_error of Linkdeps.error 35 34 36 35 exception Error of error 37 36 ··· 44 43 module Cmx_consistbl = Consistbl.Make (Misc.Stdlib.String) 45 44 let crc_implementations = Cmx_consistbl.create () 46 45 let implementations = ref ([] : string list) 47 47 - let implementations_defined = ref ([] : (string * string) list) 48 46 let cmx_required = ref ([] : string list) 49 47 50 48 let check_consistency file_name unit crc = 51 49 begin try 52 52 - let source = List.assoc unit.ui_name !implementations_defined in 53 53 - raise (Error(Multiple_definition(unit.ui_name, file_name, source))) 54 54 - with Not_found -> () 55 55 - end; 56 56 - begin try 57 50 List.iter 58 51 (fun (name, crco) -> 59 52 interfaces := name :: !interfaces; ··· 88 81 end; 89 82 implementations := unit.ui_name :: !implementations; 90 83 Cmx_consistbl.check crc_implementations unit.ui_name crc file_name; 91 91 - implementations_defined := 92 92 - (unit.ui_name, file_name) :: !implementations_defined; 93 84 if unit.ui_symbol <> unit.ui_name then 94 85 cmx_required := unit.ui_name :: !cmx_required 95 86 ··· 123 114 124 115 (* First pass: determine which units are needed *) 125 116 126 126 - let missing_globals = (Hashtbl.create 17 : (string, string list ref) Hashtbl.t) 127 127 - 128 128 - let is_required name = 129 129 - try ignore (Hashtbl.find missing_globals name); true 130 130 - with Not_found -> false 131 131 - 132 132 - let add_required by (name, _crc) = 133 133 - try 134 134 - let rq = Hashtbl.find missing_globals name in 135 135 - rq := by :: !rq 136 136 - with Not_found -> 137 137 - Hashtbl.add missing_globals name (ref [by]) 138 138 - 139 139 - let remove_required name = 140 140 - Hashtbl.remove missing_globals name 141 141 - 142 142 - let extract_missing_globals () = 143 143 - let mg = ref [] in 144 144 - Hashtbl.iter (fun md rq -> mg := (md, !rq) :: !mg) missing_globals; 145 145 - !mg 146 146 - 147 117 type file = 148 118 | Unit of string * unit_infos * Digest.t 149 119 | Library of string * library_infos ··· 181 151 end 182 152 else raise(Error(Not_an_object_file file_name)) 183 153 184 184 - let scan_file file tolink = match file with 154 154 + let scan_file ldeps file tolink = match file with 185 155 | Unit (file_name,info,crc) -> 186 156 (* This is a .cmx file. It must be linked in any case. *) 187 187 - remove_required info.ui_name; 188 188 - List.iter (add_required file_name) info.ui_imports_cmx; 157 157 + Linkdeps.add ldeps 158 158 + ~filename:file_name ~compunit:info.ui_name 159 159 + ~provides:info.ui_defines 160 160 + ~requires:(List.map fst info.ui_imports_cmx); 189 161 (info, file_name, crc) :: tolink 190 162 | Library (file_name,infos) -> 191 163 (* This is an archive file. Each unit contained in it will be linked ··· 195 167 (fun (info, crc) reqd -> 196 168 if info.ui_force_link 197 169 || !Clflags.link_everything 198 198 - || is_required info.ui_name 170 170 + || Linkdeps.required ldeps info.ui_name 199 171 then begin 200 200 - remove_required info.ui_name; 201 201 - List.iter (add_required (Printf.sprintf "%s(%s)" 202 202 - file_name info.ui_name)) 203 203 - info.ui_imports_cmx; 172 172 + Linkdeps.add ldeps 173 173 + ~filename:file_name ~compunit:info.ui_name 174 174 + ~provides:info.ui_defines 175 175 + ~requires:(List.map fst info.ui_imports_cmx); 204 176 (info, file_name, crc) :: reqd 205 177 end else 206 178 reqd) ··· 293 265 let link_shared ~ppf_dump objfiles output_name = 294 266 Profile.record_call output_name (fun () -> 295 267 let obj_infos = List.map read_file objfiles in 296 296 - let units_tolink = List.fold_right scan_file obj_infos [] in 268 268 + let ldeps = Linkdeps.create ~complete:false in 269 269 + let units_tolink = List.fold_right (scan_file ldeps) obj_infos [] in 270 270 + (match Linkdeps.check ldeps with 271 271 + | None -> () 272 272 + | Some e -> raise (Error (Link_error e))); 297 273 List.iter 298 274 (fun (info, file_name, crc) -> check_consistency file_name info crc) 299 275 units_tolink; ··· 353 329 else if !Clflags.output_c_object then stdlib :: objfiles 354 330 else stdlib :: (objfiles @ [stdexit]) in 355 331 let obj_infos = List.map read_file objfiles in 356 356 - let units_tolink = List.fold_right scan_file obj_infos [] in 357 357 - Array.iter remove_required Runtimedef.builtin_exceptions; 358 358 - begin match extract_missing_globals() with 359 359 - [] -> () 360 360 - | mg -> raise(Error(Missing_implementations mg)) 361 361 - end; 332 332 + let ldeps = Linkdeps.create ~complete:true in 333 333 + let units_tolink = List.fold_right (scan_file ldeps) obj_infos [] in 334 334 + (match Linkdeps.check ldeps with 335 335 + | None -> () 336 336 + | Some e -> raise (Error (Link_error e))); 362 337 List.iter 363 338 (fun (info, file_name, crc) -> check_consistency file_name info crc) 364 339 units_tolink; ··· 393 368 | Not_an_object_file name -> 394 369 fprintf ppf "The file %a is not a compilation unit description" 395 370 (Style.as_inline_code Location.print_filename) name 396 396 - | Missing_implementations l -> 397 397 - let print_references ppf = function 398 398 - | [] -> () 399 399 - | r1 :: rl -> 400 400 - Style.inline_code ppf r1; 401 401 - List.iter (fun r -> fprintf ppf ",@ %a" Style.inline_code r) rl in 402 402 - let print_modules ppf = 403 403 - List.iter 404 404 - (fun (md, rq) -> 405 405 - fprintf ppf "@ @[<hov 2>%a referenced from %a@]" 406 406 - Style.inline_code md 407 407 - print_references rq) in 408 408 - fprintf ppf 409 409 - "@[<v 2>No implementations provided for the following modules:%a@]" 410 410 - print_modules l 411 371 | Inconsistent_interface(intf, file1, file2) -> 412 372 fprintf ppf 413 373 "@[<hov>Files %a@ and %a@ make inconsistent assumptions \ ··· 427 387 (Style.as_inline_code Location.print_filename) file 428 388 | Linking_error exitcode -> 429 389 fprintf ppf "Error during linking (exit code %d)" exitcode 430 430 - | Multiple_definition(modname, file1, file2) -> 431 431 - fprintf ppf 432 432 - "@[<hov>Files %a@ and %a@ both define a module named %a@]" 433 433 - (Style.as_inline_code Location.print_filename) file1 434 434 - (Style.as_inline_code Location.print_filename) file2 435 435 - Style.inline_code modname 436 390 | Missing_cmx(filename, name) -> 437 391 fprintf ppf 438 392 "@[<hov>File %a@ was compiled without access@ \ ··· 447 401 (Style.as_inline_code Location.print_filename) filename 448 402 Style.inline_code "-I" 449 403 Style.inline_code (name^".cmx") 404 404 + | Link_error e -> 405 405 + Linkdeps.report_error ~print_filename:Location.print_filename ppf e 450 406 451 407 let () = 452 408 Location.register_error_of_exn ··· 458 414 let reset () = 459 415 Cmi_consistbl.clear crc_interfaces; 460 416 Cmx_consistbl.clear crc_implementations; 461 461 - implementations_defined := []; 462 417 cmx_required := []; 463 418 interfaces := []; 464 419 implementations := [];

+1 -2

asmcomp/asmlink.mli

reviewed

··· 32 32 type error = 33 33 | File_not_found of filepath 34 34 | Not_an_object_file of filepath 35 35 - | Missing_implementations of (modname * string list) list 36 35 | Inconsistent_interface of modname * filepath * filepath 37 36 | Inconsistent_implementation of modname * filepath * filepath 38 37 | Assembler_error of filepath 39 38 | Linking_error of int 40 40 - | Multiple_definition of modname * filepath * filepath 41 39 | Missing_cmx of filepath * modname 40 40 + | Link_error of Linkdeps.error 42 41 43 42 exception Error of error 44 43

+13 -3

bytecomp/bytelibrarian.ml

reviewed

··· 22 22 type error = 23 23 File_not_found of string 24 24 | Not_an_object_file of string 25 25 + | Link_error of Linkdeps.error 25 26 26 27 exception Error of error 27 28 ··· 71 72 Bytelink.check_consistency file_name compunit; 72 73 copy_compunit ic oc compunit; 73 74 close_in ic; 74 74 - [compunit] 75 75 + [name,compunit] 75 76 end else 76 77 if buffer = cma_magic_number then begin 77 78 let toc_pos = input_binary_int ic in ··· 81 82 add_ccobjs toc; 82 83 List.iter (copy_compunit ic oc) toc.lib_units; 83 84 close_in ic; 84 84 - toc.lib_units 85 85 + List.map (fun u -> name, u) toc.lib_units 85 86 end else 86 87 raise(Error(Not_an_object_file file_name)) 87 88 with ··· 99 100 output_binary_int outchan 0; 100 101 let units = 101 102 List.flatten(List.map (copy_object_file outchan) file_list) in 103 103 + let ldeps = Linkdeps.create ~complete:false in 104 104 + List.iter 105 105 + (fun (filename,u) -> Bytelink.linkdeps_unit ldeps ~filename u) 106 106 + (List.rev units); 107 107 + (match Linkdeps.check ldeps with 108 108 + | None -> () 109 109 + | Some e -> raise (Error (Link_error e))); 102 110 let toc = 103 103 - { lib_units = units; 111 111 + { lib_units = (List.map snd units); 104 112 lib_custom = !Clflags.custom_runtime; 105 113 lib_ccobjs = !Clflags.ccobjs @ !lib_ccobjs; 106 114 lib_ccopts = !Clflags.all_ccopts @ !lib_ccopts; ··· 122 130 | Not_an_object_file name -> 123 131 fprintf ppf "The file %a is not a bytecode object file" 124 132 (Style.as_inline_code Location.print_filename) name 133 133 + | Link_error e -> 134 134 + Linkdeps.report_error ~print_filename:Location.print_filename ppf e 125 135 126 136 let () = 127 137 Location.register_error_of_exn

+1

bytecomp/bytelibrarian.mli

reviewed

··· 27 27 type error = 28 28 File_not_found of string 29 29 | Not_an_object_file of string 30 30 + | Link_error of Linkdeps.error 30 31 31 32 exception Error of error 32 33

+27 -79

bytecomp/bytelink.ml

reviewed

··· 37 37 | Custom_runtime 38 38 | File_exists of filepath 39 39 | Cannot_open_dll of filepath 40 40 - | Required_compunit_unavailable of (compunit * compunit) 41 40 | Camlheader of string * filepath 42 42 - | Wrong_link_order of DepSet.t 43 43 - | Multiple_definition of compunit * filepath * filepath 41 41 + | Link_error of Linkdeps.error 44 42 45 43 exception Error of error 46 44 ··· 97 95 98 96 (* First pass: determine which units are needed *) 99 97 100 100 - let missing_compunits = ref Compunit.Map.empty 101 101 - let provided_compunits = ref Compunit.Set.empty 102 102 - let badly_ordered_dependencies : DepSet.t ref = ref DepSet.empty 98 98 + let required compunit = 99 99 + (Symtable.required_compunits compunit.cu_reloc 100 100 + @ compunit.cu_required_compunits) 101 101 + |> List.map (fun (Compunit i) -> i) 103 102 104 104 - let record_badly_ordered_dependency dep = 105 105 - badly_ordered_dependencies := DepSet.add dep !badly_ordered_dependencies 106 106 - 107 107 - let is_required (rel, _pos) = 103 103 + let provided compunit = 104 104 + List.filter_map (fun (rel, _pos) -> 108 105 match rel with 109 109 - | Reloc_setcompunit cu -> 110 110 - Compunit.Map.mem cu !missing_compunits 111 111 - | _ -> false 106 106 + | Reloc_setcompunit (Compunit id) -> Some id 107 107 + | _ -> None) compunit.cu_reloc 112 108 113 113 - let add_required compunit = 114 114 - let add cu = 115 115 - if Compunit.Set.mem cu !provided_compunits then 116 116 - record_badly_ordered_dependency (cu, compunit.cu_name); 117 117 - missing_compunits := 118 118 - Compunit.Map.add cu compunit.cu_name !missing_compunits 119 119 - in 120 120 - List.iter add (Symtable.required_compunits compunit.cu_reloc); 121 121 - List.iter add compunit.cu_required_compunits 109 109 + let linkdeps_unit ldeps ~filename compunit = 110 110 + let requires = required compunit in 111 111 + let provides = provided compunit in 112 112 + let Compunit compunit = compunit.cu_name in 113 113 + Linkdeps.add ldeps ~filename ~compunit ~requires ~provides 122 114 123 123 - let remove_required (rel, _pos) = 124 124 - match rel with 125 125 - Reloc_setcompunit cu -> 126 126 - missing_compunits := Compunit.Map.remove cu !missing_compunits; 127 127 - provided_compunits := Compunit.Set.add cu !provided_compunits; 128 128 - | _ -> () 129 129 - 130 130 - let scan_file obj_name tolink = 115 115 + let scan_file ldeps obj_name tolink = 131 116 let file_name = 132 117 try 133 118 Load_path.find obj_name ··· 144 129 seek_in ic compunit_pos; 145 130 let compunit = (input_value ic : compilation_unit) in 146 131 close_in ic; 147 147 - add_required compunit; 148 148 - List.iter remove_required compunit.cu_reloc; 132 132 + linkdeps_unit ldeps ~filename:obj_name compunit; 149 133 Link_object(file_name, compunit) :: tolink 150 134 end 151 135 else if buffer = cma_magic_number then begin ··· 159 143 let required = 160 144 List.fold_right 161 145 (fun compunit reqd -> 146 146 + let Compunit name = compunit.cu_name in 162 147 if compunit.cu_force_link 163 148 || !Clflags.link_everything 164 164 - || List.exists is_required compunit.cu_reloc 149 149 + || Linkdeps.required ldeps name 165 150 then begin 166 166 - add_required compunit; 167 167 - List.iter remove_required compunit.cu_reloc; 151 151 + linkdeps_unit ldeps ~filename:obj_name compunit; 168 152 compunit :: reqd 169 153 end else 170 154 reqd) ··· 184 168 185 169 let crc_interfaces = Consistbl.create () 186 170 let interfaces = ref ([] : string list) 187 187 - let implementations_defined = ref ([] : (compunit * string) list) 188 171 189 172 let check_consistency file_name cu = 190 190 - begin try 191 191 - let source = List.assoc cu.cu_name !implementations_defined in 192 192 - raise (Error (Multiple_definition(cu.cu_name, file_name, source))); 193 193 - with Not_found -> () 194 194 - end; 195 195 - begin try 173 173 + try 196 174 List.iter 197 175 (fun (name, crco) -> 198 176 interfaces := name :: !interfaces; ··· 206 184 original_source = auth; 207 185 } -> 208 186 raise(Error(Inconsistent_import(name, user, auth))) 209 209 - end; 210 210 - implementations_defined := 211 211 - (cu.cu_name, file_name) :: !implementations_defined 212 187 213 188 let extract_crc_interfaces () = 214 189 Consistbl.extract !interfaces crc_interfaces ··· 655 630 | false, true, false -> "stdlib.cma" :: objfiles 656 631 | _ -> "stdlib.cma" :: objfiles @ ["std_exit.cmo"] 657 632 in 658 658 - let tolink = List.fold_right scan_file objfiles [] in 659 659 - begin 660 660 - match Compunit.Map.bindings !missing_compunits with 661 661 - | [] -> () 662 662 - | missing_dependency :: _ -> 663 663 - if DepSet.is_empty !badly_ordered_dependencies 664 664 - then 665 665 - raise (Error (Required_compunit_unavailable missing_dependency)) 666 666 - else 667 667 - raise (Error (Wrong_link_order !badly_ordered_dependencies)) 668 668 - end; 633 633 + let ldeps = Linkdeps.create ~complete:true in 634 634 + let tolink = List.fold_right (scan_file ldeps) objfiles [] in 635 635 + (match Linkdeps.check ldeps with 636 636 + | None -> () 637 637 + | Some e -> raise (Error (Link_error e))); 669 638 Clflags.ccobjs := !Clflags.ccobjs @ !lib_ccobjs; (* put user's libs last *) 670 639 Clflags.all_ccopts := !lib_ccopts @ !Clflags.all_ccopts; 671 640 (* put user's opts first *) ··· 797 766 | Cannot_open_dll file -> 798 767 fprintf ppf "Error on dynamically loaded library: %a" 799 768 Location.print_filename file 800 800 - | Required_compunit_unavailable 801 801 - (Compunit unavailable, Compunit required_by) -> 802 802 - fprintf ppf "Module %a is unavailable (required by %a)" 803 803 - Style.inline_code unavailable 804 804 - Style.inline_code required_by 805 769 | Camlheader (msg, header) -> 806 770 fprintf ppf "System error while copying file %a: %a" 807 771 Style.inline_code header 808 772 Style.inline_code msg 809 809 - | Wrong_link_order depset -> 810 810 - let l = DepSet.elements depset in 811 811 - let depends_on ppf (dep, depending) = 812 812 - fprintf ppf "%a depends on %a" 813 813 - Style.inline_code (Compunit.name depending) 814 814 - Style.inline_code (Compunit.name dep) 815 815 - in 816 816 - fprintf ppf "@[<hov 2>Wrong link order: %a@]" 817 817 - (pp_print_list ~pp_sep:(fun ppf () -> fprintf ppf ",@ ") depends_on) l 818 818 - | Multiple_definition(compunit, file1, file2) -> 819 819 - fprintf ppf 820 820 - "@[<hov>Files %a@ and %a@ both define a module named %a@]" 821 821 - (Style.as_inline_code Location.print_filename) file1 822 822 - (Style.as_inline_code Location.print_filename) file2 823 823 - Style.inline_code (Compunit.name compunit) 824 824 - 773 773 + | Link_error e -> 774 774 + Linkdeps.report_error ~print_filename:Location.print_filename ppf e 825 775 826 776 let () = 827 777 Location.register_error_of_exn ··· 834 784 lib_ccobjs := []; 835 785 lib_ccopts := []; 836 786 lib_dllibs := []; 837 837 - missing_compunits := Compunit.Map.empty; 838 787 Consistbl.clear crc_interfaces; 839 839 - implementations_defined := []; 840 788 debug_info := []; 841 789 output_code_string_counter := 0

+3 -3

bytecomp/bytelink.mli

reviewed

··· 25 25 val reset : unit -> unit 26 26 27 27 val check_consistency: filepath -> Cmo_format.compilation_unit -> unit 28 28 + val linkdeps_unit : 29 29 + Linkdeps.t -> filename:string -> Cmo_format.compilation_unit -> unit 28 30 29 31 val extract_crc_interfaces: unit -> crcs 30 32 ··· 37 39 | Custom_runtime 38 40 | File_exists of filepath 39 41 | Cannot_open_dll of filepath 40 40 - | Required_compunit_unavailable of (Cmo_format.compunit * Cmo_format.compunit) 41 42 | Camlheader of string * filepath 42 42 - | Wrong_link_order of DepSet.t 43 43 - | Multiple_definition of Cmo_format.compunit * filepath * filepath 43 43 + | Link_error of Linkdeps.error 44 44 45 45 exception Error of error 46 46

+6 -1

testsuite/tests/badly-ordered-deps/main.bytecode.reference

reviewed

··· 1 1 File "_none_", line 1: 2 2 - Error: Wrong link order: "Lib" depends on "Main" 2 2 + Error: Wrong link order: "Lib" (lib.cmo) depends on "Main" (main.cmo) 3 3 + File "_none_", line 1: 4 4 + Error: Wrong link order: "Lib" (lib.cmo) depends on "Main" (main.cmo) 5 5 + File "_none_", line 1: 6 6 + Error: No implementation provided for the following modules: 7 7 + "Main" referenced from "Lib" (lib.cmo)

+52 -12

testsuite/tests/badly-ordered-deps/main.ml

reviewed

··· 1 1 (* TEST 2 2 modules = "lib.ml"; 3 3 - setup-ocamlc.byte-build-env; 4 4 - all_modules = "main.ml"; 5 5 - compile_only = "true"; 6 6 - ocamlc.byte; 7 7 - all_modules = "lib.ml"; 8 8 - ocamlc.byte; 9 9 - all_modules = "lib.cmo main.cmo"; 10 10 - compile_only = "false"; 11 11 - ocamlc_byte_exit_status = "2"; 12 12 - ocamlc.byte; 13 13 - check-ocamlc.byte-output; 3 3 + { 4 4 + setup-ocamlc.byte-build-env; 5 5 + all_modules = "main.ml"; 6 6 + compile_only = "true"; 7 7 + ocamlc.byte; 8 8 + all_modules = "lib.ml"; 9 9 + ocamlc.byte; 10 10 + { 11 11 + all_modules = "lib.cmo main.cmo"; 12 12 + compile_only = "false"; 13 13 + ocamlc_byte_exit_status = "2"; 14 14 + ocamlc.byte; 15 15 + }{ 16 16 + all_modules = "lib.cmo main.cmo"; 17 17 + compile_only = "false"; 18 18 + ocamlc_byte_exit_status = "2"; 19 19 + flags = "-a"; 20 20 + ocamlc.byte; 21 21 + }{ 22 22 + all_modules = "lib.cmo"; 23 23 + compile_only = "false"; 24 24 + ocamlc_byte_exit_status = "2"; 25 25 + ocamlc.byte; 26 26 + check-ocamlc.byte-output; 27 27 + } 28 28 + }{ 29 29 + setup-ocamlopt.byte-build-env; 30 30 + all_modules = "main.ml"; 31 31 + compile_only = "true"; 32 32 + ocamlopt.byte; 33 33 + all_modules = "lib.ml"; 34 34 + ocamlopt.byte; 35 35 + { 36 36 + all_modules = "lib.cmx main.cmx"; 37 37 + compile_only = "false"; 38 38 + ocamlopt_byte_exit_status = "2"; 39 39 + ocamlopt.byte; 40 40 + }{ 41 41 + all_modules = "lib.cmx main.cmx"; 42 42 + compile_only = "false"; 43 43 + ocamlopt_byte_exit_status = "2"; 44 44 + flags = "-a"; 45 45 + ocamlopt.byte; 46 46 + }{ 47 47 + all_modules = "lib.cmx"; 48 48 + compile_only = "false"; 49 49 + ocamlopt_byte_exit_status = "2"; 50 50 + ocamlopt.byte; 51 51 + check-ocamlopt.byte-output; 52 52 + } 53 53 + } 14 54 *) 15 55 16 16 - (* Make sure ocamlc prints badly ordered dependencies only once. 56 56 + (* Make sure ocamlc and ocamlopt print badly ordered dependencies only once. 17 57 See issue #12074. We test with ocamlc.byte only. *) 18 58 19 59 let value = ()

+7

testsuite/tests/badly-ordered-deps/main.native.reference

reviewed

··· 1 1 + File "_none_", line 1: 2 2 + Error: Wrong link order: "Lib" (lib.cmx) depends on "Main" (main.cmx) 3 3 + File "_none_", line 1: 4 4 + Error: Wrong link order: "Lib" (lib.cmx) depends on "Main" (main.cmx) 5 5 + File "_none_", line 1: 6 6 + Error: No implementation provided for the following modules: 7 7 + "Main" referenced from "Lib" (lib.cmx)

-70

testsuite/tests/lib-dynlink-initializers/test4_main.ml

reviewed

··· 1 1 - (* TEST 2 2 - include dynlink; 3 3 - readonly_files = "test4_plugin_a.ml test4_plugin_b.ml"; 4 4 - libraries = ""; 5 5 - shared-libraries; 6 6 - { 7 7 - setup-ocamlc.byte-build-env; 8 8 - { 9 9 - module = "test4_main.ml"; 10 10 - ocamlc.byte; 11 11 - }{ 12 12 - module = "test4_plugin_b.ml"; 13 13 - ocamlc.byte; 14 14 - }{ 15 15 - module = "test4_plugin_a.ml"; 16 16 - ocamlc.byte; 17 17 - }{ 18 18 - program = "test4_plugin.cma"; 19 19 - flags = "-a"; 20 20 - all_modules = "test4_plugin_a.cmo test4_plugin_b.cmo"; 21 21 - ocamlc.byte; 22 22 - }{ 23 23 - program = "${test_build_directory}/test4.byte"; 24 24 - libraries = "dynlink"; 25 25 - all_modules = "test4_main.cmo"; 26 26 - ocamlc.byte; 27 27 - run; 28 28 - } 29 29 - }{ 30 30 - native-dynlink; 31 31 - setup-ocamlopt.byte-build-env; 32 32 - { 33 33 - module = "test4_main.ml"; 34 34 - ocamlopt.byte; 35 35 - }{ 36 36 - module = "test4_plugin_b.ml"; 37 37 - ocamlopt.byte; 38 38 - }{ 39 39 - module = "test4_plugin_a.ml"; 40 40 - ocamlopt.byte; 41 41 - }{ 42 42 - program = "test4_plugin.cmxs"; 43 43 - flags = "-shared"; 44 44 - all_modules = "test4_plugin_a.cmx test4_plugin_b.cmx"; 45 45 - ocamlopt.byte; 46 46 - }{ 47 47 - program = "${test_build_directory}/test4.exe"; 48 48 - libraries = "dynlink"; 49 49 - all_modules = "test4_main.cmx"; 50 50 - ocamlopt.byte; 51 51 - run; 52 52 - } 53 53 - } 54 54 - *) 55 55 - 56 56 - (* Check that a module in a shared library cannot refer to another 57 57 - module in the same shared library if it has not yet been loaded. *) 58 58 - 59 59 - let () = 60 60 - try 61 61 - if Dynlink.is_native then begin 62 62 - Dynlink.loadfile "test4_plugin.cmxs" 63 63 - end else begin 64 64 - Dynlink.loadfile "test4_plugin.cma" 65 65 - end; 66 66 - assert false 67 67 - with 68 68 - | Dynlink.Error ( 69 69 - Dynlink.Linking_error (_, 70 70 - Dynlink.Uninitialized_global "Test4_plugin_b")) -> ()

-2

testsuite/tests/lib-dynlink-initializers/test4_plugin_a.ml

reviewed

··· 1 1 - let () = 2 2 - print_int (Test4_plugin_b.f 42)

-1

testsuite/tests/lib-dynlink-initializers/test4_plugin_b.ml

reviewed

··· 1 1 - let f x = x + 3 [@@inline never]

+139

utils/linkdeps.ml

reviewed

··· 1 1 + (**************************************************************************) 2 2 + (* *) 3 3 + (* OCaml *) 4 4 + (* *) 5 5 + (* Hugo Heuzard *) 6 6 + (* *) 7 7 + (* Copyright 2020 Institut National de Recherche en Informatique et *) 8 8 + (* en Automatique. *) 9 9 + (* *) 10 10 + (* All rights reserved. This file is distributed under the terms of *) 11 11 + (* the GNU Lesser General Public License version 2.1, with the *) 12 12 + (* special exception on linking described in the file LICENSE. *) 13 13 + (* *) 14 14 + (**************************************************************************) 15 15 + 16 16 + module Style = Misc.Style 17 17 + 18 18 + type compunit = string 19 19 + 20 20 + type filename = string 21 21 + 22 22 + type compunit_and_source = { 23 23 + compunit : compunit; 24 24 + filename : filename; 25 25 + } 26 26 + 27 27 + module Compunit_and_source = struct 28 28 + type t = compunit_and_source 29 29 + module Set = Set.Make(struct type nonrec t = t let compare = compare end) 30 30 + end 31 31 + 32 32 + type refs = Compunit_and_source.Set.t 33 33 + 34 34 + type t = { 35 35 + complete : bool; 36 36 + missing_compunits : (compunit, refs) Hashtbl.t; 37 37 + provided_compunits : (compunit, filename list) Hashtbl.t; 38 38 + badly_ordered_deps : (Compunit_and_source.t, refs) Hashtbl.t; 39 39 + } 40 40 + 41 41 + type error = 42 42 + | Missing_implementations of (compunit * compunit_and_source list) list 43 43 + | Wrong_link_order of (compunit_and_source * compunit_and_source list) list 44 44 + | Multiple_definitions of (compunit * filename list) list 45 45 + 46 46 + let create ~complete = { 47 47 + complete; 48 48 + missing_compunits = Hashtbl.create 17; 49 49 + provided_compunits = Hashtbl.create 17; 50 50 + badly_ordered_deps = Hashtbl.create 17; 51 51 + } 52 52 + 53 53 + let required t compunit = Hashtbl.mem t.missing_compunits compunit 54 54 + 55 55 + let update t k f = 56 56 + let v = Hashtbl.find_opt t k in 57 57 + Hashtbl.replace t k (f v) 58 58 + 59 59 + let add_required t by (name : string) = 60 60 + let add s = 61 61 + Compunit_and_source.Set.add by 62 62 + (Option.value s ~default:Compunit_and_source.Set.empty) in 63 63 + (try 64 64 + let filename = List.hd (Hashtbl.find t.provided_compunits name) in 65 65 + update t.badly_ordered_deps {compunit = name; filename } add 66 66 + with Not_found -> ()); 67 67 + update t.missing_compunits name add 68 68 + 69 69 + let add t ~filename ~compunit ~provides ~requires = 70 70 + List.iter (add_required t {compunit; filename}) requires; 71 71 + List.iter (fun p -> 72 72 + Hashtbl.remove t.missing_compunits p; 73 73 + let l = Option.value ~default:[] 74 74 + (Hashtbl.find_opt t.provided_compunits p) in 75 75 + Hashtbl.replace t.provided_compunits p (filename :: l)) provides 76 76 + 77 77 + let check t = 78 78 + let of_seq s = 79 79 + Seq.map (fun (k,v) -> k, Compunit_and_source.Set.elements v) s 80 80 + |> List.of_seq 81 81 + in 82 82 + let missing = of_seq (Hashtbl.to_seq t.missing_compunits) in 83 83 + let badly_ordered_deps = of_seq (Hashtbl.to_seq t.badly_ordered_deps) in 84 84 + let duplicated = 85 85 + Hashtbl.to_seq t.provided_compunits 86 86 + |> Seq.filter (fun (_, files) -> List.compare_length_with files 1 > 0) 87 87 + |> List.of_seq 88 88 + in 89 89 + match duplicated, badly_ordered_deps, missing with 90 90 + | [], [], [] -> None 91 91 + | [], [], l -> 92 92 + if t.complete 93 93 + then Some (Missing_implementations l) 94 94 + else None 95 95 + | [], l, _ -> 96 96 + Some (Wrong_link_order l) 97 97 + | l, _, _ -> 98 98 + Some (Multiple_definitions l) 99 99 + 100 100 + (* Error report *) 101 101 + 102 102 + open Format 103 103 + 104 104 + let print_reference print_fname ppf {compunit; filename} = 105 105 + fprintf ppf "%a (%a)" Style.inline_code compunit print_fname filename 106 106 + 107 107 + let pp_list_comma f = 108 108 + pp_print_list ~pp_sep:(fun ppf () -> fprintf ppf ",@ ") f 109 109 + 110 110 + let report_error ~print_filename ppf = function 111 111 + | Missing_implementations l -> 112 112 + let print_modules ppf = 113 113 + List.iter 114 114 + (fun (md, rq) -> 115 115 + fprintf ppf "@ @[<hov 2>%a referenced from %a@]" 116 116 + Style.inline_code md 117 117 + (pp_list_comma (print_reference print_filename)) rq) 118 118 + in 119 119 + fprintf ppf 120 120 + "@[<v 2>No implementation provided for the following modules:%a@]" 121 121 + print_modules l 122 122 + | Wrong_link_order l -> 123 123 + let depends_on ppf (dep, depending) = 124 124 + fprintf ppf "@ @[<hov 2>%a depends on %a@]" 125 125 + (pp_list_comma (print_reference print_filename)) depending 126 126 + (print_reference print_filename) dep 127 127 + in 128 128 + fprintf ppf "@[<hov 2>Wrong link order:%a@]" 129 129 + (pp_list_comma depends_on) l 130 130 + | Multiple_definitions l -> 131 131 + let print ppf (compunit, files) = 132 132 + fprintf ppf 133 133 + "@ @[<hov>Multiple definitions of module %a in files %a@]" 134 134 + Style.inline_code compunit 135 135 + (pp_list_comma (Style.as_inline_code print_filename)) files 136 136 + 137 137 + in 138 138 + fprintf ppf "@[<hov 2> Duplicated implementations:%a@]" 139 139 + (pp_list_comma print) l

+64

utils/linkdeps.mli

reviewed

··· 1 1 + (**************************************************************************) 2 2 + (* *) 3 3 + (* OCaml *) 4 4 + (* *) 5 5 + (* Hugo Heuzard *) 6 6 + (* *) 7 7 + (* Copyright 2020 Institut National de Recherche en Informatique et *) 8 8 + (* en Automatique. *) 9 9 + (* *) 10 10 + (* All rights reserved. This file is distributed under the terms of *) 11 11 + (* the GNU Lesser General Public License version 2.1, with the *) 12 12 + (* special exception on linking described in the file LICENSE. *) 13 13 + (* *) 14 14 + (**************************************************************************) 15 15 + 16 16 + type t 17 17 + (** The state of the linking check. 18 18 + It keeps track of compilation units provided and required so far. *) 19 19 + 20 20 + type compunit = string 21 21 + 22 22 + type filename = string 23 23 + 24 24 + val create : complete:bool -> t 25 25 + (** [create ~complete] returns an empty state. If [complete] is 26 26 + [true], missing compilation units will be treated as errors. *) 27 27 + 28 28 + val add : t 29 29 + -> filename:filename -> compunit:compunit 30 30 + -> provides:compunit list -> requires:compunit list -> unit 31 31 + (** [add t ~filename ~compunit ~provides ~requires] registers the 32 32 + compilation unit [compunit] found in [filename] to [t]. 33 33 + - [provides] are units and sub-units provided by [compunit] 34 34 + - [requires] are units required by [compunit] 35 35 + 36 36 + [add] should be called in reverse topological order. *) 37 37 + 38 38 + val required : t -> compunit -> bool 39 39 + (** [required t compunit] returns [true] if [compunit] is a dependency of 40 40 + previously added compilation units. *) 41 41 + 42 42 + type compunit_and_source = { 43 43 + compunit : compunit; 44 44 + filename : filename; 45 45 + } 46 46 + 47 47 + type error = 48 48 + | Missing_implementations of (compunit * compunit_and_source list) list 49 49 + | Wrong_link_order of (compunit_and_source * compunit_and_source list) list 50 50 + | Multiple_definitions of (compunit * filename list) list 51 51 + 52 52 + val check : t -> error option 53 53 + (** [check t] should be called once all the compilation units to be linked 54 54 + have been added. It retuns some error if: 55 55 + - There are some missing implementations 56 56 + and [complete] is [true] 57 57 + - Some implementation appear 58 58 + before their dependencies *) 59 59 + 60 60 + open Format 61 61 + 62 62 + val report_error 63 63 + : print_filename:(formatter -> string -> unit) 64 64 + -> formatter -> error -> unit