From 5562ce95c85f6db0b7e5938bd3a11f09ee8072f4 Mon Sep 17 00:00:00 2001 From: Andrey Mokhov Date: Fri, 11 Oct 2019 20:45:16 +0100 Subject: [PATCH] Add support for generated headers Signed-off-by: Andrey Mokhov --- src/dune/exe.ml | 10 +- src/dune/exe.mli | 4 +- src/dune/exe_rules.ml | 23 ++- src/dune/foreign_sources.ml | 1 + src/dune/inline_tests.ml | 2 +- src/dune/lib_rules.ml | 27 ++- src/dune/toplevel.ml | 2 +- .../test-cases/foreign-library/run.t | 175 +++++++++++------- 8 files changed, 152 insertions(+), 92 deletions(-) diff --git a/src/dune/exe.ml b/src/dune/exe.ml index f6fc4f6d1f9c..6e6f50fe9262 100644 --- a/src/dune/exe.ml +++ b/src/dune/exe.ml @@ -119,7 +119,8 @@ let exe_path_from_name cctx ~name ~(linkage : Linkage.t) = Path.Build.relative (CC.dir cctx) (name ^ linkage.ext) let link_exe ~loc ~name ~(linkage : Linkage.t) ~cm_files ~link_time_code_gen - ~promote ?(link_flags = Build.return []) ?(o_files = []) cctx = + ~promote ?(link_args = Build.return Command.Args.empty) ?(o_files = []) + cctx = let sctx = CC.super_context cctx in let ctx = SC.context sctx in let dir = CC.dir cctx in @@ -151,7 +152,7 @@ let link_exe ~loc ~name ~(linkage : Linkage.t) ~cm_files ~link_time_code_gen ; A "-o" ; Target exe ; As linkage.flags - ; Command.Args.dyn link_flags + ; Command.Args.Dyn link_args ; Command.of_result_map link_time_code_gen ~f:(fun { Link_time_code_gen.to_link; force_linkall } -> S @@ -182,8 +183,7 @@ let link_js ~name ~cm_files ~promote cctx = Js_of_ocaml_rules.build_exe cctx ~js_of_ocaml ~src ~cm:top_sorted_cms ~flags:(Command.Args.dyn flags) ~promote -let build_and_link_many ~programs ~linkages ~promote ?link_flags ?o_files cctx - = +let build_and_link_many ~programs ~linkages ~promote ?link_args ?o_files cctx = let modules = Compilation_context.modules cctx in let dep_graphs = Dep_rules.rules cctx ~modules in Module_compilation.build_all cctx ~dep_graphs; @@ -207,7 +207,7 @@ let build_and_link_many ~programs ~linkages ~promote ?link_flags ?o_files cctx link_js ~name ~cm_files ~promote cctx else link_exe cctx ~loc ~name ~linkage ~cm_files ~link_time_code_gen - ~promote ?link_flags ?o_files)) + ~promote ?link_args ?o_files)) let build_and_link ~program = build_and_link_many ~programs:[ program ] diff --git a/src/dune/exe.mli b/src/dune/exe.mli index f2cad9954edf..eda43c4e6880 100644 --- a/src/dune/exe.mli +++ b/src/dune/exe.mli @@ -41,7 +41,7 @@ val build_and_link : program:Program.t -> linkages:Linkage.t list -> promote:Dune_file.Promote.t option - -> ?link_flags:string list Build.t + -> ?link_args:Command.Args.static Command.Args.t Build.t -> ?o_files:Path.t list -> Compilation_context.t -> unit @@ -50,7 +50,7 @@ val build_and_link_many : programs:Program.t list -> linkages:Linkage.t list -> promote:Dune_file.Promote.t option - -> ?link_flags:string list Build.t + -> ?link_args:Command.Args.static Command.Args.t Build.t -> ?o_files:Path.t list -> Compilation_context.t -> unit diff --git a/src/dune/exe_rules.ml b/src/dune/exe_rules.ml index 83d6ea78ea14..650b6886d0d3 100644 --- a/src/dune/exe_rules.ml +++ b/src/dune/exe_rules.ml @@ -43,10 +43,10 @@ let executables_rules ~sctx ~dir ~expander ~dir_contents ~scope ~compile_info (Module_name.to_string mod_name) ]) in + let ctx = SC.context sctx in let explicit_js_mode = Dune_project.explicit_js_mode (Scope.project scope) in let linkages = let module L = Dune_file.Executables.Link_mode in - let ctx = SC.context sctx in let l = let has_native = Option.is_some ctx.ocamlopt in let modes = @@ -85,11 +85,22 @@ let executables_rules ~sctx ~dir ~expander ~dir_contents ~scope ~compile_info >>> Expander.expand_and_eval_set expander exes.link_flags ~standard:(Build.return []) in - let link_flags = + (* TODO_AM: Implement the same approach in lib_rules. *) + let link_args = let+ flags = link_flags in - flags - @ List.concat_map archive_names ~f:(fun archive_name -> - [ "-cclib"; "-l" ^ archive_name ]) + Command.Args.S + [ Command.Args.As flags + ; Command.Args.S + (List.map archive_names ~f:(fun archive_name -> + let ext_lib = ctx.lib_config.ext_lib in + let dir = + Path.Build.relative dir (Filename.dirname archive_name) + in + let archive_name = Filename.basename archive_name in + let lib = Foreign.lib_file ~archive_name ~dir ~ext_lib in + Command.Args.S + [ Command.Args.A "-cclib"; Command.Args.Dep (Path.build lib) ])) + ] in let requires_compile = Lib.Compile.direct_requires compile_info in let cctx = @@ -146,7 +157,7 @@ let executables_rules ~sctx ~dir ~expander ~dir_contents ~scope ~compile_info o_files in let requires_compile = Compilation_context.requires_compile cctx in - Exe.build_and_link_many cctx ~programs ~linkages ~link_flags ~o_files + Exe.build_and_link_many cctx ~programs ~linkages ~link_args ~o_files ~promote:exes.promote; ( cctx , Merlin.make () ~requires:requires_compile ~flags ~modules diff --git a/src/dune/foreign_sources.ml b/src/dune/foreign_sources.ml index 9eaae3621e31..4f302c5c0f74 100644 --- a/src/dune/foreign_sources.ml +++ b/src/dune/foreign_sources.ml @@ -126,6 +126,7 @@ let make (d : _ Dir_with_dune.t) ~(object_map : Foreign.Object_map.t) = ]) |> String.Map.map ~f:snd in + (* TODO: Make this more type-safe by switching to non-empty lists. *) let executables = String.Map.of_list_map_exn exes ~f:(fun (exes, m) -> (snd (List.hd exes.names), m)) diff --git a/src/dune/inline_tests.ml b/src/dune/inline_tests.ml index 7d4e1d4bfeb5..640cd809dc55 100644 --- a/src/dune/inline_tests.ml +++ b/src/dune/inline_tests.ml @@ -313,7 +313,7 @@ include Sub_system.Register_end_point (struct Exe.build_and_link cctx ~program:{ name; main_module_name = Module.name main_module; loc } ~linkages - ~link_flags:(Build.return [ "-linkall" ]) + ~link_args:(Build.return (Command.Args.A "-linkall" )) ~promote:None; let flags = let flags = diff --git a/src/dune/lib_rules.ml b/src/dune/lib_rules.ml index d403221fe2b8..fe7b6f7a4d52 100644 --- a/src/dune/lib_rules.ml +++ b/src/dune/lib_rules.ml @@ -179,17 +179,26 @@ let include_dir_flags ~expander ~dir (stubs : Foreign.Stubs.t) = ; Command.Args.S (File_tree.Dir.fold dir ~traverse:Sub_dirs.Status.Set.all ~init:[] ~f:(fun t args -> - (* let dir = Path.append_source build_dir - (File_tree.Dir.path t) and deps = Dep.Set.paths - (File_selector.create ~dir (Predicate.create - ~id:("files_in_" ^ Path.to_string dir) ~f:(fun _ -> - true))) in *) + let local_dir = + Path.Source.to_local (File_tree.Dir.path t) + in + let dir = + Path.relative build_dir + (Path.Local.to_string local_dir) + in let deps = - Path.Source.Set.to_list (File_tree.Dir.file_paths t) - |> List.map ~f:(Path.append_source build_dir) + Dep.Set.singleton + (Dep.file_selector + (File_selector.create ~dir + (Predicate.create + ~id: + ( lazy + (String + ("files_in_" ^ Path.to_string dir)) + ) + ~f:(fun _ -> true)))) in - Command.Args.Hidden_deps (Dep.Set.of_files deps) - :: args)) + Command.Args.Hidden_deps deps :: args)) ] ))) (* Build a static and a dynamic archive for a foreign library. *) diff --git a/src/dune/toplevel.ml b/src/dune/toplevel.ml index 992b153cd598..fe09855efd49 100644 --- a/src/dune/toplevel.ml +++ b/src/dune/toplevel.ml @@ -84,7 +84,7 @@ let setup_rules t = let program = Source.program t.source in let sctx = Compilation_context.super_context t.cctx in Exe.build_and_link t.cctx ~program ~linkages:[ linkage ] - ~link_flags:(Build.return [ "-linkall"; "-warn-error"; "-31" ]) + ~link_args:(Build.return (Command.Args.As [ "-linkall"; "-warn-error"; "-31" ])) ~promote:None; let src = Exe.exe_path t.cctx ~program ~linkage in let dir = Source.stanza_dir t.source in diff --git a/test/blackbox-tests/test-cases/foreign-library/run.t b/test/blackbox-tests/test-cases/foreign-library/run.t index f121f9488411..3e9b484958c5 100644 --- a/test/blackbox-tests/test-cases/foreign-library/run.t +++ b/test/blackbox-tests/test-cases/foreign-library/run.t @@ -85,10 +85,6 @@ Testsuite for the (foreign_library ...) stanza. > (name calc) > (modules calc) > (foreign_archives addmul config)) - > (executable - > (name main) - > (libraries calc) - > (modules main)) > (foreign_library > (archive_name config) > (language c) @@ -112,16 +108,23 @@ Testsuite for the (foreign_library ...) stanza. > val calc : int -> int -> int -> int > EOF - $ cat >lib/main.ml <dune < (executable + > (name main) + > (libraries calc) + > (modules main)) + > EOF + + $ cat >main.ml < let () = Printf.printf "%d" (Calc.calc 1 2 3) > EOF $ dune build - $ dune exec lib/main.exe + $ dune exec ./main.exe 2009 - $ (cd _build/default && ocamlrun -I lib lib/main.bc) + $ (cd _build/default && ocamlrun -I lib main.bc) 2009 ---------------------------------------------------------------------------------- @@ -136,10 +139,6 @@ Testsuite for the (foreign_library ...) stanza. > (name calc) > (modules calc) > (foreign_archives addmul config)) - > (executable - > (name main) - > (libraries calc) - > (modules main)) > (foreign_library > (archive_name config) > (language cxx) @@ -150,8 +149,8 @@ Testsuite for the (foreign_library ...) stanza. > EOF $ dune build - File "lib/dune", line 19, characters 8-14: - 19 | (names config)) + File "lib/dune", line 15, characters 8-14: + 15 | (names config)) ^^^^^^ Error: Object "config" has no source; One of "config.cxx", "config.cc" or "config.cpp" must be present. @@ -186,29 +185,29 @@ Testsuite for the (foreign_library ...) stanza. $ dune clean $ dune build --display short - ocamlc lib/add$ext_obj ocamldep lib/.calc.objs/calc.mli.d ocamlc lib/.calc.objs/byte/calc.{cmi,cmti} + ocamldep .main.eobjs/main.ml.d + ocamlc .main.eobjs/byte/dune__exe__Main.{cmi,cmo,cmt} + ocamlopt .main.eobjs/native/dune__exe__Main.{cmx,o} ocamldep lib/.calc.objs/calc.ml.d - ocamlc lib/.calc.objs/byte/calc.{cmo,cmt} - ocamlc lib/calc.cma + ocamlopt lib/.calc.objs/native/calc.{cmx,o} + ocamlopt lib/calc.{a,cmxa} + ocamlc lib/add$ext_obj ocamlc lib/mul$ext_obj ocamlmklib lib/dlladdmul$ext_dll,lib/libaddmul$ext_lib gcc lib/config$ext_obj ocamlmklib lib/dllconfig$ext_dll,lib/libconfig$ext_lib - ocamldep lib/.main.eobjs/main.ml.d - ocamlc lib/.main.eobjs/byte/dune__exe__Main.{cmi,cmo,cmt} - ocamlopt lib/.main.eobjs/native/dune__exe__Main.{cmx,o} - ocamlopt lib/.calc.objs/native/calc.{cmx,o} - ocamlopt lib/calc.{a,cmxa} + ocamlopt main.exe + ocamlc lib/.calc.objs/byte/calc.{cmo,cmt} + ocamlc lib/calc.cma + ocamlc main.bc ocamlopt lib/calc.cmxs - ocamlc lib/main.bc - ocamlopt lib/main.exe - $ dune exec lib/main.exe + $ dune exec ./main.exe 2019 - $ (cd _build/default && ocamlrun -I lib lib/main.bc) + $ (cd _build/default && ocamlrun -I lib main.bc) 2019 ---------------------------------------------------------------------------------- @@ -223,10 +222,6 @@ Testsuite for the (foreign_library ...) stanza. > (name calc) > (modules calc) > (foreign_archives addmul config)) - > (executable - > (name main) - > (libraries calc) - > (modules main)) > (foreign_library > (archive_name config) > (language cxx) @@ -237,8 +232,8 @@ Testsuite for the (foreign_library ...) stanza. > EOF $ dune build - File "lib/dune", line 16, characters 23-34: - 16 | (include_dirs headers another/dir) + File "lib/dune", line 12, characters 23-34: + 12 | (include_dirs headers another/dir) ^^^^^^^^^^^ Error: Include directory "another/dir" not found. [1] @@ -255,10 +250,6 @@ Testsuite for the (foreign_library ...) stanza. > (name calc) > (modules calc) > (foreign_archives addmul config)) - > (executable - > (name main) - > (libraries calc) - > (modules main)) > (foreign_library > (archive_name config) > (language cxx) @@ -269,8 +260,8 @@ Testsuite for the (foreign_library ...) stanza. > EOF $ dune build - File "lib/dune", line 16, characters 23-37: - 16 | (include_dirs headers /absolute/path) + File "lib/dune", line 12, characters 23-37: + 12 | (include_dirs headers /absolute/path) ^^^^^^^^^^^^^^ Error: "/absolute/path" is an external directory; dependencies in external directories are currently not tracked. @@ -282,6 +273,7 @@ Testsuite for the (foreign_library ...) stanza. + ---------------------------------------------------------------------------------- * Error message for multiple declarations with the same "archive_name". @@ -298,10 +290,6 @@ Testsuite for the (foreign_library ...) stanza. > (name calc) > (modules calc) > (foreign_archives addmul config)) - > (executable - > (name main) - > (libraries calc) - > (modules main)) > (foreign_library > (archive_name config) > (language cxx) @@ -334,10 +322,6 @@ Testsuite for the (foreign_library ...) stanza. > (modules calc) > (foreign_stubs (language c) (names month)) > (foreign_archives addmul config)) - > (executable - > (name main) - > (libraries calc) - > (modules main)) > (foreign_library > (archive_name config) > (language cxx) @@ -366,16 +350,16 @@ Testsuite for the (foreign_library ...) stanza. > val month : unit -> string > EOF - $ cat >lib/main.ml <main.ml < let () = Printf.printf "%s %d" (Calc.month ()) (Calc.calc 1 2 3) > EOF $ dune build - $ dune exec lib/main.exe + $ dune exec ./main.exe October 2019 - $ (cd _build/default && ocamlrun -I lib lib/main.bc) + $ (cd _build/default && ocamlrun -I lib main.bc) October 2019 ---------------------------------------------------------------------------------- @@ -391,11 +375,6 @@ Testsuite for the (foreign_library ...) stanza. > (modules calc) > (foreign_stubs (language c) (names month)) > (foreign_archives addmul config)) - > (executable - > (name main) - > (libraries calc) - > (foreign_archives day) - > (modules main)) > (foreign_library > (archive_name day) > (language c) @@ -409,29 +388,38 @@ Testsuite for the (foreign_library ...) stanza. > (names config)) > EOF + $ cat >dune < (executable + > (name main) + > (libraries calc) + > (foreign_archives lib/day) + > (modules main)) + > EOF + $ cat >lib/day.c < #include > value day() { return Val_int(8); } > EOF - $ cat >lib/main.ml <main.ml < external day : unit -> int = "day" > let () = Printf.printf "%d %s %d" (day ()) (Calc.month ()) (Calc.calc 1 2 3) > EOF $ dune build - File "lib/dune", line 10, characters 0-83: - 10 | (executable - 11 | (name main) - 12 | (libraries calc) - 13 | (foreign_archives day) - 14 | (modules main)) + File "dune", line 1, characters 0-87: + 1 | (executable + 2 | (name main) + 3 | (libraries calc) + 4 | (foreign_archives lib/day) + 5 | (modules main)) Error: Pure bytecode executables cannot contain foreign archives. Hint: If you need to build only a native executable use "(modes exe)". [1] ---------------------------------------------------------------------------------- * Interaction of (foreign_archives ...) and (executables ...). +* Foreign archives in subdirectories. $ cat >lib/dune < (foreign_library @@ -443,12 +431,6 @@ Testsuite for the (foreign_library ...) stanza. > (modules calc) > (foreign_stubs (language c) (names month)) > (foreign_archives addmul config)) - > (executable - > (name main) - > (modes exe) - > (libraries calc) - > (foreign_archives day) - > (modules main)) > (foreign_library > (archive_name day) > (language c) @@ -462,17 +444,74 @@ Testsuite for the (foreign_library ...) stanza. > (names config)) > EOF + $ cat >dune < (executable + > (modes exe) + > (name main) + > (libraries calc) + > (foreign_archives lib/day) + > (modules main)) + > EOF + $ cat >lib/day.c < #include > value day() { return Val_int(8); } > EOF - $ cat >lib/main.ml <main.ml < external day : unit -> int = "day" > let () = Printf.printf "%d %s %d" (day ()) (Calc.month ()) (Calc.calc 1 2 3) > EOF $ dune build - $ dune exec lib/main.exe + $ dune exec ./main.exe 8 October 2019 + +---------------------------------------------------------------------------------- +* Generated header. + + $ mkdir -p lib2/headers + $ cat >lib2/dune < (foreign_library + > (archive_name today) + > (language c) + > (include_dirs headers) + > (names today)) + > EOF + + $ cat >lib2/headers/dune < (rule + > (action (write-file today.h "#define TODAY \"Today\""))) + > EOF + + $ cat >lib2/today.c < #include + > #include + > #include "today.h" + > value today() { return copy_string(TODAY); } + > EOF + + $ cat >dune < (executable + > (name main) + > (modes exe) + > (libraries calc) + > (foreign_archives lib/day lib2/today) + > (modules main)) + > EOF + + $ cat >main.ml < external day : unit -> int = "day" + > external today : unit -> string = "today" + > let () = Printf.printf "%s: %d %s %d" (today ()) (day ()) (Calc.month ()) (Calc.calc 1 2 3) + > EOF + + $ dune exec --display short ./main.exe + ocamldep .main.eobjs/main.ml.d + ocamlc .main.eobjs/byte/dune__exe__Main.{cmi,cmo,cmt} + ocamlopt .main.eobjs/native/dune__exe__Main.{cmx,o} + ocamlc lib2/today$ext_obj + ocamlmklib lib2/dlltoday$ext_dll,lib2/libtoday$ext_lib + ocamlopt main.exe + Today: 8 October 2019