diff --git a/src/dune/dune_file.ml b/src/dune/dune_file.ml index db6d40c08e1d..485443bfe4c4 100644 --- a/src/dune/dune_file.ml +++ b/src/dune/dune_file.ml @@ -568,6 +568,9 @@ module Buildable = struct ; allow_overlapping_dependencies } + let has_stubs t = + List.is_non_empty t.foreign_stubs || List.is_non_empty t.foreign_archives + let single_preprocess t = if Per_module.is_constant t.preprocess then Per_module.get t.preprocess (Module_name.of_string "") @@ -953,9 +956,7 @@ module Library = struct ; enabled_if } )) - let has_stubs t = - List.is_non_empty t.buildable.foreign_stubs - || List.is_non_empty t.buildable.foreign_archives + let has_stubs t = Buildable.has_stubs t.buildable let stubs_archive_name t = Lib_name.Local.to_string (snd t.name) ^ "_stubs" @@ -1563,10 +1564,7 @@ module Executables = struct in (make false, make true) - let has_stubs t = - match t.buildable.foreign_stubs with - | [] -> false - | _ -> true + let has_stubs t = Buildable.has_stubs t.buildable let obj_dir t ~dir = Obj_dir.make_exe ~dir ~name:(snd (List.hd t.names)) end diff --git a/src/dune/dune_file.mli b/src/dune/dune_file.mli index b036010b6575..49cf34f0ba7d 100644 --- a/src/dune/dune_file.mli +++ b/src/dune/dune_file.mli @@ -103,6 +103,8 @@ module Buildable : sig ; allow_overlapping_dependencies : bool } + val has_stubs : t -> bool + (** Preprocessing specification used by all modules or [No_preprocessing] *) val single_preprocess : t -> Preprocess.t end @@ -175,11 +177,12 @@ module Library : sig ; ppx_runtime_libraries : (Loc.t * Lib_name.t) list ; modes : Mode_conf.Set.t ; kind : Lib_kind.t + (* TODO: It may be worth remaming [c_library_flags] to + [link_time_flags_for_c_compiler] and [library_flags] to + [link_time_flags_for_ocaml_compiler], both here and in the Dune + language, to make it easier to understand the purpose of various + flags. Also we could add [c_library_flags] to [Foreign.Stubs.t]. *) ; library_flags : Ordered_set_lang.Unexpanded.t - (* TODO_AM: Maybe [c_library_flags] should be a part of - [foreign_library] declaration? This is used to pass a flag like - [-lgzip] when linking with the [gzip_stubs.a] C library. *) - (* TODO_AM: rename to "foreign_library_flags". *) ; c_library_flags : Ordered_set_lang.Unexpanded.t ; virtual_deps : (Loc.t * Lib_name.t) list ; wrapped : Wrapped.t Lib_info.Inherited.t diff --git a/src/dune/exe_rules.ml b/src/dune/exe_rules.ml index 1407dfe7c2e6..5677d1f501ab 100644 --- a/src/dune/exe_rules.ml +++ b/src/dune/exe_rules.ml @@ -79,11 +79,18 @@ let executables_rules ~sctx ~dir ~expander ~dir_contents ~scope ~compile_info in let flags = SC.ocaml_flags sctx ~dir exes.buildable in let link_deps = SC.Deps.interpret sctx ~expander exes.link_deps in + let archive_names = exes.buildable.foreign_archives |> List.map ~f:snd in let link_flags = link_deps >>> Expander.expand_and_eval_set expander exes.link_flags ~standard:(Build.return []) in + let link_flags = + let+ flags = link_flags in + flags + @ List.concat_map archive_names ~f:(fun archive_name -> + [ "-cclib"; "-l" ^ archive_name ]) + in let requires_compile = Lib.Compile.direct_requires compile_info in let cctx = let requires_link = Lib.Compile.requires_link compile_info in @@ -109,10 +116,17 @@ let executables_rules ~sctx ~dir ~expander ~dir_contents ~scope ~compile_info let o_files = if not (Executables.has_stubs exes) then [] - else ( + else + let what = + if List.is_empty exes.buildable.Dune_file.Buildable.foreign_stubs then + "archives" + else + "stubs" + in if List.mem Exe.Linkage.byte ~set:linkages then User_error.raise ~loc:exes.buildable.loc - [ Pp.textf "Pure bytecode executables cannot contain C stubs." + [ Pp.textf "Pure bytecode executables cannot contain foreign %s." + what ; Pp.textf "Did you forget to add `(modes exe)'?" ]; let foreign_sources = @@ -126,7 +140,6 @@ let executables_rules ~sctx ~dir ~expander ~dir_contents ~scope ~compile_info in Check_rules.add_files sctx ~dir o_files; o_files - ) in let requires_compile = Compilation_context.requires_compile cctx in Exe.build_and_link_many cctx ~programs ~linkages ~link_flags ~o_files diff --git a/test/blackbox-tests/test-cases/exes-with-c/run.t b/test/blackbox-tests/test-cases/exes-with-c/run.t index d15acd9196ff..397f6fc58ac9 100644 --- a/test/blackbox-tests/test-cases/exes-with-c/run.t +++ b/test/blackbox-tests/test-cases/exes-with-c/run.t @@ -42,6 +42,6 @@ 1 | (executable 2 | (name foo) 3 | (c_names stubs)) - Error: Pure bytecode executables cannot contain C stubs. + Error: Pure bytecode executables cannot contain foreign stubs. Did you forget to add `(modes exe)'? [1] diff --git a/test/blackbox-tests/test-cases/foreign-library/run.t b/test/blackbox-tests/test-cases/foreign-library/run.t index c83fb203da01..d04a6cfe0dc7 100644 --- a/test/blackbox-tests/test-cases/foreign-library/run.t +++ b/test/blackbox-tests/test-cases/foreign-library/run.t @@ -370,3 +370,102 @@ Testsuite for the (foreign_library ...) stanza. $ (cd _build/default && ocamlrun -I lib lib/main.bc) October 2019 + +---------------------------------------------------------------------------------- +* Error when using (foreign_archives ...) and a pure bytecode (executable ...). + + $ cat >lib/dune < (foreign_library + > (archive_name addmul) + > (language c) + > (names add mul)) + > (library + > (name calc) + > (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) + > (names day)) + > (foreign_library + > (archive_name config) + > (language cxx) + > (include_dirs headers) + > (extra_deps eight.h) + > (flags -DCONFIG_VALUE=2000) + > (names config)) + > EOF + + $ cat >lib/day.c < #include + > value day() { return Val_int(8); } + > EOF + + $ cat >lib/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)) + Error: Pure bytecode executables cannot contain foreign archives. + Did you forget to add `(modes exe)'? + [1] + +---------------------------------------------------------------------------------- +* Interaction of (foreign_archives ...) and (executables ...). + + $ cat >lib/dune < (foreign_library + > (archive_name addmul) + > (language c) + > (names add mul)) + > (library + > (name calc) + > (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) + > (names day)) + > (foreign_library + > (archive_name config) + > (language cxx) + > (include_dirs headers) + > (extra_deps eight.h) + > (flags -DCONFIG_VALUE=2000) + > (names config)) + > EOF + + $ cat >lib/day.c < #include + > value day() { return Val_int(8); } + > EOF + + $ cat >lib/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 + 8 October 2019