diff --git a/CHANGES.md b/CHANGES.md index 58087f3142f..c1fdb9e10b6 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -102,6 +102,8 @@ - `c_flags`, `c_names` and `cxx_names` are now supported in `executable` and `executables` stanzas. (#2562, @nojb) + Note: this feature has been subsequently extended into a separate + `foreign_stubs` field. (#2659, RFC #2650, @snowleopard) - Remove git integration from `$ dune upgrade` (#2565, @rgrinberg) @@ -158,6 +160,11 @@ projects where the language is at least `2.0`, the field is now forbidden. (#2752, fixes #2747, @rgrinberg) +- Extend support for foreign sources and archives via the `(foreign_library ...)` + stanza as well as the `(foreign_stubs ...)` and `(foreign_archives ...)` fields. + (#2659, RFC #2650, @snowleopard) + + 1.11.4 (09/10/2019) ------------------- diff --git a/bin/arg.ml b/bin/arg.ml index 18de3286fcb..da31e784818 100644 --- a/bin/arg.ml +++ b/bin/arg.ml @@ -23,7 +23,7 @@ let profile = , fun fmt t -> Format.pp_print_string fmt (Profile.to_string t) ) module Dep = struct - module Dep_conf = Dune_file.Dep_conf + module Dep_conf = Dep_conf type t = Dep_conf.t diff --git a/bin/arg.mli b/bin/arg.mli index b88962ecfb1..1604e842958 100644 --- a/bin/arg.mli +++ b/bin/arg.mli @@ -14,7 +14,7 @@ module Path : sig end module Dep : sig - type t = Dune_file.Dep_conf.t + type t = Dep_conf.t val file : string -> t diff --git a/bin/target.ml b/bin/target.ml index 5993768d29b..7ae80fe627a 100644 --- a/bin/target.ml +++ b/bin/target.ml @@ -132,7 +132,7 @@ let resolve_alias common ~recursive sv ~(setup : Dune.Main.build_system) = | None -> Error [ Pp.text "alias cannot contain variables" ] let resolve_target common ~setup = function - | Dune.Dune_file.Dep_conf.Alias sv as dep -> + | Dune.Dep_conf.Alias sv as dep -> Result.map_error ~f:(fun hints -> (dep, hints)) (resolve_alias common ~recursive:false sv ~setup) diff --git a/doc/concepts.rst b/doc/concepts.rst index d4fd6e109dd..f79730eb2a0 100755 --- a/doc/concepts.rst +++ b/doc/concepts.rst @@ -1057,3 +1057,109 @@ Other files For all other kinds of elements, you need to attach them manually via an :ref:`install` stanza. + + +.. _foreign-sources-and-archives: + +Foreign sources and archives +============================ + +Dune provides basic support for including foreign source files as well +as archives of foreign object files into OCaml projects via the +``foreign_stubs`` and ``foreign_archives`` fields. + +.. _foreign-stubs: + +Foreign stubs +------------- + +You can specify foreign sources using the ``foreign_stubs`` field of the +``library`` and ``executable`` stanzas. For example: + +.. code:: scheme + + (library + (name lib) + (foreign_stubs (language c) (names src1 src2)) + (foreign_stubs (language cxx) (names src3) (flags -O2))) + +Here we declare an OCaml library ``lib``, which contains two C sources +``src1`` and ``src2``, and one C++ source ``src3`` that needs to be +compiled with ``-O2``. These source files will be compiled and packaged +with the library, along with the link-time flags to be used when +linking the final executables. When matching ``names`` to source files, +Dune treats ``*.c`` files as C sources, and ``*.cpp``, ``*.cc`` and +``*.cxx`` files as C++ sources. + +Here is a complete list of supported subfields: + +- ``language`` specifies the source language, where ``c`` means C and + ``cxx`` means C++. In future, more languages may be supported. +- ``names`` specifies the *names* of source files. When specifying a source + file, you should omit the extension and any relative parts of the path; + Dune will scan all library directories, finding all matching files and + raising an error if multiple source files map to the same object name. + If you need to have multiple object files with the same name, you can + package them into different :ref:`foreign-archives` via the + ``foreign_archives`` field. +- ``flags`` are passed when compiling source files. This field is specified + using the :ref:`ordered-set-language`, where the ``:standard`` value comes + from the environment settings ``c_flags`` and ``cxx_flags``, respectively. +- ``include_dirs`` are tracked as dependencies and passed to the compiler + via the ``-I`` flag. You can use :ref:`variables` in this field. The + contents of included directories is tracked recursively, e.g. if you + use ``(include_dir dir)`` and have headers ``dir/base.h`` and + ``dir/lib/lib.h`` then they both will be tracked as dependencies. +- ``extra_deps`` specifies any other dependencies that should be tracked. + This is useful when dealing with ``#include`` statements that escape into + a parent directory like ``#include "../a.h"``. + + +.. _foreign-archives: + +Foreign archives +---------------- + +You can also specify archives of separately compiled foreign object files +that need to be packaged with an OCaml library or linked into an OCaml +executable. To do that, use the ``foreign_archives`` field of the +corresponding ``library`` or ``executable`` stanza. For example: + +.. code:: scheme + + (library + (name lib) + (foreign_stubs (language c) (names src1 src2)) + (foreign_stubs (language cxx) (names src3) (flags -O2)) + (foreign_archives arch1 some/dir/arch2)) + +Here, in addition to :ref:`foreign-stubs`, we also specify foreign archives +``arch1`` and ``arch2``, where the latter is stored in a subdirectory +``some/dir``. + +You can build a foreign archive manually, e.g. using a custom ``rule`` as +described in :ref:`foreign-sandboxing`, or ask Dune to build it via the +``foreign_library`` stanza: + +.. code:: scheme + + (foreign_library + (archive_name arch1) + (language c) + (names src4 src5) + (include_dir headers)) + +This asks Dune to compile C source files ``src4`` and ``src5`` with +headers tracked in the ``headers`` directory, and put the resulting +object files into an archive ``arch1``, whose full name is typically +``libarch1.a`` for static linking and ``dllarch1.so`` for dynamic +linking. + +The ``foreign_library`` stanza supports all :ref:`foreign-stubs` fields plus +the ``archive_name`` field, which specifies the archive's name. You can refer +to the same archive name from multiple OCaml libraries and executables, so a +foreign archive is a bit like a foreign library, hence the name of the stanza. + +Foreign archives are particularly useful when embedding a library written in +a foreign language and/or built with another build system. See +:ref:`foreign-sandboxing` for more details. \ No newline at end of file diff --git a/doc/dune-files.rst b/doc/dune-files.rst index 8a6c0d68b33..91d59dcd9be 100644 --- a/doc/dune-files.rst +++ b/doc/dune-files.rst @@ -372,10 +372,16 @@ to use the :ref:`include_subdirs` stanza. or in the installed world. You can use this to provide extra features without adding hard dependencies to your project -- ``(c_names ())``, if your library has stubs, you must list the C files - in this field, without the ``.c`` extension +- ``(foreign_stubs )`` specifies foreign source files, e.g. + C or C++ stubs, to be compiled and packaged together with the library. See + the section :ref:`foreign-sources-and-archives` for more details. This field + replaces the now deprecated fields ``c_names``, ``c_flags``, ``cxx_names`` + and ``cxx_flags``. -- ``(cxx_names ())`` is the same as ``c_names`` but for C++ stubs +- ``(foreign_archives )`` specifies archives of foreign + object files to be packaged with the library. See the section + :ref:`foreign-archives` for more details. This field replaces the now + deprecated field ``self_build_stubs_archive``. - ``(install_c_headers ())``, if your library has public C header files that must be installed, you must list them in this field, without the ``.h`` @@ -422,11 +428,6 @@ to use the :ref:`include_subdirs` stanza. use this to specify ``-linkall`` for instance. ```` is a list of strings supporting :ref:`variables` -- ``(c_flags )`` specifies the compilation flags for C stubs, using the - :ref:`ordered-set-language`. This field supports ``(:include ...)`` forms - -- ``(cxx_flags )`` is the same as ``c_flags`` but for C++ stubs - - ``(c_library_flags )`` specifies the flags to pass to the C compiler when constructing the library archive file for the C stubs. ```` uses the :ref:`ordered-set-language` and supports ``(:include ...)`` forms. When you @@ -434,14 +435,6 @@ to use the :ref:`include_subdirs` stanza. ``-lbar`` here, or whatever flags are necessary to to link against this library -.. _self_build_stubs_archive: - -- ``(self_build_stubs_archive )`` indicates to dune that the - library has stubs, but that the stubs are built manually. The aim of the field - is to embed a library written in foreign language and/or building with another - build system. It is not for casual uses, see the `re2 library - `__ for an example of use - - ``(modules_without_implementation )`` specifies a list of modules that have only a ``.mli`` or ``.rei`` but no ``.ml`` or ``.re`` file. Such modules are usually referred as *mli only @@ -617,15 +610,13 @@ Executables can also be linked as object or shared object files. See ``executable`` stanza will cause Dune to copy the ``.exe`` files to the source tree and ``dune clean`` to delete them -- ``(c_names ())``, if your executable needs C stubs, you must list the C - files in this field, without the ``.c`` extension - -- ``(cxx_names ())`` is the same as ``c_names`` but for C++ stubs - -- ``(c_flags )`` specifies the compilation flags for C stubs, using the - :ref:`ordered-set-language`. This field supports ``(:include ...)`` forms +- ``(foreign_stubs )`` specifies foreign source + files, e.g. C or C++ stubs, to be linked into the executable. See the + section :ref:`foreign-sources-and-archives` for more details. -- ``(cxx_flags )`` is the same as ``c_flags`` but for C++ stubs +- ``(foreign_archives )`` specifies archives of + foreign object files to be linked into the executable. See the section + :ref:`foreign-archives` for more details. - ``(forbidden_libraries )`` ensures that the given libraries are not linked in the resulting executable. If they end up diff --git a/doc/foreign-code.rst b/doc/foreign-code.rst index 745198a8728..522435022e7 100644 --- a/doc/foreign-code.rst +++ b/doc/foreign-code.rst @@ -24,24 +24,24 @@ Adding C/C++ stubs to an OCaml library ====================================== To add C stubs to an OCaml library, simply list the C files without -the ``.c`` extension via the ``c_names`` field of the :ref:`library` -stanza. For instance: +the ``.c`` extension in the :ref:`foreign-stubs` field. For instance: .. code:: scheme (library (name mylib) - (c_names file1 file2)) + (foreign_stubs (language c) (names file1 file2))) -Similarly, you can add C++ stubs to an OCaml library by listing them -without the ``.cpp`` extension via the ``cxx_names`` field. +You can also add C++ stubs to an OCaml library by specifying +``(language cxx)`` instead. Dune is currently not flexible regarding the extension of the C/C++ -source files. They have to be ``.c`` and ``.cpp``. If you have source -files that that do not follow this extension and you want to build -them with Dune, you need to rename them first. Alternatively, you can -use the :ref:`foreign build sandboxing ` method -described bellow. +source files. They have to be ``.c`` for C files and ``.cpp``, ``.cc`` +or ``.cxx`` for C++ files. If you have source files with other +extensions and you want to build them with Dune, you need to rename +them first. Alternatively, you can use the +:ref:`foreign build sandboxing ` method described +below. Header files ------------ @@ -80,12 +80,9 @@ To do that, follow the following procedure: :ref:`data_only_dirs ` stanza - write a custom rule that: - - depend on this directory recursively via :ref:`source_tree ` - - invoke the external build system - - copy the C archive files (``.a``, ``.so``, ...) in main library - directory with a specific names (see bellow) -- *attach* the C archive files to an OCaml library via the - :ref:`self_build_stubs_archive ` field + - depends on this directory recursively via :ref:`source_tree ` + - invokes the external build system +- *attach* the C archive files to an OCaml library via :ref:`foreign-archives`. For instance, let's assume that you want to build a C library ``libfoo`` using ``libfoo``'s own build system and attach it to an @@ -106,16 +103,8 @@ writing the following code ``src/dune``: (rule (deps (source_tree libfoo)) - (targets libfoo_stubs.a dllfoo_stubs.so) - (action (progn - (chdir libfoo (run make))) - (copy libfoo/libfoo.a libfoo_stubs.a) - (copy libfoo/libfoo.so dllfoo_stubs.so))) - -Note that the rule copies the files to ``libfoo_stubs.a`` and -``dllfoo_stubs.so``. It is important that the files produced are -named ``lib_stubs.a`` and -``dll_stubs.so``. + (targets libfoo.a dllfoo.so) + (action (chdir libfoo (run make)))) The last step is to attach these archives to an OCaml library as follows: @@ -124,7 +113,7 @@ follows: (library (name bar) - (self_build_stubs_archive foo)) + (foreign_archives libfoo/foo)) Then, whenever you use the ``bar`` library, you will also be able to use C functions from ``libfoo``. diff --git a/editor-integration/emacs/dune.el b/editor-integration/emacs/dune.el index b15c38eedf0..9d458b6f202 100644 --- a/editor-integration/emacs/dune.el +++ b/editor-integration/emacs/dune.el @@ -63,7 +63,8 @@ "ocamllex" "ocamlyacc" "menhir" "alias" "install" "copy_files" "copy_files#" "include" "tests" "test" "dirs" "env" "ignored_subdirs" "include_subdirs" "data_only_dirs" - "documentation" "cinaps" "coqlib" "coq.theory" "coq.pp") + "documentation" "cinaps" "coqlib" "coq.theory" "coq.pp" + "foreign_library") ) "\\(?:\\_>\\|[[:space:]]\\)")) "Stanzas in dune files.") @@ -72,9 +73,9 @@ (regexp-opt '("name" "public_name" "synopsis" "modules" "libraries" "wrapped" "preprocess" "preprocessor_deps" "optional" "c_names" "cxx_names" - "install_c_headers" "modes" "no_dynlink" "kind" - "ppx_runtime_libraries" "virtual_deps" "js_of_ocaml" "flags" - "ocamlc_flags" "ocamlopt_flags" "library_flags" "c_flags" + "foreign_stubs" "foreign_archives" "install_c_headers" "modes" + "no_dynlink" "kind" "ppx_runtime_libraries" "virtual_deps" "js_of_ocaml" + "flags" "ocamlc_flags" "ocamlopt_flags" "library_flags" "c_flags" "cxx_flags" "c_library_flags" "self_build_stubs_archive" "inline_tests" "modules_without_implementation" "private_modules" ;; + special_builtin_support @@ -87,6 +88,8 @@ ;; + for "executable" and "executables": "package" "link_flags" "link_deps" "names" "public_names" "variants" "forbidden_libraries" + ;; + for "foreign_library" and "foreign_stubs": + "archive_name" "language" "names" "flags" "include_dirs" "extra_deps" ;; + for "rule": "targets" "action" "deps" "mode" "fallback" "locks" ;; + for "menhir": diff --git a/src/dune/c.ml b/src/dune/c.ml deleted file mode 100644 index 8a4ae155282..00000000000 --- a/src/dune/c.ml +++ /dev/null @@ -1,128 +0,0 @@ -open Stdune - -let header_ext = ".h" - -module Kind = struct - type t = - | C - | Cxx - - let to_string = function - | C -> "c" - | Cxx -> "cpp" - - let pp fmt t : unit = Format.pp_print_string fmt (to_string t) - - type split = - | Unrecognized - | Not_allowed_until of Dune_lang.Syntax.Version.t - | Recognized of string * t - - let cxx_version_introduced ~obj ~dune_version ~version_introduced = - if dune_version >= version_introduced then - Recognized (obj, Cxx) - else - Not_allowed_until version_introduced - - let split_extension fn ~dune_version = - match String.rsplit2 fn ~on:'.' with - | Some (obj, "c") -> Recognized (obj, C) - | Some (obj, "cpp") -> Recognized (obj, Cxx) - | Some (obj, "cxx") -> - cxx_version_introduced ~obj ~dune_version ~version_introduced:(1, 8) - | Some (obj, "cc") -> - cxx_version_introduced ~obj ~dune_version ~version_introduced:(1, 10) - | _ -> Unrecognized - - let possible_exts ~dune_version = function - | C -> [ ".c" ] - | Cxx -> - let exts = [ ".cpp" ] in - let exts = - if dune_version >= (1, 10) then - ".cc" :: exts - else - exts - in - if dune_version >= (1, 8) then - ".cxx" :: exts - else - exts - - let possible_fns t fn ~dune_version = - possible_exts t ~dune_version |> List.map ~f:(fun ext -> fn ^ ext) - - module Dict = struct - type 'a t = - { c : 'a - ; cxx : 'a - } - - let c t = t.c - - let cxx t = t.cxx - - let map { c; cxx } ~f = { c = f c; cxx = f cxx } - - let mapi { c; cxx } ~f = { c = f ~kind:C c; cxx = f ~kind:Cxx cxx } - - let make_both a = { c = a; cxx = a } - - let make ~c ~cxx = { c; cxx } - - let get { c; cxx } = function - | C -> c - | Cxx -> cxx - - let add t k v = - match k with - | C -> { t with c = v } - | Cxx -> { t with cxx = v } - - let update t k ~f = - let v = get t k in - add t k (f v) - - let merge t1 t2 ~f = { c = f t1.c t2.c; cxx = f t1.cxx t2.cxx } - end -end - -module Source = struct - type t = - { kind : Kind.t - ; path : Path.Build.t - } - - let kind t = t.kind - - let path t = t.path - - let src_dir t = Path.Build.parent_exn t.path - - let make ~kind ~path = { kind; path } -end - -module Sources = struct - type t = (Loc.t * Source.t) String.Map.t - - let objects (t : t) ~dir ~ext_obj = - String.Map.keys t - |> List.map ~f:(fun c -> Path.Build.relative dir (c ^ ext_obj)) - - let split_by_kind t = - let c, cxx = - String.Map.partition t ~f:(fun (_, s) -> - match (Source.kind s : Kind.t) with - | C -> true - | Cxx -> false) - in - { Kind.Dict.c; cxx } -end - -let all_possible_exts = - let exts = Kind.possible_exts ~dune_version:Stanza.latest_version in - (header_ext :: exts C) @ exts Cxx - -let c_cxx_or_header ~fn = - let ext = Filename.extension fn in - List.mem ~set:all_possible_exts ext diff --git a/src/dune/c.mli b/src/dune/c.mli deleted file mode 100644 index 886ed3cc4c5..00000000000 --- a/src/dune/c.mli +++ /dev/null @@ -1,76 +0,0 @@ -open Stdune - -val header_ext : string - -module Kind : sig - type t = - | C - | Cxx - - val to_string : t -> string - - val pp : t Fmt.t - - type split = - | Unrecognized - | Not_allowed_until of Dune_lang.Syntax.Version.t - | Recognized of string * t - - val split_extension : - string -> dune_version:Dune_lang.Syntax.Version.t -> split - - (** [possible_fns t s] returns the possible filenames given the - extension-less basenames [s] *) - val possible_fns : - t -> string -> dune_version:Dune_lang.Syntax.Version.t -> string list - - module Dict : sig - type kind - - type 'a t = - { c : 'a - ; cxx : 'a - } - - val c : 'a t -> 'a - - val cxx : 'a t -> 'a - - val map : 'a t -> f:('a -> 'b) -> 'b t - - val mapi : 'a t -> f:(kind:kind -> 'a -> 'b) -> 'b t - - val make_both : 'a -> 'a t - - val make : c:'a -> cxx:'a -> 'a t - - val update : 'a t -> kind -> f:('a -> 'a) -> 'a t - - val merge : 'a t -> 'b t -> f:('a -> 'b -> 'c) -> 'c t - - val get : 'a t -> kind -> 'a - end - with type kind := t -end - -module Source : sig - type t - - val kind : t -> Kind.t - - val path : t -> Path.Build.t - - val src_dir : t -> Path.Build.t - - val make : kind:Kind.t -> path:Path.Build.t -> t -end - -module Sources : sig - type t = (Loc.t * Source.t) String.Map.t - - val objects : t -> dir:Path.Build.t -> ext_obj:string -> Path.Build.t list - - val split_by_kind : t -> t Kind.Dict.t -end - -val c_cxx_or_header : fn:string -> bool diff --git a/src/dune/c_sources.ml b/src/dune/c_sources.ml deleted file mode 100644 index 80719017add..00000000000 --- a/src/dune/c_sources.ml +++ /dev/null @@ -1,143 +0,0 @@ -open Stdune -open Dune_file -module Library = Dune_file.Library - -type t = - { libraries : C.Sources.t Lib_name.Map.t - ; executables : C.Sources.t String.Map.t - } - -let for_lib t ~name = Lib_name.Map.find_exn t.libraries name - -let for_exes t ~first_exe = String.Map.find_exn t.executables first_exe - -let empty = { libraries = Lib_name.Map.empty; executables = String.Map.empty } - -let c_name, cxx_name = - let make what ~loc s = - if - match s with - | "" - | "." - | ".." -> - true - | _ -> false - then - User_error.raise ~loc [ Pp.textf "%S is not a valid %s name." s what ] - else - s - in - (make "C", make "C++") - -let load_sources ~dune_version ~dir ~files = - let init = C.Kind.Dict.make_both String.Map.empty in - String.Set.fold files ~init ~f:(fun fn acc -> - match C.Kind.split_extension fn ~dune_version with - | Unrecognized -> acc - | Not_allowed_until version -> - let loc = Loc.in_dir (Path.build dir) in - User_error.raise ~loc - [ Pp.textf - "Source file %s with extension %s is not allowed before version \ - %s" - fn (Filename.extension fn) - (Dune_lang.Syntax.Version.to_string version) - ] - | Recognized (obj, kind) -> - let path = Path.Build.relative dir fn in - C.Kind.Dict.update acc kind ~f:(fun v -> - String.Map.set v obj (C.Source.make ~kind ~path))) - -let eval_c_sources (d : _ Dir_with_dune.t) buildable ~c_sources = - let eval (kind : C.Kind.t) (c_sources : C.Source.t String.Map.t) validate osl - = - Ordered_set_lang.Unordered_string.eval_loc osl - ~key:(fun x -> x) - ~parse:(fun ~loc s -> - let s = validate ~loc s in - let s' = Filename.basename s in - if s' <> s then - User_error.raise ~loc - [ Pp.text - "relative part of stub is not necessary and should be \ - removed. To include sources in subdirectories, use the \ - include_subdirs stanza" - ]; - s') - ~standard:String.Map.empty - |> String.Map.map ~f:(fun (loc, s) -> - match String.Map.find c_sources s with - | Some source -> (loc, source) - | None -> - let dune_version = d.dune_version in - User_error.raise ~loc - [ Pp.textf "%s does not exist as a C source. %s must be present" - s - (String.enumerate_one_of - (C.Kind.possible_fns kind s ~dune_version)) - ]) - in - let names = Option.value ~default:Ordered_set_lang.standard in - let c = - eval C.Kind.C c_sources.C.Kind.Dict.c c_name - (names buildable.Buildable.c_names) - in - let cxx = - eval C.Kind.Cxx c_sources.cxx cxx_name (names buildable.cxx_names) - in - String.Map.union c cxx ~f:(fun _ (_loc1, c) (loc2, cxx) -> - User_error.raise ~loc:loc2 - [ Pp.textf - "%s and %s have conflicting names. You must rename one of them." - (Path.to_string_maybe_quoted - (Path.drop_optional_build_context - (Path.build (C.Source.path cxx)))) - (Path.to_string_maybe_quoted - (Path.drop_optional_build_context (Path.build (C.Source.path c)))) - ]) - -let make (d : _ Dir_with_dune.t) - ~(c_sources : C.Source.t String.Map.t C.Kind.Dict.t) = - let libs, exes = - List.filter_partition_map d.data ~f:(fun stanza -> - match (stanza : Stanza.t) with - | Library lib -> - let all = eval_c_sources d lib.buildable ~c_sources in - Left (lib, all) - | Executables exes -> - let all = eval_c_sources d exes.buildable ~c_sources in - Right (exes, all) - | _ -> Skip) - in - let libraries = - match - Lib_name.Map.of_list_map libs ~f:(fun (lib, m) -> - (Library.best_name lib, m)) - with - | Ok x -> x - | Error (name, _, (lib2, _)) -> - User_error.raise ~loc:lib2.buildable.loc - [ Pp.textf "Library %S appears for the second time in this directory" - (Lib_name.to_string name) - ] - in - let executables = - String.Map.of_list_map_exn exes ~f:(fun (exes, m) -> - (snd (List.hd exes.names), m)) - in - let () = - let rev_map = - List.concat_map libs ~f:(fun (_, c_sources) -> - String.Map.values c_sources - |> List.map ~f:(fun (loc, source) -> (C.Source.path source, loc))) - |> Path.Build.Map.of_list - in - match rev_map with - | Ok _ -> () - | Error (_, loc1, loc2) -> - User_error.raise ~loc:loc2 - [ Pp.text "This c stub is already used in another stanza:" - ; Pp.textf "- %s" (Loc.to_file_colon_line loc1) - ] - in - { libraries; executables } diff --git a/src/dune/c_sources.mli b/src/dune/c_sources.mli deleted file mode 100644 index f61f20f8013..00000000000 --- a/src/dune/c_sources.mli +++ /dev/null @@ -1,27 +0,0 @@ -(** This module loads and validates C/C++ sources from directories. *) - -open Stdune - -type t - -val empty : t - -val for_lib : t -> name:Lib_name.t -> C.Sources.t - -val for_exes : t -> first_exe:string -> C.Sources.t - -(** [load_sources dir ~files] will load the C sources in [dir] into a two - double map. The first level will is keyed by C vs. C++ sources. The second - level is keyed by the object name of the source. *) -val load_sources : - dune_version:Dune_lang.Syntax.Version.t - -> dir:Path.Build.t - -> files:String.Set.t - -> C.Source.t String.Map.t C.Kind.Dict.t - -(** [make stanzas ~c_sources] will load and validate C/C++ sources. [c_sources] - should be a two level map such as the one returned by [load_sources] *) -val make : - Stanza.t list Dir_with_dune.t - -> c_sources:C.Source.t String.Map.t C.Kind.Dict.t - -> t diff --git a/src/dune/cinaps.ml b/src/dune/cinaps.ml index 11ed0b7f505..8425e1c3361 100644 --- a/src/dune/cinaps.ml +++ b/src/dune/cinaps.ml @@ -7,7 +7,7 @@ type t = ; files : Predicate_lang.Glob.t ; libraries : Lib_dep.t list ; preprocess : Dune_file.Preprocess_map.t - ; preprocessor_deps : Dune_file.Dep_conf.t list + ; preprocessor_deps : Dep_conf.t list ; flags : Ocaml_flags.Spec.t } diff --git a/src/dune/command.ml b/src/dune/command.ml index ef2a9bc4767..d11317363ce 100644 --- a/src/dune/command.ml +++ b/src/dune/command.ml @@ -23,6 +23,8 @@ module Args = struct (* TODO: Shall we simply make the constructor [Dyn] to accept a list? *) let dyn args = Dyn (Build.map args ~f:(fun x -> As x)) + + let empty = S [] end open Args diff --git a/src/dune/command.mli b/src/dune/command.mli index 862ec3ba700..51357f32a40 100644 --- a/src/dune/command.mli +++ b/src/dune/command.mli @@ -45,8 +45,11 @@ module Args : sig | Dyn : static t Build.t -> dynamic t | Fail : fail -> _ t - (* Create dynamic command line arguments. *) + (** Create dynamic command line arguments. *) val dyn : string list Build.t -> dynamic t + + (** Create an empty command line. *) + val empty : _ t end (* TODO: Using list in [dynamic t list] complicates the API unnecessarily: we diff --git a/src/dune/compilation_context.ml b/src/dune/compilation_context.ml index b64e63c2eea..24170be26bd 100644 --- a/src/dune/compilation_context.ml +++ b/src/dune/compilation_context.ml @@ -35,7 +35,7 @@ module Includes = struct in { cmi = cmi_includes; cmo = cmi_includes; cmx = cmx_includes } - let empty = Cm_kind.Dict.make_all (Command.Args.As []) + let empty = Cm_kind.Dict.make_all Command.Args.empty end type t = diff --git a/src/dune/dep_conf.ml b/src/dune/dep_conf.ml new file mode 100644 index 00000000000..b18b805df1d --- /dev/null +++ b/src/dune/dep_conf.ml @@ -0,0 +1,100 @@ +open! Stdune +open Import +open Dune_lang.Decoder + +type t = + | File of String_with_vars.t + | Alias of String_with_vars.t + | Alias_rec of String_with_vars.t + | Glob_files of String_with_vars.t + | Source_tree of String_with_vars.t + | Package of String_with_vars.t + | Universe + | Env_var of String_with_vars.t + | Sandbox_config of Sandbox_config.t + +let remove_locs = function + | File sw -> File (String_with_vars.remove_locs sw) + | Alias sw -> Alias (String_with_vars.remove_locs sw) + | Alias_rec sw -> Alias_rec (String_with_vars.remove_locs sw) + | Glob_files sw -> Glob_files (String_with_vars.remove_locs sw) + | Source_tree sw -> Source_tree (String_with_vars.remove_locs sw) + | Package sw -> Package (String_with_vars.remove_locs sw) + | Universe -> Universe + | Env_var sw -> Env_var sw + | Sandbox_config s -> Sandbox_config s + +let decode_sandbox_config = + let+ () = Dune_lang.Syntax.since Stanza.syntax (1, 12) + and+ loc, x = + located + (repeat + (sum + [ ("none", return Sandbox_config.Partial.no_sandboxing) + ; ("always", return Sandbox_config.Partial.needs_sandboxing) + ; ( "preserve_file_kind" + , return (Sandbox_config.Partial.disallow Sandbox_mode.symlink) + ) + ])) + in + Sandbox_config.Partial.merge ~loc x + +let decode = + let decode = + let sw = String_with_vars.decode in + sum + [ ("file", sw >>| fun x -> File x) + ; ("alias", sw >>| fun x -> Alias x) + ; ("alias_rec", sw >>| fun x -> Alias_rec x) + ; ("glob_files", sw >>| fun x -> Glob_files x) + ; ("package", sw >>| fun x -> Package x) + ; ("universe", return Universe) + ; ( "files_recursively_in" + , let+ () = + Dune_lang.Syntax.renamed_in Stanza.syntax (1, 0) ~to_:"source_tree" + and+ x = sw in + Source_tree x ) + ; ( "source_tree" + , let+ () = Dune_lang.Syntax.since Stanza.syntax (1, 0) + and+ x = sw in + Source_tree x ) + ; ("env_var", sw >>| fun x -> Env_var x) + ; ("sandbox", decode_sandbox_config >>| fun x -> Sandbox_config x) + ] + in + if_list ~then_:decode ~else_:(String_with_vars.decode >>| fun x -> File x) + +open Dune_lang + +let encode = function + | File t -> + List [ Dune_lang.unsafe_atom_of_string "file"; String_with_vars.encode t ] + | Alias t -> + List [ Dune_lang.unsafe_atom_of_string "alias"; String_with_vars.encode t ] + | Alias_rec t -> + List + [ Dune_lang.unsafe_atom_of_string "alias_rec"; String_with_vars.encode t ] + | Glob_files t -> + List + [ Dune_lang.unsafe_atom_of_string "glob_files" + ; String_with_vars.encode t + ] + | Source_tree t -> + List + [ Dune_lang.unsafe_atom_of_string "source_tree" + ; String_with_vars.encode t + ] + | Package t -> + List + [ Dune_lang.unsafe_atom_of_string "package"; String_with_vars.encode t ] + | Universe -> Dune_lang.unsafe_atom_of_string "universe" + | Env_var t -> + List + [ Dune_lang.unsafe_atom_of_string "env_var"; String_with_vars.encode t ] + | Sandbox_config config -> + if Sandbox_config.equal config Sandbox_config.no_special_requirements then + List [] + else + Code_error.raise "There's no syntax for [Sandbox_config] yet" [] + +let to_dyn t = Dune_lang.to_dyn (encode t) diff --git a/src/dune/dep_conf.mli b/src/dune/dep_conf.mli new file mode 100644 index 00000000000..7f3a0a16e62 --- /dev/null +++ b/src/dune/dep_conf.mli @@ -0,0 +1,23 @@ +open! Stdune +open Import + +type t = + | File of String_with_vars.t + | Alias of String_with_vars.t + | Alias_rec of String_with_vars.t + | Glob_files of String_with_vars.t + | Source_tree of String_with_vars.t + | Package of String_with_vars.t + | Universe + | Env_var of String_with_vars.t + (* [Sandbox_config] is a way to declare that your action also depends on + there being a clean filesystem around its deps. (or, if you require + [no_sandboxing], it's that your action depends on something undeclared + (e.g. absolute path of cwd) and you want to allow it) *) + | Sandbox_config of Sandbox_config.t + +val remove_locs : t -> t + +include Dune_lang.Conv.S with type t := t + +val to_dyn : t Dyn.Encoder.t diff --git a/src/dune/dir_contents.ml b/src/dune/dir_contents.ml index cbd52b11a9b..6926900cad0 100644 --- a/src/dune/dir_contents.ml +++ b/src/dune/dir_contents.ml @@ -38,7 +38,7 @@ type t = ; dir : Path.Build.t ; text_files : String.Set.t ; modules : Dir_modules.t Memo.Lazy.t - ; c_sources : C_sources.t Memo.Lazy.t + ; foreign_sources : Foreign_sources.t Memo.Lazy.t ; mlds : (Dune_file.Documentation.t * Path.Build.t list) list Memo.Lazy.t ; coq_modules : Coq_module.t list Lib_name.Map.t Memo.Lazy.t ; artifacts : Dir_artifacts.t Memo.Lazy.t @@ -77,11 +77,14 @@ let modules_of_executables t ~obj_dir ~first_exe = let src_dir = Path.build (Obj_dir.obj_dir obj_dir) in String.Map.find_exn map first_exe |> Modules.relocate_alias_module ~src_dir -let c_sources_of_executables t ~first_exe = - C_sources.for_exes (Memo.Lazy.force t.c_sources) ~first_exe +let foreign_sources_of_executables t ~first_exe = + Foreign_sources.for_exes (Memo.Lazy.force t.foreign_sources) ~first_exe -let c_sources_of_library t ~name = - C_sources.for_lib (Memo.Lazy.force t.c_sources) ~name +let foreign_sources_of_library t ~name = + Foreign_sources.for_lib (Memo.Lazy.force t.foreign_sources) ~name + +let foreign_sources_of_archive t ~archive_name = + Foreign_sources.for_archive (Memo.Lazy.force t.foreign_sources) ~archive_name let lookup_module t name = Module_name.Map.find (Memo.Lazy.force t.modules).rev_map name @@ -521,13 +524,13 @@ end = struct ; text_files = files ; modules = Memo.Lazy.map ~f:make_modules libs_and_exes ; mlds = Memo.lazy_ (fun () -> build_mlds_map d ~files) - ; c_sources = + ; foreign_sources = Memo.lazy_ (fun () -> let dune_version = d.dune_version in - C_sources.make d - ~c_sources: - (C_sources.load_sources ~dune_version ~dir:d.ctx_dir - ~files)) + Foreign_sources.make d + ~sources: + (Foreign.Sources.Unresolved.load ~dune_version + ~dir:d.ctx_dir ~files)) ; coq_modules = Memo.lazy_ (fun () -> build_coq_modules_map d ~dir:d.ctx_dir @@ -547,7 +550,7 @@ end = struct ; text_files = String.Set.empty ; modules = Memo.Lazy.of_val Dir_modules.empty ; mlds = Memo.Lazy.of_val [] - ; c_sources = Memo.Lazy.of_val C_sources.empty + ; foreign_sources = Memo.Lazy.of_val Foreign_sources.empty ; coq_modules = Memo.Lazy.of_val Lib_name.Map.empty ; artifacts = Memo.Lazy.of_val Dir_artifacts.empty } @@ -622,48 +625,20 @@ end = struct in let modules = Memo.Lazy.map ~f:make_modules libs_and_exes in let artifacts = Memo.Lazy.map ~f:(make_artifacts d) libs_and_exes in - let c_sources = + let foreign_sources = Memo.lazy_ (fun () -> check_no_qualified Loc.none qualif_mode; let dune_version = d.dune_version in - let init = C.Kind.Dict.make_both String.Map.empty in - let c_sources = + let init = String.Map.empty in + let sources = List.fold_left ((dir, [], files) :: subdirs) ~init ~f:(fun acc (dir, _local, files) -> let sources = - C_sources.load_sources ~dir ~dune_version ~files - in - let f acc sources = - String.Map.union acc sources ~f:(fun name x y -> - User_error.raise - ~loc: - (Loc.in_file - (Path.source - ( match File_tree.Dir.dune_file ft_dir with - | None -> - Path.Source.relative - (File_tree.Dir.path ft_dir) - "_unknown_" - | Some d -> File_tree.Dune_file.path d ))) - [ Pp.textf - "%s file %s appears in several directories:" - (C.Kind.to_string (C.Source.kind x)) - name - ; Pp.textf "- %s" - (Path.to_string_maybe_quoted - (Path.drop_optional_build_context - (Path.build (C.Source.src_dir x)))) - ; Pp.textf "- %s" - (Path.to_string_maybe_quoted - (Path.drop_optional_build_context - (Path.build (C.Source.src_dir y)))) - ; Pp.text - "This is not allowed, please rename one of them." - ]) + Foreign.Sources.Unresolved.load ~dir ~dune_version ~files in - C.Kind.Dict.merge acc sources ~f) + String.Map.Multi.rev_union sources acc) in - C_sources.make d ~c_sources) + Foreign_sources.make d ~sources) in let coq_modules = Memo.lazy_ (fun () -> @@ -678,7 +653,7 @@ end = struct ; dir ; text_files = files ; modules - ; c_sources + ; foreign_sources ; mlds = Memo.lazy_ (fun () -> build_mlds_map d ~files) ; coq_modules ; artifacts @@ -689,7 +664,7 @@ end = struct ; dir ; text_files = files ; modules - ; c_sources + ; foreign_sources ; mlds = Memo.lazy_ (fun () -> build_mlds_map d ~files) ; coq_modules ; artifacts diff --git a/src/dune/dir_contents.mli b/src/dune/dir_contents.mli index 3b9414bae16..3f435b00922 100644 --- a/src/dune/dir_contents.mli +++ b/src/dune/dir_contents.mli @@ -28,13 +28,15 @@ val text_files : t -> String.Set.t (** Modules attached to a library. [name] is the library best name. *) val modules_of_library : t -> name:Lib_name.t -> Modules.t -val c_sources_of_library : t -> name:Lib_name.t -> C.Sources.t +val foreign_sources_of_library : t -> name:Lib_name.t -> Foreign.Sources.t + +val foreign_sources_of_archive : t -> archive_name:string -> Foreign.Sources.t (** Modules attached to a set of executables. *) val modules_of_executables : t -> obj_dir:Path.Build.t Obj_dir.t -> first_exe:string -> Modules.t -val c_sources_of_executables : t -> first_exe:string -> C.Sources.t +val foreign_sources_of_executables : t -> first_exe:string -> Foreign.Sources.t (** Find out what buildable a module is part of *) val lookup_module : t -> Module_name.t -> Dune_file.Buildable.t option diff --git a/src/dune/dune_env.ml b/src/dune/dune_env.ml index abc00ddca4d..e0f6e2446cd 100644 --- a/src/dune/dune_env.ml +++ b/src/dune/dune_env.ml @@ -5,14 +5,14 @@ type stanza = Stanza.t = .. module Stanza = struct open Dune_lang.Decoder - let c_flags ~since = + let foreign_flags ~since = let check = Option.map since ~f:(fun since -> Dune_lang.Syntax.since Stanza.syntax since) in let+ c = Ordered_set_lang.Unexpanded.field "c_flags" ?check and+ cxx = Ordered_set_lang.Unexpanded.field "cxx_flags" ?check in - C.Kind.Dict.make ~c ~cxx + Foreign.Language.Dict.make ~c ~cxx module Inline_tests = struct type t = @@ -32,7 +32,7 @@ module Stanza = struct type config = { flags : Ocaml_flags.Spec.t - ; c_flags : Ordered_set_lang.Unexpanded.t C.Kind.Dict.t + ; foreign_flags : Ordered_set_lang.Unexpanded.t Foreign.Language.Dict.t ; env_vars : Env.t ; binaries : File_binding.Unexpanded.t list ; inline_tests : Inline_tests.t option @@ -40,7 +40,8 @@ module Stanza = struct let empty_config = { flags = Ocaml_flags.Spec.standard - ; c_flags = C.Kind.Dict.make_both Ordered_set_lang.Unexpanded.standard + ; foreign_flags = + Foreign.Language.Dict.make_both Ordered_set_lang.Unexpanded.standard ; env_vars = Env.empty ; binaries = [] ; inline_tests = None @@ -72,14 +73,14 @@ module Stanza = struct let config = let+ flags = Ocaml_flags.Spec.decode - and+ c_flags = c_flags ~since:(Some (1, 7)) + and+ foreign_flags = foreign_flags ~since:(Some (1, 7)) and+ env_vars = env_vars_field and+ binaries = field ~default:[] "binaries" ( Dune_lang.Syntax.since Stanza.syntax (1, 6) >>> File_binding.Unexpanded.L.decode ) and+ inline_tests = inline_tests_field in - { flags; c_flags; env_vars; binaries; inline_tests } + { flags; foreign_flags; env_vars; binaries; inline_tests } let rule = enter diff --git a/src/dune/dune_env.mli b/src/dune/dune_env.mli index a04be47212c..de789e3bdb2 100644 --- a/src/dune/dune_env.mli +++ b/src/dune/dune_env.mli @@ -16,7 +16,7 @@ module Stanza : sig type config = { flags : Ocaml_flags.Spec.t - ; c_flags : Ordered_set_lang.Unexpanded.t C.Kind.Dict.t + ; foreign_flags : Ordered_set_lang.Unexpanded.t Foreign.Language.Dict.t ; env_vars : Env.t ; binaries : File_binding.Unexpanded.t list ; inline_tests : Inline_tests.t option @@ -31,9 +31,9 @@ module Stanza : sig ; rules : (pattern * config) list } - val c_flags : + val foreign_flags : since:Dune_lang.Syntax.Version.t option - -> Ordered_set_lang.Unexpanded.t C.Kind.Dict.t + -> Ordered_set_lang.Unexpanded.t Foreign.Language.Dict.t Dune_lang.Decoder.fields_parser val decode : t Dune_lang.Decoder.t diff --git a/src/dune/dune_file.ml b/src/dune/dune_file.ml index 15483fcd62e..fb41b02861c 100644 --- a/src/dune/dune_file.ml +++ b/src/dune/dune_file.ml @@ -162,110 +162,6 @@ module Pps_and_flags = struct (pps, all_flags) end -module Dep_conf = struct - type t = - | File of String_with_vars.t - | Alias of String_with_vars.t - | Alias_rec of String_with_vars.t - | Glob_files of String_with_vars.t - | Source_tree of String_with_vars.t - | Package of String_with_vars.t - | Universe - | Env_var of String_with_vars.t - | Sandbox_config of Sandbox_config.t - - let remove_locs = function - | File sw -> File (String_with_vars.remove_locs sw) - | Alias sw -> Alias (String_with_vars.remove_locs sw) - | Alias_rec sw -> Alias_rec (String_with_vars.remove_locs sw) - | Glob_files sw -> Glob_files (String_with_vars.remove_locs sw) - | Source_tree sw -> Source_tree (String_with_vars.remove_locs sw) - | Package sw -> Package (String_with_vars.remove_locs sw) - | Universe -> Universe - | Env_var sw -> Env_var sw - | Sandbox_config s -> Sandbox_config s - - let decode_sandbox_config = - let+ () = Dune_lang.Syntax.since Stanza.syntax (1, 12) - and+ loc, x = - located - (repeat - (sum - [ ("none", return Sandbox_config.Partial.no_sandboxing) - ; ("always", return Sandbox_config.Partial.needs_sandboxing) - ; ( "preserve_file_kind" - , return (Sandbox_config.Partial.disallow Sandbox_mode.symlink) - ) - ])) - in - Sandbox_config.Partial.merge ~loc x - - let decode = - let decode = - let sw = String_with_vars.decode in - sum - [ ("file", sw >>| fun x -> File x) - ; ("alias", sw >>| fun x -> Alias x) - ; ("alias_rec", sw >>| fun x -> Alias_rec x) - ; ("glob_files", sw >>| fun x -> Glob_files x) - ; ("package", sw >>| fun x -> Package x) - ; ("universe", return Universe) - ; ( "files_recursively_in" - , let+ () = - Dune_lang.Syntax.renamed_in Stanza.syntax (1, 0) - ~to_:"source_tree" - and+ x = sw in - Source_tree x ) - ; ( "source_tree" - , let+ () = Dune_lang.Syntax.since Stanza.syntax (1, 0) - and+ x = sw in - Source_tree x ) - ; ("env_var", sw >>| fun x -> Env_var x) - ; ("sandbox", decode_sandbox_config >>| fun x -> Sandbox_config x) - ] - in - if_list ~then_:decode ~else_:(String_with_vars.decode >>| fun x -> File x) - - open Dune_lang - - let encode = function - | File t -> - List [ Dune_lang.unsafe_atom_of_string "file"; String_with_vars.encode t ] - | Alias t -> - List - [ Dune_lang.unsafe_atom_of_string "alias"; String_with_vars.encode t ] - | Alias_rec t -> - List - [ Dune_lang.unsafe_atom_of_string "alias_rec" - ; String_with_vars.encode t - ] - | Glob_files t -> - List - [ Dune_lang.unsafe_atom_of_string "glob_files" - ; String_with_vars.encode t - ] - | Source_tree t -> - List - [ Dune_lang.unsafe_atom_of_string "source_tree" - ; String_with_vars.encode t - ] - | Package t -> - List - [ Dune_lang.unsafe_atom_of_string "package"; String_with_vars.encode t ] - | Universe -> Dune_lang.unsafe_atom_of_string "universe" - | Env_var t -> - List - [ Dune_lang.unsafe_atom_of_string "env_var"; String_with_vars.encode t ] - | Sandbox_config config -> - if Sandbox_config.equal config Sandbox_config.no_special_requirements - then - List [] - else - Code_error.raise "There's no syntax for [Sandbox_config] yet" [] - - let to_dyn t = Dune_lang.to_dyn (encode t) -end - module Preprocess = struct module Pps = struct type t = @@ -565,9 +461,8 @@ module Buildable = struct ; modules : Ordered_set_lang.t ; modules_without_implementation : Ordered_set_lang.t ; libraries : Lib_dep.t list - ; c_flags : Ordered_set_lang.Unexpanded.t C.Kind.Dict.t - ; c_names : Ordered_set_lang.t option - ; cxx_names : Ordered_set_lang.t option + ; foreign_archives : (Loc.t * string) list + ; foreign_stubs : Foreign.Stubs.t list ; preprocess : Preprocess_map.t ; preprocessor_deps : Dep_conf.t list ; lint : Preprocess_map.t @@ -576,19 +471,59 @@ module Buildable = struct ; allow_overlapping_dependencies : bool } - let decode ~since_c ~allow_re_export = - let check_c t = - match since_c with - | None -> t - | Some v -> Dune_lang.Syntax.since Stanza.syntax v >>> t + let decode ~in_library ~allow_re_export = + let use_foreign = + Dune_lang.Syntax.deleted_in Stanza.syntax (2, 0) + ~extra_info:"Use the (foreign_stubs ...) field instead." + in + let only_in_library decode = + if in_library then + decode + else + return None + in + let add_stubs language ~loc ~names ~flags foreign_stubs = + match names with + | None -> foreign_stubs + | Some names -> + let flags = + Option.value ~default:Ordered_set_lang.Unexpanded.standard flags + in + Foreign.Stubs.make ~loc ~language ~names ~flags :: foreign_stubs in let+ loc = loc and+ preprocess, preprocessor_deps = preprocess_fields and+ lint = field "lint" Lint.decode ~default:Lint.default - and+ c_flags = Dune_env.Stanza.c_flags ~since:since_c - and+ c_names = field_o "c_names" (check_c Ordered_set_lang.decode) - and+ cxx_names = field_o "cxx_names" (check_c Ordered_set_lang.decode) + and+ foreign_stubs = + multi_field "foreign_stubs" + (Dune_lang.Syntax.since Stanza.syntax (2, 0) >>> Foreign.Stubs.decode) + and+ foreign_archives = + field_o "foreign_archives" + ( Dune_lang.Syntax.since Stanza.syntax (2, 0) + >>> repeat (located string) ) + and+ c_flags = + only_in_library + (field_o "c_flags" (use_foreign >>> Ordered_set_lang.Unexpanded.decode)) + and+ cxx_flags = + only_in_library + (field_o "cxx_flags" + (use_foreign >>> Ordered_set_lang.Unexpanded.decode)) + and+ c_names_loc, c_names = + located + (only_in_library + (field_o "c_names" (use_foreign >>> Ordered_set_lang.decode))) + and+ cxx_names_loc, cxx_names = + located + (only_in_library + (field_o "cxx_names" (use_foreign >>> Ordered_set_lang.decode))) and+ modules = modules_field "modules" + and+ self_build_stubs_archive_loc, self_build_stubs_archive = + located + (only_in_library + (field ~default:None "self_build_stubs_archive" + ( Dune_lang.Syntax.deleted_in Stanza.syntax (2, 0) + ~extra_info:"Use the (foreign_archives ...) field instead." + >>> option string ))) and+ modules_without_implementation = modules_field "modules_without_implementation" and+ libraries = @@ -598,6 +533,37 @@ module Buildable = struct field "js_of_ocaml" Js_of_ocaml.decode ~default:Js_of_ocaml.default and+ allow_overlapping_dependencies = field_b "allow_overlapping_dependencies" + and+ version = Dune_lang.Syntax.get_exn Stanza.syntax in + let foreign_stubs = + foreign_stubs + |> add_stubs C ~loc:c_names_loc ~names:c_names ~flags:c_flags + |> add_stubs Cxx ~loc:cxx_names_loc ~names:cxx_names ~flags:cxx_flags + in + let foreign_archives = Option.value ~default:[] foreign_archives in + let foreign_archives = + if + version < (2, 0) + && List.is_non_empty foreign_stubs + && Option.is_some self_build_stubs_archive + then + User_error.raise ~loc:self_build_stubs_archive_loc + [ Pp.concat + [ Pp.textf "A library cannot use " + ; Pp.hbox (Pp.textf "(self_build_stubs_archive ...)") + ; Pp.textf " and " + ; Pp.hbox (Pp.textf "(c_names ...)") + ; Pp.textf " simultaneously. This is supported starting from " + ; Pp.hbox (Pp.textf "Dune 2.0.") + ] + ] + else + match self_build_stubs_archive with + | None -> foreign_archives + (* Note: we add "_stubs" to the name, since [self_build_stubs_archive] + used this naming convention; [foreign_archives] does not use it and + allows users to name archives as they like (they still need to add + the "lib" prefix, however, since standard linkers require it). *) + | Some name -> (loc, name ^ "_stubs") :: foreign_archives in { loc ; preprocess @@ -605,15 +571,17 @@ module Buildable = struct ; lint ; modules ; modules_without_implementation - ; c_flags - ; c_names - ; cxx_names + ; foreign_stubs + ; foreign_archives ; libraries ; flags ; js_of_ocaml ; allow_overlapping_dependencies } + let has_foreign 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 "") @@ -817,7 +785,6 @@ module Library = struct ; kind : Lib_kind.t ; library_flags : Ordered_set_lang.Unexpanded.t ; c_library_flags : Ordered_set_lang.Unexpanded.t - ; self_build_stubs_archive : string option ; virtual_deps : (Loc.t * Lib_name.t) list ; wrapped : Wrapped.t Lib_info.Inherited.t ; optional : bool @@ -838,7 +805,7 @@ module Library = struct let decode = fields - (let+ buildable = Buildable.decode ~since_c:None ~allow_re_export:true + (let+ buildable = Buildable.decode ~in_library:true ~allow_re_export:true and+ loc = loc and+ name = field_o "name" Lib_name.Local.decode_loc and+ public = Public_lib.public_name_field @@ -859,9 +826,6 @@ module Library = struct and+ kind = field "kind" Lib_kind.decode ~default:Lib_kind.Normal and+ wrapped = Wrapped.field and+ optional = field_b "optional" - and+ self_build_stubs_archive = - located - (field "self_build_stubs_archive" (option string) ~default:None) and+ no_dynlink = field_b "no_dynlink" and+ () = let check = @@ -965,29 +929,6 @@ module Library = struct | _ -> (); let variant = Option.map variant ~f:(fun (_, v) -> v) in - let self_build_stubs_archive = - let loc, self_build_stubs_archive = self_build_stubs_archive in - let err = - match - ( buildable.c_names - , buildable.cxx_names - , self_build_stubs_archive ) - with - | _, _, None -> None - | Some _, _, Some _ -> Some "c_names" - | _, Some _, Some _ -> Some "cxx_names" - | None, None, _ -> None - in - match err with - | None -> self_build_stubs_archive - | Some name -> - User_error.raise ~loc - [ Pp.textf - "A library cannot use (self_build_stubs_archive ...) and \ - (%s ...) simultaneously." - name - ] - in Blang.fold_vars enabled_if ~init:() ~f:(fun var () -> match ( String_with_vars.Var.name var @@ -1013,7 +954,6 @@ module Library = struct ; kind ; library_flags ; c_library_flags - ; self_build_stubs_archive ; virtual_deps ; wrapped ; optional @@ -1032,28 +972,24 @@ module Library = struct ; enabled_if } )) - let has_stubs t = - match - (t.buildable.c_names, t.buildable.cxx_names, t.self_build_stubs_archive) - with - | None, None, None -> false - | _ -> true + let has_foreign t = Buildable.has_foreign t.buildable - let stubs_name t = - let name = - match t.self_build_stubs_archive with - | None -> Lib_name.Local.to_string (snd t.name) - | Some s -> s - in - name ^ "_stubs" + let stubs_archive_name t = Lib_name.Local.to_string (snd t.name) ^ "_stubs" - let stubs t ~dir = Path.Build.relative dir (stubs_name t) + let archive_names t = + ( if List.is_empty t.buildable.foreign_stubs then + [] + else + [ stubs_archive_name t ] ) + @ List.map ~f:snd t.buildable.foreign_archives - let stubs_archive t ~dir ~ext_lib = - Path.Build.relative dir (sprintf "lib%s%s" (stubs_name t) ext_lib) + let lib_files t ~dir ~ext_lib = + List.map (archive_names t) ~f:(fun archive_name -> + Foreign.lib_file ~archive_name ~dir ~ext_lib) - let dll t ~dir ~ext_dll = - Path.Build.relative dir (sprintf "dll%s%s" (stubs_name t) ext_dll) + let dll_files t ~dir ~ext_dll = + List.map (archive_names t) ~f:(fun archive_name -> + Foreign.dll_file ~archive_name ~dir ~ext_dll) let archive t ~dir ~ext = Path.Build.relative dir (Lib_name.Local.to_string (snd t.name) ^ ext) @@ -1105,12 +1041,7 @@ module Library = struct in let virtual_library = is_virtual conf in let foreign_archives = - let stubs = - if has_stubs conf then - [ stubs_archive conf ~dir ~ext_lib ] - else - [] - in + let stubs = lib_files conf ~dir ~ext_lib in { Mode.Dict.byte = stubs ; native = Path.Build.relative dir (Lib_name.Local.to_string lib_name ^ ext_lib) @@ -1552,8 +1483,7 @@ module Executables = struct Dune_project.Extension.register syntax (return ((), [])) Dyn.Encoder.unit let common = - let+ buildable = - Buildable.decode ~since_c:(Some (2, 0)) ~allow_re_export:false + let+ buildable = Buildable.decode ~in_library:false ~allow_re_export:false and+ (_ : bool) = field "link_executables" ~default:true (Dune_lang.Syntax.deleted_in Stanza.syntax (1, 0) >>> bool) @@ -1649,10 +1579,7 @@ module Executables = struct in (make false, make true) - let has_stubs t = - match (t.buildable.c_names, t.buildable.cxx_names) with - | None, None -> false - | _ -> true + let has_foreign t = Buildable.has_foreign t.buildable let obj_dir t ~dir = Obj_dir.make_exe ~dir ~name:(snd (List.hd t.names)) end @@ -2071,7 +1998,7 @@ module Tests = struct let gen_parse names = fields (let+ buildable = - Buildable.decode ~since_c:(Some (2, 0)) ~allow_re_export:false + Buildable.decode ~in_library:false ~allow_re_export:false and+ link_flags = Ordered_set_lang.Unexpanded.field "link_flags" and+ variants = variants_field and+ names = names @@ -2211,6 +2138,7 @@ end type Stanza.t += | Library of Library.t + | Foreign_library of Foreign.Library.t | Executables of Executables.t | Rule of Rule.t | Install of File_binding.Unexpanded.t Install_conf.t @@ -2242,6 +2170,10 @@ module Stanzas = struct [ ( "library" , let+ x = Library.decode in [ Library x ] ) + ; ( "foreign_library" + , let+ () = Dune_lang.Syntax.since Stanza.syntax (2, 0) + and+ x = Foreign.Library.decode in + [ Foreign_library x ] ) ; ("executable", Executables.single >>| execs) ; ("executables", Executables.multi >>| execs) ; ( "rule" diff --git a/src/dune/dune_file.mli b/src/dune/dune_file.mli index e99c1f401b3..115daded83d 100644 --- a/src/dune/dune_file.mli +++ b/src/dune/dune_file.mli @@ -1,4 +1,4 @@ -(** Representation and parsing of jbuild files *) +(** Representation and parsing of Dune files *) open! Stdune open Import @@ -83,29 +83,6 @@ module Lib_deps : sig val decode : allow_re_export:bool -> t Dune_lang.Decoder.t end -module Dep_conf : sig - type t = - | File of String_with_vars.t - | Alias of String_with_vars.t - | Alias_rec of String_with_vars.t - | Glob_files of String_with_vars.t - | Source_tree of String_with_vars.t - | Package of String_with_vars.t - | Universe - | Env_var of String_with_vars.t - (* [Sandbox_config] is a way to declare that your action also depends on - there being a clean filesystem around its deps. (or, if you require - [no_sandboxing], it's that your action depends on something undeclared - (e.g. absolute path of cwd) and you want to allow it) *) - | Sandbox_config of Sandbox_config.t - - val remove_locs : t -> t - - include Dune_lang.Conv.S with type t := t - - val to_dyn : t Dyn.Encoder.t -end - (** [preprocess] and [preprocessor_deps] fields *) val preprocess_fields : (Preprocess_map.t * Dep_conf.t list) Dune_lang.Decoder.fields_parser @@ -116,9 +93,8 @@ module Buildable : sig ; modules : Ordered_set_lang.t ; modules_without_implementation : Ordered_set_lang.t ; libraries : Lib_dep.t list - ; c_flags : Ordered_set_lang.Unexpanded.t C.Kind.Dict.t - ; c_names : Ordered_set_lang.t option - ; cxx_names : Ordered_set_lang.t option + ; foreign_archives : (Loc.t * string) list + ; foreign_stubs : Foreign.Stubs.t list ; preprocess : Preprocess_map.t ; preprocessor_deps : Dep_conf.t list ; lint : Lint.t @@ -127,6 +103,9 @@ module Buildable : sig ; allow_overlapping_dependencies : bool } + (** Check if the buildable has any foreign stubs or archives. *) + val has_foreign : t -> bool + (** Preprocessing specification used by all modules or [No_preprocessing] *) val single_preprocess : t -> Preprocess.t end @@ -199,9 +178,13 @@ 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 ; c_library_flags : Ordered_set_lang.Unexpanded.t - ; self_build_stubs_archive : string option ; virtual_deps : (Loc.t * Lib_name.t) list ; wrapped : Wrapped.t Lib_info.Inherited.t ; optional : bool @@ -220,16 +203,25 @@ module Library : sig ; enabled_if : Blang.t } - val has_stubs : t -> bool + (** Check if the library has any foreign stubs or archives. *) + val has_foreign : t -> bool - val stubs_name : t -> string + (** The name of the automatically built foreign stubs archive. *) + val stubs_archive_name : t -> string - val stubs : t -> dir:Path.Build.t -> Path.Build.t + (** The names of all foreign archives, including the foreign stubs archive. *) + val archive_names : t -> string list - val stubs_archive : t -> dir:Path.Build.t -> ext_lib:string -> Path.Build.t + (** The [lib*.a] files of all foreign archives, including foreign stubs. + [dir] is the directory the library is declared in. *) + val lib_files : t -> dir:Path.Build.t -> ext_lib:string -> Path.Build.t list - val dll : t -> dir:Path.Build.t -> ext_dll:string -> Path.Build.t + (** The [dll*.a] files of all foreign archives, including foreign stubs. + [dir] is the directory the library is declared in. *) + val dll_files : t -> dir:Path.Build.t -> ext_dll:string -> Path.Build.t list + (** The path to a library archive. + [dir] is the directory the library is declared in. *) val archive : t -> dir:Path.Build.t -> ext:string -> Path.Build.t val best_name : t -> Lib_name.t @@ -325,7 +317,8 @@ module Executables : sig ; bootstrap_info : string option } - val has_stubs : t -> bool + (** Check if the executables have any foreign stubs or archives. *) + val has_foreign : t -> bool val obj_dir : t -> dir:Path.Build.t -> Path.Build.t Obj_dir.t end @@ -481,6 +474,7 @@ end type Stanza.t += | Library of Library.t + | Foreign_library of Foreign.Library.t | Executables of Executables.t | Rule of Rule.t | Install of File_binding.Unexpanded.t Install_conf.t diff --git a/src/dune/env_node.ml b/src/dune/env_node.ml index e482b953777..14baaf93859 100644 --- a/src/dune/env_node.ml +++ b/src/dune/env_node.ml @@ -7,7 +7,7 @@ type t = ; config : Dune_env.Stanza.t ; mutable local_binaries : File_binding.Expanded.t list option ; mutable ocaml_flags : Ocaml_flags.t option - ; mutable c_flags : string list Build.t C.Kind.Dict.t option + ; mutable foreign_flags : string list Build.t Foreign.Language.Dict.t option ; mutable external_ : Env.t option ; mutable bin_artifacts : Artifacts.Bin.t option ; mutable inline_tests : Dune_env.Stanza.Inline_tests.t option @@ -21,7 +21,7 @@ let make ~dir ~inherit_from ~scope ~config = ; scope ; config ; ocaml_flags = None - ; c_flags = None + ; foreign_flags = None ; external_ = None ; bin_artifacts = None ; local_binaries = None @@ -61,7 +61,7 @@ let rec external_ t ~profile ~default = in let env, have_binaries = let cfg = find_config t ~profile in - (Env.extend_env default cfg.env_vars, not (List.is_empty cfg.binaries)) + (Env.extend_env default cfg.env_vars, List.is_non_empty cfg.binaries) in let env = if have_binaries then @@ -129,21 +129,21 @@ let rec inline_tests t ~profile = t.inline_tests <- Some state; state -let rec c_flags t ~profile ~expander ~default_context_flags = - match t.c_flags with +let rec foreign_flags t ~profile ~expander ~default_context_flags = + match t.foreign_flags with | Some x -> x | None -> let default = match t.inherit_from with - | None -> C.Kind.Dict.map ~f:Build.return default_context_flags - | Some (lazy t) -> c_flags t ~profile ~expander ~default_context_flags + | None -> Foreign.Language.Dict.map ~f:Build.return default_context_flags + | Some (lazy t) -> foreign_flags t ~profile ~expander ~default_context_flags in let flags = let cfg = find_config t ~profile in let expander = Expander.set_dir expander ~dir:t.dir in - C.Kind.Dict.mapi cfg.c_flags ~f:(fun ~kind f -> - let default = C.Kind.Dict.get default kind in + Foreign.Language.Dict.mapi cfg.foreign_flags ~f:(fun ~language f -> + let default = Foreign.Language.Dict.get default language in Expander.expand_and_eval_set expander f ~standard:default) in - t.c_flags <- Some flags; + t.foreign_flags <- Some flags; flags diff --git a/src/dune/env_node.mli b/src/dune/env_node.mli index 8183b62bd8e..9940d711183 100644 --- a/src/dune/env_node.mli +++ b/src/dune/env_node.mli @@ -20,12 +20,12 @@ val ocaml_flags : val inline_tests : t -> profile:Profile.t -> Dune_env.Stanza.Inline_tests.t -val c_flags : +val foreign_flags : t -> profile:Profile.t -> expander:Expander.t - -> default_context_flags:string list C.Kind.Dict.t - -> string list Build.t C.Kind.Dict.t + -> default_context_flags:string list Foreign.Language.Dict.t + -> string list Build.t Foreign.Language.Dict.t val local_binaries : t -> profile:Profile.t -> expander:Expander.t -> File_binding.Expanded.t list diff --git a/src/dune/exe.ml b/src/dune/exe.ml index f6fc4f6d1f9..6e6f50fe926 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 f2cad9954ed..eda43c4e688 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 59fec846488..dec75f6461f 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 = @@ -79,11 +79,32 @@ 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 + (* TODO: Currently [exe_rules] differ from [lib_rules] in some aspects and + the reason is unclear. For example, instead of building an archive for + foreign stubs, we link the corresponding object files directly. It would + be nice to make the code more uniform. *) + let ext_lib = ctx.lib_config.ext_lib in + let link_args = + let+ flags = link_flags in + Command.Args.S + [ Command.Args.As flags + ; Command.Args.S + (List.map archive_names ~f:(fun archive_name -> + let dir, archive_name = + Path.Build.relative dir (Filename.dirname 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 = let requires_link = Lib.Compile.requires_link compile_info in @@ -107,28 +128,39 @@ let executables_rules ~sctx ~dir ~expander ~dir_contents ~scope ~compile_info ~js_of_ocaml ~opaque:(SC.opaque sctx) ~dynlink ~package:exes.package in let o_files = - if not (Executables.has_stubs exes) then + if not (Executables.has_foreign 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 "Did you forget to add `(modes exe)'?" - ]; - let c_sources = - Dir_contents.c_sources_of_executables dir_contents ~first_exe + [ Pp.textf "Pure bytecode executables cannot contain foreign %s." + what + ] + ~hints: + [ Pp.text + "If you only need to build a native executable use \"(modes \ + exe)\"." + ]; + let foreign_sources = + Dir_contents.foreign_sources_of_executables dir_contents ~first_exe in let o_files = - C_rules.build_o_files exes.buildable ~sctx ~dir ~expander - ~requires:requires_compile ~dir_contents ~c_sources + Foreign_rules.build_o_files ~sctx ~dir ~expander + ~requires:requires_compile ~dir_contents ~foreign_sources + ~extra_flags:Command.Args.empty ~extra_deps:[] |> List.map ~f:Path.build 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 + 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/expander.ml b/src/dune/expander.ml index e3da046b755..a105652c3ef 100644 --- a/src/dune/expander.ml +++ b/src/dune/expander.ml @@ -307,9 +307,9 @@ type expansion_kind = | Dynamic | Static -let cc_of_c_flags t (cc : string list Build.t C.Kind.Dict.t) = +let cc_of_c_flags t (cc : string list Build.t Foreign.Language.Dict.t) = let open Build.O in - C.Kind.Dict.map cc ~f:(fun cc -> + Foreign.Language.Dict.map cc ~f:(fun cc -> let+ flags = cc in Value.L.strings (t.c_compiler :: flags)) @@ -325,7 +325,7 @@ let cannot_be_used_here pform = let expand_and_record acc ~map_exe ~dep_kind ~expansion_kind ~(dir : Path.Build.t) ~pform t expansion - ~(cc : dir:Path.Build.t -> Value.t list Build.t C.Kind.Dict.t) = + ~(cc : dir:Path.Build.t -> Value.t list Build.t Foreign.Language.Dict.t) = let key = String_with_vars.Var.full_name pform in let loc = String_with_vars.Var.loc pform in let relative d s = Path.build (Path.Build.relative ~error_loc:loc d s) in @@ -504,8 +504,9 @@ let expand_no_ddeps acc ~dir ~dep_kind ~map_exe ~expand_var ~cc t pform Option.map res ~f:static let gen_with_record_deps ~expand t resolved_forms ~dep_kind ~map_exe - ~(c_flags : dir:Path.Build.t -> string list Build.t C.Kind.Dict.t) = - let cc ~dir = cc_of_c_flags t (c_flags ~dir) in + ~(foreign_flags : + dir:Path.Build.t -> string list Build.t Foreign.Language.Dict.t) = + let cc ~dir = cc_of_c_flags t (foreign_flags ~dir) in let expand_var = expand (* we keep the dir constant here to replicate the old behavior of: (chdir diff --git a/src/dune/expander.mli b/src/dune/expander.mli index 242dcfd1916..e6c303a89c0 100644 --- a/src/dune/expander.mli +++ b/src/dune/expander.mli @@ -108,7 +108,7 @@ val with_record_deps : -> targets_written_by_user:Targets.t -> dep_kind:Lib_deps_info.Kind.t -> map_exe:(Path.t -> Path.t) - -> c_flags:(dir:Path.Build.t -> string list Build.t C.Kind.Dict.t) + -> foreign_flags:(dir:Path.Build.t -> string list Build.t Foreign.Language.Dict.t) -> t val with_record_no_ddeps : @@ -116,7 +116,7 @@ val with_record_no_ddeps : -> Resolved_forms.t -> dep_kind:Lib_deps_info.Kind.t -> map_exe:(Path.t -> Path.t) - -> c_flags:(dir:Path.Build.t -> string list Build.t C.Kind.Dict.t) + -> foreign_flags:(dir:Path.Build.t -> string list Build.t Foreign.Language.Dict.t) -> t val add_ddeps_and_bindings : diff --git a/src/dune/findlib/findlib.ml b/src/dune/findlib/findlib.ml index e06510469aa..9186b2b1dde 100644 --- a/src/dune/findlib/findlib.ml +++ b/src/dune/findlib/findlib.ml @@ -237,9 +237,7 @@ module Package = struct let modes : Mode.Dict.Set.t = (* libraries without archives are compatible with all modes. mainly a hack for compiler-libs which doesn't have any archives *) - let discovered = - Mode.Dict.map ~f:(fun x -> not (List.is_empty x)) archives - in + let discovered = Mode.Dict.map ~f:List.is_non_empty archives in if Mode.Dict.Set.is_empty discovered then Mode.Dict.Set.all else diff --git a/src/dune/foreign.ml b/src/dune/foreign.ml new file mode 100644 index 00000000000..edd8aeb93eb --- /dev/null +++ b/src/dune/foreign.ml @@ -0,0 +1,247 @@ +open Stdune + +let header_ext = ".h" + +module Language = struct + module T = struct + type t = + | C + | Cxx + + let compare x y = + match (x, y) with + | C, C -> Eq + | C, _ -> Lt + | _, C -> Gt + | Cxx, Cxx -> Eq + + let equal x y = + match (x, y) with + | C, C -> true + | Cxx, Cxx -> true + | _, _ -> false + + let to_dyn = function + | C -> Dyn.Variant ("C", []) + | Cxx -> Dyn.Variant ("Cxx", []) + end + + include T + + let proper_name = function + | C -> "C" + | Cxx -> "C++" + + let encode = function + | C -> "c" + | Cxx -> "cxx" + + let decode = Dune_lang.Decoder.enum [ (encode C, C); (encode Cxx, Cxx) ] + + type split = + | Unrecognized + | Not_allowed_until of Dune_lang.Syntax.Version.t + | Recognized of string * t + + let cxx_version_introduced ~obj ~dune_version ~version_introduced = + if dune_version >= version_introduced then + Recognized (obj, Cxx) + else + Not_allowed_until version_introduced + + let split_extension fn ~dune_version = + match String.rsplit2 fn ~on:'.' with + | Some (obj, "c") -> Recognized (obj, C) + | Some (obj, "cpp") -> Recognized (obj, Cxx) + | Some (obj, "cxx") -> + cxx_version_introduced ~obj ~dune_version ~version_introduced:(1, 8) + | Some (obj, "cc") -> + cxx_version_introduced ~obj ~dune_version ~version_introduced:(1, 10) + | _ -> Unrecognized + + let possible_exts ~dune_version = function + | C -> [ ".c" ] + | Cxx -> + let exts = [ ".cpp" ] in + let exts = + if dune_version >= (1, 10) then + ".cc" :: exts + else + exts + in + if dune_version >= (1, 8) then + ".cxx" :: exts + else + exts + + let possible_fns t fn ~dune_version = + possible_exts t ~dune_version |> List.map ~f:(fun ext -> fn ^ ext) + + include Comparable.Make (T) + + module Dict = struct + type 'a t = + { c : 'a + ; cxx : 'a + } + + let c t = t.c + + let cxx t = t.cxx + + let map { c; cxx } ~f = { c = f c; cxx = f cxx } + + let mapi { c; cxx } ~f = { c = f ~language:C c; cxx = f ~language:Cxx cxx } + + let make_both a = { c = a; cxx = a } + + let make ~c ~cxx = { c; cxx } + + let get { c; cxx } = function + | C -> c + | Cxx -> cxx + + let add t k v = + match k with + | C -> { t with c = v } + | Cxx -> { t with cxx = v } + + let update t k ~f = + let v = get t k in + add t k (f v) + + let merge t1 t2 ~f = { c = f t1.c t2.c; cxx = f t1.cxx t2.cxx } + end +end + +let all_possible_exts = + let exts = Language.possible_exts ~dune_version:Stanza.latest_version in + (header_ext :: exts C) @ exts Cxx + +let c_cxx_or_header ~fn = + let ext = Filename.extension fn in + List.mem ~set:all_possible_exts ext + +module Stubs = struct + type t = + { loc : Loc.t + ; language : Language.t + ; names : Ordered_set_lang.t + ; flags : Ordered_set_lang.Unexpanded.t + ; include_dirs : String_with_vars.t list + ; extra_deps : Dep_conf.t list + } + + let make ~loc ~language ~names ~flags = + { loc; language; names; flags; include_dirs = []; extra_deps = [] } + + let decode_stubs = + let open Dune_lang.Decoder in + let+ loc = loc + and+ loc_archive_name, archive_name = + located (field_o "archive_name" string) + and+ language = field "language" Language.decode + and+ names = field "names" Ordered_set_lang.decode + and+ flags = Ordered_set_lang.Unexpanded.field "flags" + and+ include_dirs = + field ~default:[] "include_dirs" (repeat String_with_vars.decode) + and+ extra_deps = field_o "extra_deps" (repeat Dep_conf.decode) in + let extra_deps = Option.value ~default:[] extra_deps in + let () = + match archive_name with + | None -> () + | Some _ -> + User_error.raise ~loc:loc_archive_name + [ Pp.textf + "The field \"archive_name\" is not allowed in the (foreign_stubs \ + ...) stanza. For named foreign archives use the \ + (foreign_library ...) stanza." + ] + in + { loc; language; names; flags; include_dirs; extra_deps } + + let decode = Dune_lang.Decoder.fields decode_stubs +end + +module Library = struct + type t = + { archive_name : string + ; archive_name_loc : Loc.t + ; stubs : Stubs.t + } + + let decode = + let open Dune_lang.Decoder in + fields + (let+ archive_name_loc, archive_name = + located (field "archive_name" string) + and+ stubs = Stubs.decode_stubs in + { archive_name; archive_name_loc; stubs }) +end + +let lib_file ~archive_name ~dir ~ext_lib = + Path.Build.relative dir (sprintf "lib%s%s" archive_name ext_lib) + +let dll_file ~archive_name ~dir ~ext_dll = + Path.Build.relative dir (sprintf "dll%s%s" archive_name ext_dll) + +module Source = struct + (* we store the entire [stubs] record even though [t] only describes an + individual source file *) + type t = + { stubs : Stubs.t + ; path : Path.Build.t + } + + let language t = t.stubs.language + + let flags t = t.stubs.flags + + let path t = t.path + + let make ~stubs ~path = { stubs; path } +end + +module Sources = struct + type t = (Loc.t * Source.t) String.Map.t + + let object_files t ~dir ~ext_obj = + String.Map.keys t + |> List.map ~f:(fun c -> Path.Build.relative dir (c ^ ext_obj)) + + module Unresolved = struct + type t = (Language.t * Path.Build.t) String.Map.Multi.t + + let to_dyn t = + String.Map.to_dyn + (fun xs -> + Dyn.List + (List.map xs ~f:(fun (language, path) -> + Dyn.Tuple [ Language.to_dyn language; Path.Build.to_dyn path ]))) + t + + let load ~dune_version ~dir ~files = + let init = String.Map.empty in + String.Set.fold files ~init ~f:(fun fn acc -> + match Language.split_extension fn ~dune_version with + | Unrecognized -> acc + | Not_allowed_until version -> + (* CR-someday aalekseyev: + Raising in [Not_allowed_until] can break backwards compatibility + when we change a file from [Unrecognized] to [Not_allowed_until]. + + An easy fix would be to treat [Not_allowed_until] as + [Unrecognized], but the error messages are not good then. *) + let loc = Loc.in_dir (Path.build dir) in + User_error.raise ~loc + [ Pp.textf + "The extension %s of the source file %S is not supported \ + until version %s." + (Filename.extension fn) fn + (Dune_lang.Syntax.Version.to_string version) + ] + | Recognized (obj, language) -> + let path = Path.Build.relative dir fn in + String.Map.add_multi acc obj (language, path)) + end +end diff --git a/src/dune/foreign.mli b/src/dune/foreign.mli new file mode 100644 index 00000000000..91e57c9b959 --- /dev/null +++ b/src/dune/foreign.mli @@ -0,0 +1,172 @@ +open Stdune + +val header_ext : string + +val c_cxx_or_header : fn:string -> bool + +module Language : sig + type t = + | C + | Cxx + + val compare : t -> t -> ordering + + val equal : t -> t -> bool + + val to_dyn : t -> Dyn.t + + (** The proper name of a language, e.g. "C++" for [Cxx]. Useful for + diagnostic messages. *) + val proper_name : t -> string + + (** The string used to encode a language in Dune files, e.g. "cxx" for [Cxx]. *) + val encode : t -> string + + val decode : t Dune_lang.Decoder.t + + type split = + | Unrecognized + | Not_allowed_until of Dune_lang.Syntax.Version.t + | Recognized of string * t + + val split_extension : + string -> dune_version:Dune_lang.Syntax.Version.t -> split + + (** [possible_fns t s] returns the possible filenames given the + extension-less basenames [s] *) + val possible_fns : + t -> string -> dune_version:Dune_lang.Syntax.Version.t -> string list + + module Map : sig + include Map.S with type key = t + end + + module Dict : sig + type language + + type 'a t = + { c : 'a + ; cxx : 'a + } + + val c : 'a t -> 'a + + val cxx : 'a t -> 'a + + val map : 'a t -> f:('a -> 'b) -> 'b t + + val mapi : 'a t -> f:(language:language -> 'a -> 'b) -> 'b t + + val make_both : 'a -> 'a t + + val make : c:'a -> cxx:'a -> 'a t + + val update : 'a t -> language -> f:('a -> 'a) -> 'a t + + val merge : 'a t -> 'b t -> f:('a -> 'b -> 'c) -> 'c t + + val get : 'a t -> language -> 'a + end + with type language := t +end + +(** A type of foreign library "stubs", which includes all fields of the + [Library.t] type except for the [archive_name] field. The type is parsed as + an optional [foreign_stubs] field of the [library] stanza, or as part of + the top-level [foreign_library] stanza. *) +module Stubs : sig + type t = + { loc : Loc.t + ; language : Language.t + ; names : Ordered_set_lang.t + ; flags : Ordered_set_lang.Unexpanded.t + ; include_dirs : String_with_vars.t list + ; extra_deps : Dep_conf.t list + } + + (** Construct foreign library stubs with some fields set to default values. *) + val make : + loc:Loc.t + -> language:Language.t + -> names:Ordered_set_lang.t + -> flags:Ordered_set_lang.Unexpanded.t + -> t + + val decode : t Dune_lang.Decoder.t +end + +(** Foreign libraries. + + This data type represents the contents of the top-level stanza + [foreign_library]. + + The fields have the following semantics. + + [language] selects the compiler. At the moment, we support only [c] and + [cxx] settings, but in future other languages/compilers could be supported, + e.g. Rust and Clang. + + [archive_name] determines the names of the resulting [.a] archive files. + + [names] are names of source files. The full paths to the files are + determined by scanning package directories. Duplicate file names are + disallowed to avoid conflicting object names in the resulting archive file. + + [flags] are passed when compiling source files. + + [include_dirs] are tracked as dependencies and passed to the compiler via + the "-I" flag. + + [extra_deps] are tracked as dependencies. *) +module Library : sig + type t = + { archive_name : string + ; archive_name_loc : Loc.t + ; stubs : Stubs.t + } + + val decode : t Dune_lang.Decoder.t +end + +val lib_file : + archive_name:string -> dir:Path.Build.t -> ext_lib:string -> Path.Build.t + +val dll_file : + archive_name:string -> dir:Path.Build.t -> ext_dll:string -> Path.Build.t + +(** A foreign source file that has a [path] and all information of the + corresponnding [Foreign.Stubs.t] declaration. *) +module Source : sig + type t + + val language : t -> Language.t + + val flags : t -> Ordered_set_lang.Unexpanded.t + + val path : t -> Path.Build.t + + val make : stubs:Stubs.t -> path:Path.Build.t -> t +end + +(** A map from object names to the corresponding sources. *) +module Sources : sig + type t = (Loc.t * Source.t) String.Map.t + + val object_files : + t -> dir:Path.Build.t -> ext_obj:string -> Path.Build.t list + + (** A map from object names to lists of possible language/path combinations. *) + module Unresolved : sig + type t = (Language.t * Path.Build.t) String.Map.Multi.t + + val to_dyn : t -> Dyn.t + + (** [load ~dir ~files] loads foreign sources in [dir] into a map keyed by + the object name. *) + val load : + dune_version:Dune_lang.Syntax.Version.t + -> dir:Path.Build.t + -> files:String.Set.t + -> t + end +end diff --git a/src/dune/c_rules.ml b/src/dune/foreign_rules.ml similarity index 58% rename from src/dune/c_rules.ml rename to src/dune/foreign_rules.ml index 2db48d78d28..3fc66a973d0 100644 --- a/src/dune/c_rules.ml +++ b/src/dune/foreign_rules.ml @@ -1,24 +1,24 @@ open! Stdune -open Dune_file -let build_c_file (buildable : Buildable.t) ~sctx ~dir ~expander ~includes - (loc, src, dst) = +let build_c_file ~sctx ~dir ~expander ~include_flags (loc, src, dst) = + let flags = Foreign.Source.flags src in let ctx = Super_context.context sctx in let c_flags = - (Super_context.c_flags sctx ~dir ~expander ~flags:buildable.c_flags).c + Super_context.foreign_flags sctx ~dir ~expander ~flags + ~language:Foreign.Language.C in Super_context.add_rule sctx ~loc ~dir (* With sandboxing we get errors like: bar.c:2:19: fatal error: foo.cxx: No such file or directory #include "foo.cxx" *) ~sandbox:Sandbox_config.no_sandboxing - (let src = Path.build (C.Source.path src) in + (let src = Path.build (Foreign.Source.path src) in Command.run (* We have to execute the rule in the library directory as the .o is produced in the current directory *) ~dir:(Path.build dir) (Ok ctx.ocamlc) [ A "-g" - ; includes + ; include_flags ; Dyn (Build.map c_flags ~f:(fun x -> Command.quote_args "-ccopt" x)) ; A "-o" ; Target dst @@ -26,8 +26,8 @@ let build_c_file (buildable : Buildable.t) ~sctx ~dir ~expander ~includes ]); dst -let build_cxx_file (buildable : Buildable.t) ~sctx ~dir ~expander ~includes - (loc, src, dst) = +let build_cxx_file ~sctx ~dir ~expander ~include_flags (loc, src, dst) = + let flags = Foreign.Source.flags src in let ctx = Super_context.context sctx in let output_param = if ctx.ccomp_type = "msvc" then @@ -36,34 +36,37 @@ let build_cxx_file (buildable : Buildable.t) ~sctx ~dir ~expander ~includes [ A "-o"; Target dst ] in let cxx_flags = - (Super_context.c_flags sctx ~dir ~expander ~flags:buildable.c_flags).cxx + Super_context.foreign_flags sctx ~dir ~expander ~flags + ~language:Foreign.Language.Cxx in Super_context.add_rule sctx ~loc ~dir (* this seems to work with sandboxing, but for symmetry with [build_c_file] disabling that here too *) ~sandbox:Sandbox_config.no_sandboxing - (let src = Path.build (C.Source.path src) in + (let src = Path.build (Foreign.Source.path src) in Command.run (* We have to execute the rule in the library directory as the .o is produced in the current directory *) ~dir:(Path.build dir) (Super_context.resolve_program ~loc:None ~dir sctx ctx.c_compiler) ( [ Command.Args.S [ A "-I"; Path ctx.stdlib_dir ] - ; includes + ; include_flags ; Command.Args.dyn cxx_flags ] @ output_param @ [ A "-c"; Dep src ] )); dst -let build_o_files buildable ~sctx ~(c_sources : C.Sources.t) ~dir ~expander - ~requires ~dir_contents = +(* TODO: [requires] is a confusing name, probably because it's too general: it + looks like it's a list of libraries we depend on. *) +let build_o_files ~sctx ~foreign_sources ~(dir : Path.Build.t) ~expander + ~requires ~dir_contents ~extra_flags ~(extra_deps : Dep_conf.t list) = let ctx = Super_context.context sctx in let all_dirs = Dir_contents.dirs dir_contents in let h_files = List.fold_left all_dirs ~init:[] ~f:(fun acc dc -> String.Set.fold (Dir_contents.text_files dc) ~init:acc ~f:(fun fn acc -> - if String.is_suffix fn ~suffix:C.header_ext then + if String.is_suffix fn ~suffix:Foreign.header_ext then Path.relative (Path.build (Dir_contents.dir dc)) fn :: acc else acc)) @@ -80,11 +83,20 @@ let build_o_files buildable ~sctx ~(c_sources : C.Sources.t) ~dir ~expander ]) ] in - let build_x_files build_x files = - String.Map.to_list files - |> List.map ~f:(fun (obj, (loc, src)) -> - let dst = Path.Build.relative dir (obj ^ ctx.lib_config.ext_obj) in - build_x buildable ~sctx ~dir ~expander ~includes (loc, src, dst)) + let extra_deps = + let open Build.O in + let+ () = Super_context.Deps.interpret sctx extra_deps ~expander in + Command.Args.empty in - let { C.Kind.Dict.c; cxx } = C.Sources.split_by_kind c_sources in - build_x_files build_c_file c @ build_x_files build_cxx_file cxx + let include_flags = + Command.Args.S [ includes; extra_flags; Dyn extra_deps ] + in + String.Map.to_list foreign_sources + |> List.map ~f:(fun (obj, (loc, src)) -> + let dst = Path.Build.relative dir (obj ^ ctx.lib_config.ext_obj) in + let build_file = + match Foreign.Source.language src with + | C -> build_c_file + | Cxx -> build_cxx_file + in + build_file ~sctx ~dir ~expander ~include_flags (loc, src, dst)) diff --git a/src/dune/c_rules.mli b/src/dune/foreign_rules.mli similarity index 54% rename from src/dune/c_rules.mli rename to src/dune/foreign_rules.mli index adf5fa2a9b7..1cefaf9cf82 100644 --- a/src/dune/c_rules.mli +++ b/src/dune/foreign_rules.mli @@ -1,13 +1,13 @@ open! Stdune open Import -open Dune_file val build_o_files : - Buildable.t - -> sctx:Super_context.t - -> c_sources:C.Sources.t + sctx:Super_context.t + -> foreign_sources:Foreign.Sources.t -> dir:Path.Build.t -> expander:Expander.t -> requires:Lib.L.t Or_exn.t -> dir_contents:Dir_contents.t + -> extra_flags:Command.Args.dynamic Command.Args.t + -> extra_deps:Dep_conf.t list -> Path.Build.t list diff --git a/src/dune/foreign_sources.ml b/src/dune/foreign_sources.ml new file mode 100644 index 00000000000..906bf6f9f88 --- /dev/null +++ b/src/dune/foreign_sources.ml @@ -0,0 +1,177 @@ +open Stdune +open Dune_file +module Library = Dune_file.Library + +(* TODO: This is a strange module; it seems to add unnecessary indirection for + accessing foreign sources. It's worth checking if it can be simplified away. *) +type t = + { libraries : Foreign.Sources.t Lib_name.Map.t + ; archives : Foreign.Sources.t String.Map.t + ; executables : Foreign.Sources.t String.Map.t + } + +let for_lib t ~name = Lib_name.Map.find_exn t.libraries name + +let for_archive t ~archive_name = String.Map.find_exn t.archives archive_name + +let for_exes t ~first_exe = String.Map.find_exn t.executables first_exe + +let empty = + { libraries = Lib_name.Map.empty + ; archives = String.Map.empty + ; executables = String.Map.empty + } + +let valid_name language ~loc s = + match s with + | "" + | "." + | ".." -> + User_error.raise ~loc + [ Pp.textf "%S is not a valid %s name." s + (Foreign.Language.proper_name language) + ] + | _ -> s + +let eval_foreign_sources (d : _ Dir_with_dune.t) foreign_stubs + ~(sources : Foreign.Sources.Unresolved.t) : Foreign.Sources.t = + let eval (stubs : Foreign.Stubs.t) = + let language = stubs.language in + let osl = stubs.names in + Ordered_set_lang.Unordered_string.eval_loc osl + ~key:(fun x -> x) + (* CR-someday aalekseyev: Might be a good idea to change [standard] to + mean "all files with the relevant extension". *) + ~standard:String.Map.empty + ~parse:(fun ~loc s -> + let name = valid_name language ~loc s in + let basename = Filename.basename s in + if name <> basename then + User_error.raise ~loc + [ Pp.text + "Relative part of stub is not necessary and should be \ + removed. To include sources in subdirectories, use the \ + (include_subdirs ...) stanza." + ]; + name) + |> String.Map.map ~f:(fun (loc, name) -> + match String.Map.find sources name with + | Some (_ :: _ :: _ as paths) -> + (* CR aalekseyev: This looks suspicious to me. If the user writes + foo.c and foo.cpp and only declares a foreign library that uses + foo.cpp, will that be an error? I think it shouldn't be. *) + User_error.raise ~loc + [ Pp.textf "Multiple sources map to the same object name %S:" + name + ; Pp.enumerate + ( List.map paths ~f:snd + |> List.sort ~compare:Path.Build.compare ) + ~f:(fun path -> + Pp.text + (Path.to_string_maybe_quoted + (Path.drop_optional_build_context (Path.build path)))) + ; Pp.text "This is not allowed; please rename them." + ] + ~hints: + [ Pp.text + "You can also avoid the name clash by placing the \ + objects into different foreign archives and building \ + them in different directories. Foreign archives can be \ + defined using the (foreign_library ...) stanza." + ] + | Some [ (l, path) ] when l = language -> + (loc, Foreign.Source.make ~stubs ~path) + | None + | Some [] + | Some [ (_, _) ] + (* Found a matching source file, but in a wrong language. *) -> + User_error.raise ~loc + [ Pp.textf "Object %S has no source; %s must be present." name + (String.enumerate_one_of + ( Foreign.Language.possible_fns language name + ~dune_version:d.dune_version + |> List.map ~f:(fun s -> sprintf "%S" s) )) + ]) + in + let stub_maps = List.map foreign_stubs ~f:eval in + List.fold_left stub_maps ~init:String.Map.empty ~f:(fun a b -> + String.Map.union a b ~f:(fun name (_, src) (_, another_src) -> + let path src = + Path.to_string_maybe_quoted + (Path.drop_optional_build_context + (Path.build (Foreign.Source.path src))) + in + Code_error.raise + (Printf.sprintf + "%S and %S from different (foreign_stubs ...) map to the same \ + object name %S. This should be impossible because of the \ + check we do in the [eval] function." + (path another_src) (path src) name) + [])) + +let make (d : _ Dir_with_dune.t) ~(sources : Foreign.Sources.Unresolved.t) = + let libs, exes = + List.filter_partition_map d.data ~f:(fun stanza -> + match (stanza : Stanza.t) with + | Library lib -> + let all = + eval_foreign_sources d lib.buildable.foreign_stubs ~sources + in + Left (Left (lib, all)) + | Foreign_library library -> + let all = eval_foreign_sources d [ library.stubs ] ~sources in + Left (Right (library.archive_name, (library.archive_name_loc, all))) + | Executables exes -> + let all = + eval_foreign_sources d exes.buildable.foreign_stubs ~sources + in + Right (exes, all) + | _ -> Skip) + in + let libs, foreign_libs = List.partition_map libs ~f:Fn.id in + let libraries = + match + Lib_name.Map.of_list_map libs ~f:(fun (lib, m) -> + (Library.best_name lib, m)) + with + | Ok x -> x + | Error (name, _, (lib2, _)) -> + User_error.raise ~loc:lib2.buildable.loc + [ Pp.textf "Library %S appears for the second time in this directory" + (Lib_name.to_string name) + ] + in + let archives = + String.Map.of_list_reducei foreign_libs + ~f:(fun archive_name (loc1, _) (loc2, _) -> + User_error.raise ~loc:loc2 + [ Pp.textf + "Multiple foreign libraries with the same archive name %S; the \ + name has already been taken in %s." + archive_name + (Loc.to_file_colon_line loc1) + ]) + |> 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)) + in + let () = + let rev_map = + List.concat_map libs ~f:(fun (_, c_sources) -> + String.Map.values c_sources + |> List.map ~f:(fun (loc, source) -> + (Foreign.Source.path source, loc))) + |> Path.Build.Map.of_list + in + match rev_map with + | Ok _ -> () + | Error (_, loc1, loc2) -> + User_error.raise ~loc:loc2 + [ Pp.text "This c stub is already used in another stanza:" + ; Pp.textf "- %s" (Loc.to_file_colon_line loc1) + ] + in + { libraries; archives; executables } diff --git a/src/dune/foreign_sources.mli b/src/dune/foreign_sources.mli new file mode 100644 index 00000000000..7aa16c8ef37 --- /dev/null +++ b/src/dune/foreign_sources.mli @@ -0,0 +1,15 @@ +(** This module loads and validates foreign sources from directories. *) + +type t + +val empty : t + +val for_lib : t -> name:Lib_name.t -> Foreign.Sources.t + +val for_archive : t -> archive_name:string -> Foreign.Sources.t + +val for_exes : t -> first_exe:string -> Foreign.Sources.t + +(** [make stanzas ~sources] loads and validates foreign sources. *) +val make : + Stanza.t list Dir_with_dune.t -> sources:Foreign.Sources.Unresolved.t -> t diff --git a/src/dune/gen_rules.ml b/src/dune/gen_rules.ml index 1f9757f573b..97aab0db983 100644 --- a/src/dune/gen_rules.ml +++ b/src/dune/gen_rules.ml @@ -81,6 +81,9 @@ end = struct ; js = None ; source_dirs = None } + | Foreign_library lib -> + Lib_rules.foreign_rules lib ~sctx ~dir ~dir_contents ~expander; + empty_none | Executables exes -> Option.iter exes.install_conf ~f:files_to_install; let cctx, merlin = diff --git a/src/dune/gen_rules.mli b/src/dune/gen_rules.mli index 4d4535c6167..f364a5e09dc 100644 --- a/src/dune/gen_rules.mli +++ b/src/dune/gen_rules.mli @@ -1,7 +1,7 @@ open! Stdune open! Import -(* Generate rules. Returns evaluated jbuilds per context names. *) +(* Generate rules. Returns evaluated Dune files per context names. *) val gen : contexts:Context.t list -> ?external_lib_deps_mode:bool (* default: false *) diff --git a/src/dune/inline_tests.ml b/src/dune/inline_tests.ml index 4c8470c13e6..640cd809dc5 100644 --- a/src/dune/inline_tests.ml +++ b/src/dune/inline_tests.ml @@ -1,6 +1,5 @@ open! Stdune open Import -open Dune_file open Build.O open! No_io module SC = Super_context @@ -314,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 = @@ -356,7 +355,7 @@ include Sub_system.Register_end_point (struct in let exe, runner_args = match custom_runner with - | None -> (Ok exe, Command.Args.As []) + | None -> (Ok exe, Command.Args.empty) | Some runner -> ( Super_context.resolve_program ~dir sctx ~loc:(Some loc) runner , Dep exe ) diff --git a/src/dune/install_rules.ml b/src/dune/install_rules.ml index dbde0681037..14fb076721c 100644 --- a/src/dune/install_rules.ml +++ b/src/dune/install_rules.ml @@ -119,9 +119,9 @@ end = struct | Private, Some dir -> Some (Filename.concat dir ".private") in make_entry ?sub_dir Lib file) - ; List.map (Lib_archives.files archives) ~f:(make_entry Lib) + ; List.map (Lib_archives.lib_files archives) ~f:(make_entry Lib) ; List.map execs ~f:(make_entry Libexec) - ; List.map (Lib_archives.dlls archives) ~f:(fun a -> + ; List.map (Lib_archives.dll_files archives) ~f:(fun a -> (Some loc, Install.Entry.make Stublibs a)) ] @@ -292,8 +292,9 @@ let gen_dune_package sctx pkg = let name = Lib.name lib in let foreign_objects = let dir = Obj_dir.obj_dir obj_dir in - Dir_contents.c_sources_of_library dir_contents ~name - |> C.Sources.objects ~dir ~ext_obj:ctx.lib_config.ext_obj + Dir_contents.foreign_sources_of_library dir_contents ~name + |> Foreign.Sources.object_files ~dir + ~ext_obj:ctx.lib_config.ext_obj |> List.map ~f:Path.build in let modules = diff --git a/src/dune/lib_archives.ml b/src/dune/lib_archives.ml index 98024d74579..5f88bc04673 100644 --- a/src/dune/lib_archives.ml +++ b/src/dune/lib_archives.ml @@ -1,13 +1,13 @@ open Stdune type t = - { dlls : Path.Build.t list - ; files : Path.Build.t list + { dll_files : Path.Build.t list + ; lib_files : Path.Build.t list } -let files t = t.files +let lib_files t = t.lib_files -let dlls t = t.dlls +let dll_files t = t.dll_files module Library = Dune_file.Library @@ -24,7 +24,7 @@ let make ~(ctx : Context.t) ~dir ~dir_contents (lib : Library.t) = else [] in - let files = + let lib_files = let virtual_library = Library.is_virtual lib in List.concat [ if_ @@ -32,14 +32,12 @@ let make ~(ctx : Context.t) ~dir ~dir_contents (lib : Library.t) = [ Library.archive ~dir lib ~ext:(Mode.compiled_lib_ext Byte) ] ; ( if virtual_library then let files = - Dir_contents.c_sources_of_library dir_contents + Dir_contents.foreign_sources_of_library dir_contents ~name:(Library.best_name lib) in - C.Sources.objects files ~dir ~ext_obj - else if Library.has_stubs lib then - [ Library.stubs_archive ~dir lib ~ext_lib ] + Foreign.Sources.object_files files ~dir ~ext_obj else - [] ) + Library.lib_files lib ~dir ~ext_lib ) ; if_ (native && not virtual_library) (let files = @@ -57,13 +55,12 @@ let make ~(ctx : Context.t) ~dir ~dir_contents (lib : Library.t) = ; List.map lib.buildable.js_of_ocaml.javascript_files ~f:(Path.Build.relative dir) ; List.map lib.install_c_headers ~f:(fun fn -> - Path.Build.relative dir (fn ^ C.header_ext)) + Path.Build.relative dir (fn ^ Foreign.header_ext)) ] in - let dlls = + let dll_files = if_ - ( byte && Library.has_stubs lib - && Dynlink_supported.get lib.dynlink ctx.supports_shared_libraries ) - [ Library.dll ~dir lib ~ext_dll ] + (byte && Dynlink_supported.get lib.dynlink ctx.supports_shared_libraries) + (Library.dll_files lib ~dir ~ext_dll) in - { files; dlls } + { lib_files; dll_files } diff --git a/src/dune/lib_archives.mli b/src/dune/lib_archives.mli index 0ba3f20b2f9..c8508bf9150 100644 --- a/src/dune/lib_archives.mli +++ b/src/dune/lib_archives.mli @@ -9,6 +9,6 @@ val make : -> Dune_file.Library.t -> t -val files : t -> Path.Build.t list +val lib_files : t -> Path.Build.t list -val dlls : t -> Path.Build.t list +val dll_files : t -> Path.Build.t list diff --git a/src/dune/lib_file_deps.ml b/src/dune/lib_file_deps.ml index 5f77f30ec10..f794147af61 100644 --- a/src/dune/lib_file_deps.ml +++ b/src/dune/lib_file_deps.ml @@ -11,7 +11,7 @@ module Group = struct let ext = function | Cmi -> Cm_kind.ext Cmi | Cmx -> Cm_kind.ext Cmx - | Header -> C.header_ext + | Header -> Foreign.header_ext let obj_dir t obj_dir = match t with diff --git a/src/dune/lib_rules.ml b/src/dune/lib_rules.ml index cd604b6f78b..09d2bf70ff5 100644 --- a/src/dune/lib_rules.ml +++ b/src/dune/lib_rules.ml @@ -15,6 +15,7 @@ let msvc_hack_cclibs = in Option.value ~default:lib (String.drop_prefix ~prefix:"-l" lib)) +(* Build an OCaml library. *) let build_lib (lib : Library.t) ~sctx ~expander ~flags ~dir ~mode ~cm_files = let ctx = Super_context.context sctx in let { Lib_config.ext_lib; _ } = ctx.lib_config in @@ -23,15 +24,13 @@ let build_lib (lib : Library.t) ~sctx ~expander ~flags ~dir ~mode ~cm_files = Library.archive lib ~dir ~ext:(Mode.compiled_lib_ext mode) in let stubs_flags = - if not (Library.has_stubs lib) then - [] - else - let stubs_name = Library.stubs_name lib in - let lstubs = "-l" ^ stubs_name in - let stubs = [ "-cclib"; lstubs ] in - match mode with - | Native -> stubs - | Byte -> "-dllib" :: lstubs :: stubs + List.concat_map (Library.archive_names lib) ~f:(fun name -> + let lname = "-l" ^ name in + let cclib = [ "-cclib"; lname ] in + let dllib = [ "-dllib"; lname ] in + match mode with + | Native -> cclib + | Byte -> dllib @ cclib) in let map_cclibs = (* https://github.com/ocaml/dune/issues/119 *) @@ -108,11 +107,12 @@ let gen_wrapped_compat_modules (lib : Library.t) cctx = Build.write_file (Path.as_in_build_dir_exn source_path) contents |> Super_context.add_rule sctx ~loc ~dir:(Compilation_context.dir cctx)) -let ocamlmklib (lib : Library.t) ~sctx ~dir ~expander ~o_files ~sandbox ~custom - ~targets = - Super_context.add_rule sctx ~sandbox ~dir ~loc:lib.buildable.loc +(* Add a rule calling [ocamlmklib] to build a library. *) +let ocamlmklib ~path ~loc ~c_library_flags ~sctx ~dir ~expander ~o_files + ~sandbox ~custom ~targets = + Super_context.add_rule sctx ~sandbox ~dir ~loc (let cclibs_args = - Expander.expand_and_eval_set expander lib.c_library_flags + Expander.expand_and_eval_set expander c_library_flags ~standard:(Build.return []) in let ctx = Super_context.context sctx in @@ -121,9 +121,9 @@ let ocamlmklib (lib : Library.t) ~sctx ~dir ~expander ~o_files ~sandbox ~custom ; ( if custom then A "-custom" else - As [] ) + Command.Args.empty ) ; A "-o" - ; Path (Path.build (Library.stubs lib ~dir)) + ; Path path ; Deps o_files ; Dyn (Build.map cclibs_args ~f:(fun cclibs -> @@ -136,14 +136,109 @@ let ocamlmklib (lib : Library.t) ~sctx ~dir ~expander ~o_files ~sandbox ~custom ; Hidden_targets targets ]) +(* Add a rule calling [ocamlmklib] to build a stubs archive for an OCaml + library. *) +let ocamlmklib_ocaml (lib : Library.t) ~sctx ~dir ~expander ~o_files ~sandbox + ~custom ~targets = + let path = + Path.build (Path.Build.relative dir (Library.stubs_archive_name lib)) + in + (* CR-someday aalekseyev: + I'm not sure why [c_library_flags] is needed here. I think it's unused + at least when building a static archive. But maybe it's used for + dynamic libraries. It would be nice to clarify that somewhere. *) + ocamlmklib ~path ~loc:lib.buildable.loc ~c_library_flags:lib.c_library_flags + ~sctx ~dir ~expander ~o_files ~sandbox ~custom ~targets + +(* Compute command line flags for the [include_dirs] field of [Foreign.Stubs.t] + and track all files in specified directories as [Hidden_deps] dependencies. *) +let include_dir_flags ~expander ~dir (stubs : Foreign.Stubs.t) = + Command.Args.S + (List.map stubs.include_dirs ~f:(fun include_dir -> + let loc = String_with_vars.loc include_dir + and include_dir = Expander.expand_path expander include_dir in + match Path.extract_build_context_dir include_dir with + | None -> + (* TODO: Track files in external directories. *) + User_error.raise ~loc + [ Pp.textf + "%S is an external directory; dependencies in external \ + directories are currently not tracked." + (Path.to_string include_dir) + ] + ~hints: + [ Pp.textf + "You can specify %S as an untracked include directory like \ + this:\n\n\ + \ (flags -I %s)\n" + (Path.to_string include_dir) + (Path.to_string include_dir) + ] + | Some (build_dir, source_dir) -> ( + match File_tree.find_dir source_dir with + | None -> + User_error.raise ~loc + [ Pp.textf "Include directory %S does not exist." + (Path.reach ~from:(Path.build dir) include_dir) + ] + | Some dir -> + Command.Args.S + [ A "-I" + ; Path include_dir + ; 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) + in + let deps = + Dep.Set.singleton + (Dep.file_selector + (File_selector.create ~dir Predicate.true_)) + in + Command.Args.Hidden_deps deps :: args)) + ] ))) + +(* CR aalekseyev: + Maybe we'll need to support the case when dynamic library can't be + built for some reason. It seems that the OCaml library code path has to deal + with that case. *) +(* Build a static and a dynamic archive for a foreign library. *) +let foreign_rules (library : Foreign.Library.t) ~sctx ~expander ~dir + ~dir_contents = + let archive_name = library.archive_name in + let o_files = + let extra_flags = include_dir_flags ~expander ~dir library.stubs in + let foreign_sources = + Dir_contents.foreign_sources_of_archive dir_contents ~archive_name + in + Foreign_rules.build_o_files ~sctx ~dir ~expander ~requires:(Result.ok []) + ~dir_contents ~foreign_sources ~extra_flags + ~extra_deps:library.stubs.extra_deps + |> List.map ~f:Path.build + in + Check_rules.add_files sctx ~dir o_files; + let ctx = Super_context.context sctx in + let { Lib_config.ext_lib; ext_dll; _ } = ctx.lib_config in + let static = Foreign.lib_file ~archive_name ~dir ~ext_lib in + let dynamic = Foreign.dll_file ~archive_name ~dir ~ext_dll in + ocamlmklib + ~path:(Path.build (Path.Build.relative dir archive_name)) + ~loc:library.stubs.loc + ~c_library_flags:Ordered_set_lang.Unexpanded.standard ~sctx ~dir ~expander + ~o_files ~sandbox:Sandbox_config.no_special_requirements ~custom:false + ~targets:[ static; dynamic ] + +(* Build a required set of archives for an OCaml library. *) let build_self_stubs lib ~cctx ~expander ~dir ~o_files = let sctx = Compilation_context.super_context cctx in let ctx = Super_context.context sctx in let { Lib_config.ext_lib; ext_dll; _ } = ctx.lib_config in - let static = Library.stubs_archive lib ~dir ~ext_lib in - let dynamic = Library.dll lib ~dir ~ext_dll in + let archive_name = Library.stubs_archive_name lib in + let static = Foreign.lib_file ~archive_name ~dir ~ext_lib in + let dynamic = Foreign.dll_file ~archive_name ~dir ~ext_dll in let modes = Compilation_context.modes cctx in - let ocamlmklib = ocamlmklib lib ~sctx ~expander ~dir ~o_files in + let ocamlmklib = ocamlmklib_ocaml lib ~sctx ~expander ~dir ~o_files in if modes.native && modes.byte && Dynlink_supported.get lib.dynlink ctx.supports_shared_libraries @@ -165,16 +260,13 @@ let build_stubs lib ~cctx ~dir ~expander ~requires ~dir_contents ~vlib_stubs_o_files = let sctx = Compilation_context.super_context cctx in let lib_o_files = - if Library.has_stubs lib then - let c_sources = - Dir_contents.c_sources_of_library dir_contents - ~name:(Library.best_name lib) - in - C_rules.build_o_files lib.buildable ~sctx ~dir ~expander ~requires - ~dir_contents ~c_sources - |> List.map ~f:Path.build - else - [] + let foreign_sources = + Dir_contents.foreign_sources_of_library dir_contents + ~name:(Library.best_name lib) + in + Foreign_rules.build_o_files ~sctx ~dir ~expander ~requires ~dir_contents + ~foreign_sources ~extra_flags:Command.Args.empty ~extra_deps:[] + |> List.map ~f:Path.build in Check_rules.add_files sctx ~dir lib_o_files; match vlib_stubs_o_files @ lib_o_files with @@ -207,11 +299,8 @@ let build_shared lib ~sctx ~dir ~flags = ] in let build = - if Library.has_stubs lib then - Build.path (Path.build (Library.stubs_archive ~dir lib ~ext_lib)) - >>> build - else - build + List.fold_left ~init:build (Library.lib_files lib ~dir ~ext_lib) + ~f:(fun build lib -> Build.path (Path.build lib) >>> build) in Super_context.add_rule sctx build ~dir) @@ -329,7 +418,7 @@ let library_rules (lib : Library.t) ~cctx ~source_modules ~dir_contents setup_build_archives lib ~cctx ~dep_graphs ~expander; let () = let vlib_stubs_o_files = Vimpl.vlib_stubs_o_files vimpl in - if Library.has_stubs lib || not (List.is_empty vlib_stubs_o_files) then + if Library.has_foreign lib || List.is_non_empty vlib_stubs_o_files then build_stubs lib ~cctx ~dir ~expander ~requires:requires_compile ~dir_contents ~vlib_stubs_o_files in diff --git a/src/dune/lib_rules.mli b/src/dune/lib_rules.mli index b196dad7e48..c12d0e3991e 100644 --- a/src/dune/lib_rules.mli +++ b/src/dune/lib_rules.mli @@ -1,6 +1,14 @@ open! Stdune open Dune_file +val foreign_rules : + Foreign.Library.t + -> sctx:Super_context.t + -> expander:Expander.t + -> dir:Path.Build.t + -> dir_contents:Dir_contents.t + -> unit + val rules : Library.t -> sctx:Super_context.t diff --git a/src/dune/module_compilation.ml b/src/dune/module_compilation.ml index 9dfa6e4f85a..98f4c7f0fe1 100644 --- a/src/dune/module_compilation.ml +++ b/src/dune/module_compilation.ml @@ -19,7 +19,7 @@ let force_read_cmi source_file = [ "-intf-suffix"; Path.extension source_file ] let opens modules m = match Modules.alias_for modules m with - | None -> Command.Args.S [] + | None -> Command.Args.empty | Some (m : Module.t) -> As [ "-open"; Module_name.to_string (Module.name m) ] let other_cm_files ~opaque ~(cm_kind : Cm_kind.t) ~dep_graph ~obj_dir m = @@ -99,7 +99,7 @@ let build_cm cctx ~dep_graphs ~precompiled_cmi ~cm_kind (m : Module.t) = in let other_targets, cmt_args = match cm_kind with - | Cmx -> (other_targets, Command.Args.S []) + | Cmx -> (other_targets, Command.Args.empty) | Cmi | Cmo -> let fn = Option.value_exn (Obj_dir.Module.cmt_file obj_dir m ~ml_kind) in @@ -112,7 +112,7 @@ let build_cm cctx ~dep_graphs ~precompiled_cmi ~cm_kind (m : Module.t) = then Command.Args.A "-opaque" else - As [] + Command.Args.empty in let dir = ctx.build_dir in let flags = @@ -139,7 +139,7 @@ let build_cm cctx ~dep_graphs ~precompiled_cmi ~cm_kind (m : Module.t) = ; Cm_kind.Dict.get (CC.includes cctx) cm_kind ; As extra_args ; ( if dynlink || cm_kind <> Cmx then - As [] + Command.Args.empty else A "-nodynlink" ) ; A "-no-alias-deps" diff --git a/src/dune/modules_field_evaluator.ml b/src/dune/modules_field_evaluator.ml index 4af1d500ccd..a50891143e9 100644 --- a/src/dune/modules_field_evaluator.ml +++ b/src/dune/modules_field_evaluator.ml @@ -134,7 +134,7 @@ let check_invalid_module_listing ~(buildable : Buildable.t) ~intf_only ~modules ~existing_virtual_modules ~allow_new_public_modules in if - (not (List.is_empty errors)) + List.is_non_empty errors || not (Module_name.Set.is_empty unimplemented_virt_modules) then ( let get kind = diff --git a/src/dune/predicate.ml b/src/dune/predicate.ml index df7075d24b1..8191d799ba8 100644 --- a/src/dune/predicate.ml +++ b/src/dune/predicate.ml @@ -19,6 +19,8 @@ let encode _ = Dune_lang.Encoder.string "predicate " let create ~id ~f = { id; f } +let true_ = { id = lazy (String "true_"); f = (fun _ -> true) } + let test t e = t.f e let contramap t ~f ~map_id = diff --git a/src/dune/predicate.mli b/src/dune/predicate.mli index 542369644d3..c4a85da6392 100644 --- a/src/dune/predicate.mli +++ b/src/dune/predicate.mli @@ -20,6 +20,9 @@ val to_dyn : _ t -> Dyn.t [id]. [id] is used to safely compare predicates for equality for memoization *) val create : id:Dyn.t Lazy.t -> f:('a -> bool) -> 'a t +(** The predicate that evaluates to [true] for any query. *) +val true_ : _ t + val test : 'a t -> 'a -> bool (** the user of this function must take care not to break the uniqueness of the diff --git a/src/dune/preprocessing.mli b/src/dune/preprocessing.mli index 4400718d94e..cb0aee28a0a 100644 --- a/src/dune/preprocessing.mli +++ b/src/dune/preprocessing.mli @@ -15,7 +15,7 @@ val make : -> dep_kind:Lib_deps_info.Kind.t -> lint:Dune_file.Preprocess_map.t -> preprocess:Dune_file.Preprocess_map.t - -> preprocessor_deps:Dune_file.Dep_conf.t list + -> preprocessor_deps:Dep_conf.t list -> lib_name:Lib_name.Local.t option -> scope:Scope.t -> t diff --git a/src/dune/simple_rules.ml b/src/dune/simple_rules.ml index 15e6351b665..258d070af66 100644 --- a/src/dune/simple_rules.ml +++ b/src/dune/simple_rules.ml @@ -124,7 +124,7 @@ let add_alias sctx ~dir ~name ~stamp ~loc ?(locks = []) build = let alias sctx ?extra_bindings ~dir ~expander (alias_conf : Alias_conf.t) = let stamp = ( "user-alias" - , Bindings.map ~f:Dune_file.Dep_conf.remove_locs alias_conf.deps + , Bindings.map ~f:Dep_conf.remove_locs alias_conf.deps , Option.map ~f:(fun (_loc, a) -> Action_unexpanded.remove_locs a) alias_conf.action diff --git a/src/dune/super_context.ml b/src/dune/super_context.ml index 24ad87899c0..0a1b4ce979a 100644 --- a/src/dune/super_context.ml +++ b/src/dune/super_context.ml @@ -112,7 +112,8 @@ module Env : sig val ocaml_flags : t -> dir:Path.Build.t -> Ocaml_flags.t - val c_flags : t -> dir:Path.Build.t -> string list Build.t C.Kind.Dict.t + val foreign_flags : + t -> dir:Path.Build.t -> string list Build.t Foreign.Language.Dict.t val external_ : t -> dir:Path.Build.t -> External_env.t @@ -225,11 +226,11 @@ end = struct List.filter ctx.ocamlc_cflags ~f:(fun s -> not (String.is_prefix s ~prefix:"-std=")) in - C.Kind.Dict.make ~c ~cxx + Foreign.Language.Dict.make ~c ~cxx - let c_flags t ~dir = + let foreign_flags t ~dir = let default_context_flags = default_context_flags t.context in - Env_node.c_flags (get t ~dir) ~profile:t.profile + Env_node.foreign_flags (get t ~dir) ~profile:t.profile ~expander:(expander t ~dir) ~default_context_flags end @@ -275,10 +276,10 @@ let source_files ~src_path = let partial_expand sctx ~dep_kind ~targets_written_by_user ~map_exe ~expander t = let acc = Expander.Resolved_forms.empty () in - let c_flags ~dir = Env.c_flags sctx.env_context ~dir in + let foreign_flags ~dir = Env.foreign_flags sctx.env_context ~dir in let expander = Expander.with_record_deps expander acc ~dep_kind ~targets_written_by_user - ~map_exe ~c_flags + ~map_exe ~foreign_flags in let partial = Action_unexpanded.partial_expand t ~expander ~map_exe in (partial, acc) @@ -307,20 +308,17 @@ let ocaml_flags t ~dir (x : Dune_file.Buildable.t) = else flags -let c_flags t ~dir ~expander ~flags = +let foreign_flags t ~dir ~expander ~flags ~language = let t = t.env_context in let ccg = Context.cc_g t.context in - let default = Env.c_flags t ~dir in - C.Kind.Dict.mapi flags ~f:(fun ~kind flags -> - let name = C.Kind.to_string kind in - Build.memoize (sprintf "%s flags" name) - (let default = C.Kind.Dict.get default kind in - let c = - Expander.expand_and_eval_set expander flags ~standard:default - in - let open Build.O in - let+ l = c in - l @ ccg)) + let default = Env.foreign_flags t ~dir in + let name = Foreign.Language.proper_name language in + Build.memoize (sprintf "%s flags" name) + (let default = Foreign.Language.Dict.get default language in + let c = Expander.expand_and_eval_set expander flags ~standard:default in + let open Build.O in + let+ l = c in + l @ ccg) let local_binaries t ~dir = Env.local_binaries t.env_context ~dir @@ -329,9 +327,9 @@ let dump_env t ~dir = let open Build.O in let+ o_dump = Ocaml_flags.dump (Env.ocaml_flags t ~dir) and+ c_dump = - let c_flags = Env.c_flags t ~dir in - let+ c_flags = c_flags.c - and+ cxx_flags = c_flags.cxx in + let foreign_flags = Env.foreign_flags t ~dir in + let+ c_flags = foreign_flags.c + and+ cxx_flags = foreign_flags.cxx in List.map ~f:Dune_lang.Encoder.(pair string (list string)) [ ("c_flags", c_flags); ("cxx_flags", cxx_flags) ] @@ -575,7 +573,7 @@ end module Deps = struct open Build.O - open Dune_file.Dep_conf + open Dep_conf let make_alias expander s = let loc = String_with_vars.loc s in @@ -625,10 +623,10 @@ module Deps = struct let make_interpreter ~f t ~expander l = let forms = Expander.Resolved_forms.empty () in - let c_flags ~dir = Env.c_flags t.env_context ~dir in + let foreign_flags ~dir = Env.foreign_flags t.env_context ~dir in let expander = Expander.with_record_no_ddeps expander forms ~dep_kind:Optional - ~map_exe:Fn.id ~c_flags + ~map_exe:Fn.id ~foreign_flags in let+ deps = Build.map ~f:List.concat (List.map l ~f:(f t expander) |> Build.all) diff --git a/src/dune/super_context.mli b/src/dune/super_context.mli index 4cd19058135..d3792254696 100644 --- a/src/dune/super_context.mli +++ b/src/dune/super_context.mli @@ -60,12 +60,13 @@ val internal_lib_names : t -> Lib_name.Set.t stanza *) val ocaml_flags : t -> dir:Path.Build.t -> Buildable.t -> Ocaml_flags.t -val c_flags : +val foreign_flags : t -> dir:Path.Build.t -> expander:Expander.t - -> flags:Ordered_set_lang.Unexpanded.t C.Kind.Dict.t - -> string list Build.t C.Kind.Dict.t + -> flags:Ordered_set_lang.Unexpanded.t + -> language:Foreign.Language.t + -> string list Build.t (** Binaries that are symlinked in the associated .bin directory of [dir]. This associated directory is [Path.relative dir ".bin"] *) @@ -143,8 +144,8 @@ module Libs : sig /!\ WARNING /!\: make sure the last function call inside [f] is fully applied, otherwise the function might end up being executed after this - function has returned. Consider addin a type annotation to make sure this - doesn't happen by mistake. *) + function has returned. Consider adding a type annotation to make sure + this doesn't happen by mistake. *) val with_lib_deps : t -> Lib.Compile.t -> dir:Path.Build.t -> f:(unit -> 'a) -> 'a @@ -152,7 +153,7 @@ module Libs : sig val gen_select_rules : t -> dir:Path.Build.t -> Lib.Compile.t -> unit end -(** Interpret dependencies written in jbuild files *) +(** Interpret dependencies written in Dune files *) module Deps : sig (** Evaluates to the actual list of dependencies, ignoring aliases, and registers them as the action dependencies. *) @@ -169,7 +170,7 @@ module Deps : sig -> Path.t Bindings.t Build.t end -(** Interpret action written in jbuild files *) +(** Interpret action written in Dune files *) module Action : sig (** This function takes as input the list of dependencies written by user, which is used for action expansion. These must be registered with the diff --git a/src/dune/toplevel.ml b/src/dune/toplevel.ml index 992b153cd59..fe09855efd4 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/src/dune/upgrader.ml b/src/dune/upgrader.ml index 50163bdb1fd..20b0c026cb1 100644 --- a/src/dune/upgrader.ml +++ b/src/dune/upgrader.ml @@ -329,7 +329,7 @@ let upgrade_opam_file todo fn = in List.iter t.file_contents ~f:scan_item; let substs = List.sort !substs ~compare in - if not (List.is_empty substs) then ( + if List.is_non_empty substs then ( let buf = Buffer.create (String.length s + 128) in let ofs = List.fold_left substs ~init:0 ~f:(fun ofs (start, stop, repl) -> diff --git a/src/dune/utils.ml b/src/dune/utils.ml index fa06239ba53..841ea276887 100644 --- a/src/dune/utils.ml +++ b/src/dune/utils.ml @@ -56,7 +56,7 @@ let install_file ~(package : Package.Name.t) ~findlib_toolchain = let line_directive ~filename:fn ~line_number = let directive = - if C.c_cxx_or_header ~fn then + if Foreign.c_cxx_or_header ~fn then "line" else "" diff --git a/src/dune/virtual_rules.ml b/src/dune/virtual_rules.ml index 0ed8377e21f..0900e93ab72 100644 --- a/src/dune/virtual_rules.ml +++ b/src/dune/virtual_rules.ml @@ -119,8 +119,8 @@ let impl sctx ~(lib : Dune_file.Library.t) ~scope = let foreign_objects = let ext_obj = (Super_context.context sctx).lib_config.ext_obj in let dir = Obj_dir.obj_dir (Lib.Local.obj_dir vlib) in - Dir_contents.c_sources_of_library dir_contents ~name - |> C.Sources.objects ~ext_obj ~dir + Dir_contents.foreign_sources_of_library dir_contents ~name + |> Foreign.Sources.object_files ~ext_obj ~dir |> List.map ~f:Path.build in (modules, foreign_objects) diff --git a/src/dune_lang/decoder.ml b/src/dune_lang/decoder.ml index 15846ca74f1..33ddbbf4556 100644 --- a/src/dune_lang/decoder.ml +++ b/src/dune_lang/decoder.ml @@ -436,6 +436,8 @@ let map_validate t ~f ctx state1 = in raise (User_error.E msg) +(** TODO: Improve consistency of error messages, e.g. use %S consistently for + field names: see [field_missing] and [field_present_too_many_times]. *) let field_missing loc name = User_error.raise ~loc [ Pp.textf "field %s missing" name ] [@@inline never] diff --git a/src/dune_lang/syntax.ml b/src/dune_lang/syntax.ml index af74a5d0ac2..1a515230f5e 100644 --- a/src/dune_lang/syntax.ml +++ b/src/dune_lang/syntax.ml @@ -87,18 +87,32 @@ module Error = struct (Version.to_string ver) t.desc ] - let deleted_in loc t ?(repl = []) ver ~what = + let deleted_in ?(extra_info = "") loc t ?(repl = []) ver ~what = User_error.raise ~loc - ( Pp.textf "%s was deleted in version %s of %s" what - (Version.to_string ver) t.desc + ( Pp.concat + [ Pp.textf "%s was deleted in version %s of %s." what + (Version.to_string ver) t.desc + ; ( if extra_info = "" then + Pp.nop + else + Pp.space ) + ; Pp.text extra_info + ] :: repl ) end module Warning = struct - let deprecated_in loc t ?(repl = []) ver ~what = + let deprecated_in ?(extra_info = "") loc t ?(repl = []) ver ~what = User_warning.emit ~loc - ( Pp.textf "%s was deprecated in version %s of %s." what - (Version.to_string ver) t.desc + ( Pp.concat + [ Pp.textf "%s was deprecated in version %s of %s." what + (Version.to_string ver) t.desc + ; ( if extra_info = "" then + Pp.nop + else + Pp.space ) + ; Pp.text extra_info + ] :: repl ) end @@ -155,23 +169,23 @@ let desc () = | Values (loc, Some s) -> (loc, sprintf "'%s'" s) | Fields (loc, Some s) -> (loc, sprintf "Field '%s'" s) -let deleted_in t ver = +let deleted_in ?(extra_info = "") t ver = let open Version.Infix in let* current_ver = get_exn t in if current_ver < ver then return () else let* loc, what = desc () in - Error.deleted_in loc t ver ~what + Error.deleted_in ~extra_info loc t ver ~what -let deprecated_in t ver = +let deprecated_in ?(extra_info = "") t ver = let open Version.Infix in let* current_ver = get_exn t in if current_ver < ver then return () else let+ loc, what = desc () in - Warning.deprecated_in loc t ver ~what + Warning.deprecated_in ~extra_info loc t ver ~what let renamed_in t ver ~to_ = let open Version.Infix in diff --git a/src/dune_lang/syntax.mli b/src/dune_lang/syntax.mli index 9d5d81e60a5..b83edfa116b 100644 --- a/src/dune_lang/syntax.mli +++ b/src/dune_lang/syntax.mli @@ -37,7 +37,8 @@ module Error : sig val renamed_in : Loc.t -> t -> Version.t -> what:string -> to_:string -> _ val deleted_in : - Loc.t + ?extra_info:string + -> Loc.t -> t -> ?repl:User_message.Style.t Pp.t list -> Version.t @@ -47,7 +48,8 @@ end module Warning : sig val deprecated_in : - Loc.t + ?extra_info:string + -> Loc.t -> t -> ?repl:User_message.Style.t Pp.t list -> Version.t @@ -75,11 +77,13 @@ val greatest_supported_version : t -> Version.t (** Indicate the field/constructor being parsed was deleted in the given version *) -val deleted_in : t -> Version.t -> (unit, _) Decoder.parser +val deleted_in : + ?extra_info:string -> t -> Version.t -> (unit, _) Decoder.parser (** Indicate the field/constructor being parsed was deprecated in the given version *) -val deprecated_in : t -> Version.t -> (unit, _) Decoder.parser +val deprecated_in : + ?extra_info:string -> t -> Version.t -> (unit, _) Decoder.parser (** Indicate the field/constructor being parsed was renamed in the given version *) diff --git a/src/stdune/dune b/src/stdune/dune index 75d7c7683be..b3a36ffa241 100644 --- a/src/stdune/dune +++ b/src/stdune/dune @@ -4,4 +4,4 @@ (synopsis "[Internal] Standard library of Dune") (preprocess future_syntax) (libraries dune_caml unix) - (c_names fcntl)) + (foreign_stubs (language c) (names fcntl))) diff --git a/src/stdune/list.ml b/src/stdune/list.ml index cb912214d3b..793c4b4683c 100644 --- a/src/stdune/list.ml +++ b/src/stdune/list.ml @@ -8,6 +8,10 @@ let is_empty = function | [] -> true | _ -> false +let is_non_empty = function + | [] -> false + | _ -> true + let rec filter_map l ~f = match l with | [] -> [] @@ -180,3 +184,6 @@ let fold_map t ~init ~f = y) in (!acc, result) + +let unzip l = + fold_right ~init:([], []) ~f:(fun (x, y) (xs, ys) -> (x :: xs, y :: ys)) l diff --git a/src/stdune/list.mli b/src/stdune/list.mli index 595ca805d9a..b59e7e46ca1 100644 --- a/src/stdune/list.mli +++ b/src/stdune/list.mli @@ -8,6 +8,8 @@ type 'a t = 'a list val is_empty : _ t -> bool +val is_non_empty : _ t -> bool + val filter_map : 'a t -> f:('a -> 'b option) -> 'b t val filter_opt : 'a option t -> 'a t @@ -68,3 +70,5 @@ val hash : ('a -> int) -> 'a list -> int val cons : 'a t -> 'a -> 'a t val fold_map : 'a list -> init:'b -> f:('b -> 'a -> 'b * 'c) -> 'b * 'c list + +val unzip : ('a * 'b) t -> 'a t * 'b t diff --git a/test/blackbox-tests/dune.inc b/test/blackbox-tests/dune.inc index d640eca442a..bae29e16410 100644 --- a/test/blackbox-tests/dune.inc +++ b/test/blackbox-tests/dune.inc @@ -586,6 +586,22 @@ test-cases/force-test (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) +(alias + (name foreign-library) + (deps (package dune) (source_tree test-cases/foreign-library)) + (action + (chdir + test-cases/foreign-library + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + +(alias + (name foreign-stubs) + (deps (package dune) (source_tree test-cases/foreign-stubs)) + (action + (chdir + test-cases/foreign-stubs + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (alias (name format-dune-file) (deps (package dune) (source_tree test-cases/format-dune-file)) @@ -634,14 +650,6 @@ test-cases/github1231 (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) -(alias - (name github1306) - (deps (package dune) (source_tree test-cases/github1306)) - (action - (chdir - test-cases/github1306 - (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) - (alias (name github1342) (deps (package dune) (source_tree test-cases/github1342)) @@ -1909,13 +1917,14 @@ (alias findlib-error) (alias forbidden_libraries) (alias force-test) + (alias foreign-library) + (alias foreign-stubs) (alias format-dune-file) (alias formatting) (alias gen-opam-install-file) (alias github1019) (alias github1099) (alias github1231) - (alias github1306) (alias github1342) (alias github1372) (alias github1395) @@ -2126,12 +2135,13 @@ (alias findlib-error) (alias forbidden_libraries) (alias force-test) + (alias foreign-library) + (alias foreign-stubs) (alias format-dune-file) (alias formatting) (alias github1019) (alias github1099) (alias github1231) - (alias github1306) (alias github1342) (alias github1395) (alias github1426) diff --git a/test/blackbox-tests/test-cases/duplicate-c-cxx-obj/run.t b/test/blackbox-tests/test-cases/duplicate-c-cxx-obj/run.t index 9f819a76193..21713294b6c 100644 --- a/test/blackbox-tests/test-cases/duplicate-c-cxx-obj/run.t +++ b/test/blackbox-tests/test-cases/duplicate-c-cxx-obj/run.t @@ -1,20 +1,49 @@ This test showcases that although libraries can technically have non overlapping stubs names, things are still broken if their .o files overlap: + $ dune build --root diff-stanza @all Entering directory 'diff-stanza' - Error: Multiple rules generated for _build/default/foo$ext_obj: - - dune:4 - - dune:9 + File "dune", line 4, characters 10-13: + 4 | (c_names foo)) + ^^^ + Error: Multiple sources map to the same object name "foo": + - foo.c + - foo.cpp + This is not allowed; please rename them. + Hint: You can also avoid the name clash by placing the objects into different + foreign archives and building them in different directories. Foreign archives + can be defined using the (foreign_library ...) stanza. [1] Another form of this bug is if the same source is present in different directories. In this case, the rules are fine, but this is probably not what the user intended. + + $ dune build --root same-stanza @all + Entering directory 'same-stanza' + File "dune", line 5, characters 14-21: + 5 | (c_names foo sub/foo)) + ^^^^^^^ + Error: Relative part of stub is not necessary and should be removed. To + include sources in subdirectories, use the (include_subdirs ...) stanza. + [1] + + $ cat >same-stanza/dune < (include_subdirs unqualified) + > (library + > (name foo) + > (c_names foo)) + > EOF $ dune build --root same-stanza @all Entering directory 'same-stanza' - File "dune", line 1, characters 0-0: - Error: c file foo appears in several directories: - - . - - sub - This is not allowed, please rename one of them. + File "dune", line 4, characters 10-13: + 4 | (c_names foo)) + ^^^ + Error: Multiple sources map to the same object name "foo": + - foo.c + - sub/foo.c + This is not allowed; please rename them. + Hint: You can also avoid the name clash by placing the objects into different + foreign archives and building them in different directories. Foreign archives + can be defined using the (foreign_library ...) stanza. [1] diff --git a/test/blackbox-tests/test-cases/duplicate-c-cxx/run.t b/test/blackbox-tests/test-cases/duplicate-c-cxx/run.t index 4d0fa349b35..669a9fde09f 100644 --- a/test/blackbox-tests/test-cases/duplicate-c-cxx/run.t +++ b/test/blackbox-tests/test-cases/duplicate-c-cxx/run.t @@ -4,15 +4,26 @@ c_names and cxx_names with overlapping names in the same stanza File "dune", line 4, characters 12-15: 4 | (cxx_names foo)) ^^^ - Error: foo.cpp and foo.c have conflicting names. You must rename one of them. + Error: Multiple sources map to the same object name "foo": + - foo.c + - foo.cpp + This is not allowed; please rename them. + Hint: You can also avoid the name clash by placing the objects into different + foreign archives and building them in different directories. Foreign archives + can be defined using the (foreign_library ...) stanza. [1] c_names with overlapping names in different stanzas $ dune build --root diff-stanza @all Entering directory 'diff-stanza' - File "dune", line 9, characters 10-13: - 9 | (c_names foo)) + File "dune", line 4, characters 10-13: + 4 | (c_names foo)) ^^^ - Error: This c stub is already used in another stanza: - - dune:4 + Error: Multiple sources map to the same object name "foo": + - foo.c + - foo.cpp + This is not allowed; please rename them. + Hint: You can also avoid the name clash by placing the objects into different + foreign archives and building them in different directories. Foreign archives + can be defined using the (foreign_library ...) stanza. [1] diff --git a/test/blackbox-tests/test-cases/exes-with-c/dune b/test/blackbox-tests/test-cases/exes-with-c/dune index a40cba7355a..c410bc6d394 100644 --- a/test/blackbox-tests/test-cases/exes-with-c/dune +++ b/test/blackbox-tests/test-cases/exes-with-c/dune @@ -1,4 +1,4 @@ (executables (names aa bb) - (c_names foo) + (foreign_stubs (language c) (names foo)) (modes exe)) 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 070ab7542d5..e4f65644857 100644 --- a/test/blackbox-tests/test-cases/exes-with-c/run.t +++ b/test/blackbox-tests/test-cases/exes-with-c/run.t @@ -22,16 +22,16 @@ $ cat > err/dune << EOF > (executable > (name foo) - > (c_names stubs)) + > (foreign_stubs (language c) (names stubs))) > EOF $ dune build --root err @all Entering directory 'err' Info: Creating file dune-project with this contents: | (lang dune 2.0) - File "dune", line 1, characters 0-41: + File "dune", line 1, characters 0-68: 1 | (executable 2 | (name foo) - 3 | (c_names stubs)) - Error: Pure bytecode executables cannot contain C stubs. - Did you forget to add `(modes exe)'? + 3 | (foreign_stubs (language c) (names stubs))) + Error: Pure bytecode executables cannot contain foreign stubs. + Hint: If you only need to build a native executable use "(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 new file mode 100644 index 00000000000..d07dd500916 --- /dev/null +++ b/test/blackbox-tests/test-cases/foreign-library/run.t @@ -0,0 +1,652 @@ +---------------------------------------------------------------------------------- +Testsuite for the (foreign_library ...) stanza. + +---------------------------------------------------------------------------------- +* (foreign_library ...) is unavailable before Dune 2.0. + + $ echo "(lang dune 1.0)" > dune-project + $ mkdir -p lib + + $ cat >lib/dune < (foreign_library + > (language c) + > (names add)) + > EOF + + $ dune build + File "lib/dune", line 1, characters 0-44: + 1 | (foreign_library + 2 | (language c) + 3 | (names add)) + Error: 'foreign_library' is only available since version 2.0 of the dune + language. Please update your dune-project file to have (lang 2.0). + [1] + +---------------------------------------------------------------------------------- +* (foreign_library ...) is available in Dune 2.0. +* "archive_name" is a required field. + + $ echo "(lang dune 2.0)" > dune-project + + $ dune build + File "lib/dune", line 1, characters 0-44: + 1 | (foreign_library + 2 | (language c) + 3 | (names add)) + Error: field archive_name missing + [1] + +---------------------------------------------------------------------------------- +* Error message for a missing source file. + + $ cat >lib/dune < (foreign_library + > (archive_name addmul) + > (language c) + > (names add mul)) + > EOF + + $ cat >lib/add.c < #include + > value add(value x, value y) { return Val_int(Int_val(x) + Int_val(y)); } + > EOF + + $ dune build + File "lib/dune", line 4, characters 12-15: + 4 | (names add mul)) + ^^^ + Error: Object "mul" has no source; "mul.c" must be present. + [1] + +---------------------------------------------------------------------------------- +* Successful build of a foreign library archive when all source files exist. + + $ cat >lib/mul.c < #include + > value mul(value x, value y) { return Val_int(Int_val(x) * Int_val(y)); } + > EOF + + $ dune build --display short + ocamlc lib/add$ext_obj + ocamlc lib/mul$ext_obj + ocamlmklib lib/dlladdmul$ext_dll,lib/libaddmul$ext_lib + +---------------------------------------------------------------------------------- +* Error message for a missing C++ source file. + + $ cat >lib/dune < (foreign_library + > (archive_name addmul) + > (language c) + > (names add mul)) + > (library + > (name calc) + > (modules calc) + > (foreign_archives addmul config)) + > (foreign_library + > (archive_name config) + > (language cxx) + > (flags -DCONFIG_VALUE=2000) + > (names config)) + > EOF + + $ rm -rf _build + $ dune build + File "lib/dune", line 13, characters 8-14: + 13 | (names config)) + ^^^^^^ + Error: Object "config" has no source; One of "config.cxx", "config.cc" or + "config.cpp" must be present. + [1] + +---------------------------------------------------------------------------------- +* Multiple (foreign_library ...) declarations. +* Mixing C and C++ foreign library archives. +* Passing flags via (flags ...) field. +* Interaction with (foreign_archives ...) stanza. + + $ cat >lib/config.cpp < #include + > extern "C" value config(value unit) { return Val_int(CONFIG_VALUE); } + > EOF + + $ cat >lib/calc.ml < external add : int -> int -> int = "add" + > external mul : int -> int -> int = "mul" + > external config : unit -> int = "config" + > let calc x y z = add (mul (add x y) z) (config ()) + > EOF + + $ cat >lib/calc.mli < val calc : int -> int -> int -> int + > EOF + + $ cat >dune < (executable + > (name main) + > (libraries calc) + > (modules main)) + > EOF + + $ cat >main.ml < let () = Printf.printf "%d" (Calc.calc 1 2 3) + > EOF + + $ rm -rf _build + $ dune build + + $ dune exec ./main.exe + 2009 + + $ (cd _build/default && ocamlrun -I lib main.bc) + 2009 + +---------------------------------------------------------------------------------- +* Include directories via the (include_dirs ...) field. +* Extra dependencies via the (extra_deps ...) field. + + $ cat >lib/dune < (foreign_library + > (archive_name addmul) + > (language c) + > (names add mul)) + > (library + > (name calc) + > (modules calc) + > (foreign_archives addmul config)) + > (foreign_library + > (archive_name config) + > (language cxx) + > (include_dirs headers) + > (extra_deps eight.h) + > (flags -DCONFIG_VALUE=2000) + > (names config)) + > EOF + + $ cat >lib/config.cpp < #include + > #include "ten.h" + > extern "C" value config(value unit) { return Val_int(CONFIG_VALUE + TEN); } + > EOF + + $ mkdir -p lib/headers + $ cat >lib/headers/ten.h < #include "../eight.h" + > #include "some/deep/path/one.h" + > #define TEN (1 + EIGHT + ONE) + > EOF + + $ mkdir -p lib/headers/some/deep/path + $ cat >lib/headers/some/deep/path/one.h < #define ONE 1 + > EOF + + $ cat >lib/eight.h < #define EIGHT 8 + > EOF + + $ rm -rf _build + $ dune build --display short + 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 + 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 + ocamlopt main.exe + ocamlc lib/.calc.objs/byte/calc.{cmo,cmt} + ocamlc lib/calc.cma + ocamlc main.bc + ocamlopt lib/calc.cmxs + + $ dune exec ./main.exe + 2019 + + $ (cd _build/default && ocamlrun -I lib main.bc) + 2019 + +---------------------------------------------------------------------------------- +* Error message when a given (include_dir ...) is not found. + + $ cat >lib/dune < (foreign_library + > (archive_name addmul) + > (language c) + > (names add mul)) + > (library + > (name calc) + > (modules calc) + > (foreign_archives addmul config)) + > (foreign_library + > (archive_name config) + > (language cxx) + > (include_dirs headers another/dir) + > (extra_deps eight.h) + > (flags -DCONFIG_VALUE=2000) + > (names config)) + > EOF + + $ dune build + File "lib/dune", line 12, characters 23-34: + 12 | (include_dirs headers another/dir) + ^^^^^^^^^^^ + Error: Include directory "another/dir" does not exist. + [1] + +---------------------------------------------------------------------------------- +* Warning about untracked dependencies in external include directories. + + $ cat >lib/dune < (foreign_library + > (archive_name addmul) + > (language c) + > (names add mul)) + > (library + > (name calc) + > (modules calc) + > (foreign_archives addmul config)) + > (foreign_library + > (archive_name config) + > (language cxx) + > (include_dirs headers /absolute/path) + > (extra_deps eight.h) + > (flags -DCONFIG_VALUE=2000) + > (names config)) + > EOF + + $ dune build + 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. + Hint: You can specify "/absolute/path" as an untracked include directory like this: + + (flags -I /absolute/path) + + [1] + + + +---------------------------------------------------------------------------------- +* Error message for multiple declarations with the same "archive_name". + + $ cat >lib/dune < (foreign_library + > (archive_name addmul) + > (language c) + > (names add)) + > (foreign_library + > (archive_name addmul) + > (language c) + > (names mul)) + > (library + > (name calc) + > (modules calc) + > (foreign_archives addmul config)) + > (foreign_library + > (archive_name config) + > (language cxx) + > (include_dirs headers /absolute/path) + > (extra_deps eight.h) + > (flags -DCONFIG_VALUE=2000) + > (names config)) + > EOF + + $ dune build + File "lib/dune", line 6, characters 1-22: + 6 | (archive_name addmul) + ^^^^^^^^^^^^^^^^^^^^^ + Error: Multiple foreign libraries with the same archive name "addmul"; the + name has already been taken in lib/dune:2. + [1] + +---------------------------------------------------------------------------------- +* Interaction of (foreign_stubs ...) and (foreign_archives ...). + + $ 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)) + > (foreign_library + > (archive_name config) + > (language cxx) + > (include_dirs headers) + > (extra_deps eight.h) + > (flags -DCONFIG_VALUE=2000) + > (names config)) + > EOF + + $ cat >lib/month.c < #include + > #include + > value month(value unit) { return caml_copy_string("October"); } + > EOF + + $ cat >lib/calc.ml < external add : int -> int -> int = "add" + > external mul : int -> int -> int = "mul" + > external config : unit -> int = "config" + > external month : unit -> string = "month" + > let calc x y z = add (mul (add x y) z) (config ()) + > EOF + + $ cat >lib/calc.mli < val calc : int -> int -> int -> int + > val month : unit -> string + > EOF + + $ cat >main.ml < let () = Printf.printf "%s %d" (Calc.month ()) (Calc.calc 1 2 3) + > EOF + + $ rm -rf _build + $ dune build + + $ dune exec ./main.exe + October 2019 + + $ (cd _build/default && ocamlrun -I 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)) + > (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 >dune < (executable + > (name main) + > (libraries calc) + > (foreign_archives lib/day) + > (modules main)) + > EOF + + $ cat >lib/day.c < #include + > value day(value unit) { return Val_int(8); } + > EOF + + $ cat >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 "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 only need to build a native executable use "(modes exe)". + [1] + +---------------------------------------------------------------------------------- +* Interaction of (foreign_archives ...) and (executables ...). +* Foreign archives in subdirectories. + + $ 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)) + > (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 >dune < (executable + > (modes exe) + > (name main) + > (libraries calc) + > (foreign_archives lib/day) + > (modules main)) + > EOF + + $ cat >lib/day.c < #include + > value day(value unit) { return Val_int(8); } + > EOF + + $ cat >main.ml < external day : unit -> int = "day" + > let () = Printf.printf "%d %s %d" (day ()) (Calc.month ()) (Calc.calc 1 2 3) + > EOF + + $ rm -rf _build + $ dune build + + $ dune exec ./main.exe + 8 October 2019 + +---------------------------------------------------------------------------------- +* Use (env ...) to pass C++ flags. + + $ 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)) + > (foreign_library + > (archive_name day) + > (language c) + > (names day)) + > (foreign_library + > (archive_name config) + > (language cxx) + > (include_dirs headers) + > (extra_deps eight.h) + > (names config)) + > EOF + + $ cat >dune < (env (_ (cxx_flags -DCONFIG_VALUE=2000))) + > (executable + > (modes exe) + > (name main) + > (libraries calc) + > (foreign_archives lib/day) + > (modules main)) + > EOF + + $ dune exec ./main.exe + 8 October 2019 + +---------------------------------------------------------------------------------- +* Generated header. + + $ 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)) + > (foreign_library + > (archive_name day) + > (language c) + > (names day)) + > (foreign_library + > (archive_name config) + > (language cxx) + > (include_dirs headers) + > (flags -DCONFIG_VALUE=2000) + > (extra_deps eight.h) + > (names config)) + > EOF + + $ 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(value unit) { return caml_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 + + $ rm -rf _build + $ dune exec --display short ./main.exe + 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 + 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 + ocamlc lib/month$ext_obj + ocamlmklib lib/dllcalc_stubs$ext_dll,lib/libcalc_stubs$ext_lib + gcc lib/config$ext_obj + ocamlmklib lib/dllconfig$ext_dll,lib/libconfig$ext_lib + ocamlc lib/day$ext_obj + ocamlmklib lib/dllday$ext_dll,lib/libday$ext_lib + ocamlc lib2/today$ext_obj + ocamlmklib lib2/dlltoday$ext_dll,lib2/libtoday$ext_lib + ocamlopt main.exe + Today: 8 October 2019 + +---------------------------------------------------------------------------------- +* Object files with the same name in different archives. +* Generated C source file. + + $ mkdir -p lib3 + $ cat >lib3/dune < (foreign_library + > (archive_name new_day) + > (language c) + > (names day)) + > (rule + > (action (write-file day.c "#include \nvalue new_day(value unit) { return Val_int(14); }\n"))) + > EOF + + $ cat >dune < (executable + > (name main) + > (modes exe) + > (libraries calc) + > (foreign_archives lib/day lib2/today lib3/new_day) + > (modules main)) + > EOF + + $ cat >main.ml < external day : unit -> int = "day" + > external today : unit -> string = "today" + > external new_day : unit -> int = "new_day" + > let () = Printf.printf "%s: %02d %s %d\n" (today ()) ( day ()) (Calc.month ()) (Calc.calc 1 2 3); + > Printf.printf "%s: %02d %s %d\n" (today ()) (new_day ()) (Calc.month ()) (Calc.calc 1 2 3); + > EOF + + $ rm -rf _build + $ dune exec ./main.exe --display short + 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 + 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 + ocamlc lib/month$ext_obj + ocamlmklib lib/dllcalc_stubs$ext_dll,lib/libcalc_stubs$ext_lib + gcc lib/config$ext_obj + ocamlmklib lib/dllconfig$ext_dll,lib/libconfig$ext_lib + ocamlc lib/day$ext_obj + ocamlmklib lib/dllday$ext_dll,lib/libday$ext_lib + ocamlc lib2/today$ext_obj + ocamlmklib lib2/dlltoday$ext_dll,lib2/libtoday$ext_lib + ocamlc lib3/day$ext_obj + ocamlmklib lib3/dllnew_day$ext_dll,lib3/libnew_day$ext_lib + ocamlopt main.exe + Today: 08 October 2019 + Today: 14 October 2019 diff --git a/test/blackbox-tests/test-cases/foreign-stubs/run.t b/test/blackbox-tests/test-cases/foreign-stubs/run.t new file mode 100644 index 00000000000..559753f5151 --- /dev/null +++ b/test/blackbox-tests/test-cases/foreign-stubs/run.t @@ -0,0 +1,264 @@ +---------------------------------------------------------------------------------- +Testsuite for the (foreign_stubs ...) field. + +---------------------------------------------------------------------------------- +* Error when using both (self_build_stubs_archive ...) and (c_names ...) before 2.0. + + $ echo "(lang dune 1.0)" > dune-project + + $ cat >dune < (library + > (name foo) + > (c_names foo) + > (self_build_stubs_archive (bar))) + > EOF + + $ dune build + File "dune", line 4, characters 1-33: + 4 | (self_build_stubs_archive (bar))) + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + Error: A library cannot use (self_build_stubs_archive ...) and (c_names ...) + simultaneously. This is supported starting from Dune 2.0. + [1] + +---------------------------------------------------------------------------------- +* Error when using (c_names ...) in (library ...) in Dune 2.0. + + $ echo "(lang dune 2.0)" > dune-project + + $ dune build + File "dune", line 3, characters 1-14: + 3 | (c_names foo) + ^^^^^^^^^^^^^ + Error: 'c_names' was deleted in version 2.0 of the dune language. Use the + (foreign_stubs ...) field instead. + [1] + +---------------------------------------------------------------------------------- +* Error when using (c_names ...) in (executable ...) in Dune 2.0. + + $ cat >dune < (executable + > (name foo) + > (c_names bar)) + > EOF + + $ dune build + File "dune", line 3, characters 2-9: + 3 | (c_names bar)) + ^^^^^^^ + Error: Unknown field c_names + [1] + +---------------------------------------------------------------------------------- +* Error when using (self_build_stubs_archive ...) in (library ...) in Dune 2.0. + + $ cat >dune < (library + > (name foo) + > (foreign_stubs (language c) (names foo)) + > (self_build_stubs_archive (bar))) + > EOF + + $ dune build + File "dune", line 4, characters 1-33: + 4 | (self_build_stubs_archive (bar))) + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + Error: 'self_build_stubs_archive' was deleted in version 2.0 of the dune + language. Use the (foreign_archives ...) field instead. + [1] + +---------------------------------------------------------------------------------- +* Error when using (self_build_stubs_archive ...) in (executable ...) in Dune 2.0. + + $ cat >dune < (executable + > (name foo) + > (foreign_stubs (language c) (names bar)) + > (self_build_stubs_archive (baz))) + > EOF + + $ dune build + File "dune", line 4, characters 2-26: + 4 | (self_build_stubs_archive (baz))) + ^^^^^^^^^^^^^^^^^^^^^^^^ + Error: Unknown field self_build_stubs_archive + [1] + +---------------------------------------------------------------------------------- +* Error when a C source file is missing. + + $ cat >dune < (library + > (name foo) + > (foreign_stubs (language c) (names foo)) + > (foreign_archives bar)) + > EOF + + $ dune build + File "dune", line 3, characters 36-39: + 3 | (foreign_stubs (language c) (names foo)) + ^^^ + Error: Object "foo" has no source; "foo.c" must be present. + [1] + +---------------------------------------------------------------------------------- +* Error when a self-built archive is missing. + + $ cat >foo.c < #include + > value foo(value unit) { return Val_int(9); } + > EOF + + $ dune build + Error: No rule found for libbar$ext_lib + [1] + +---------------------------------------------------------------------------------- +* Build succeeds when a self-built archive exists. + + $ cat >bar.c < #include + > value bar(value unit) { return Val_int(10); } + > EOF + + $ cat >dune < (library + > (name foo) + > (foreign_stubs (language c) (names foo)) + > (foreign_archives bar)) + > (rule + > (targets bar%{ext_obj}) + > (deps bar.c) + > (action (run %{ocaml-config:c_compiler} -c -I %{ocaml-config:standard_library} -o %{targets} %{deps}))) + > (rule + > (targets libbar.a) + > (deps bar%{ext_obj}) + > (action (run ar rcs %{targets} %{deps}))) + > EOF + + $ dune build + +---------------------------------------------------------------------------------- +* Error when specifying an (archive_name ...) in (foreign_stubs ...) stanza. + + $ cat >dune < (library + > (name foo) + > (foreign_stubs (archive_name baz) (language c) (names foo)) + > (foreign_archives bar)) + > (rule + > (targets bar%{ext_obj}) + > (deps bar.c) + > (action (run %{ocaml-config:c_compiler} -c -I %{ocaml-config:standard_library} -o %{targets} %{deps}))) + > (rule + > (targets libbar_stubs.a) + > (deps bar%{ext_obj}) + > (action (run ar rcs %{targets} %{deps}))) + > EOF + + $ dune build + File "dune", line 3, characters 16-34: + 3 | (foreign_stubs (archive_name baz) (language c) (names foo)) + ^^^^^^^^^^^^^^^^^^ + Error: The field "archive_name" is not allowed in the (foreign_stubs ...) + stanza. For named foreign archives use the (foreign_library ...) stanza. + [1] + +---------------------------------------------------------------------------------- +* Foreign stubs in C and C++ language. +* Multiple foreign stub archives. + + $ cat >baz.cpp < #include + > extern "C" value baz(value unit) { return Val_int(0); } + > EOF + + $ cat >qux.cpp < #include + > extern "C" value qux(value unit) { return Val_int(2000); } + > EOF + + $ cat >quad.ml < external foo : unit -> int = "foo" + > external bar : unit -> int = "bar" + > external baz : unit -> int = "baz" + > external qux : unit -> int = "qux" + > let quad x = foo x + bar x + baz x + qux x + > EOF + + $ cat >quad.mli < val quad : unit -> int + > EOF + + $ cat >main.ml < let () = Printf.printf "%d" (Quad.quad ()) + > EOF + + $ cat >dune < (library + > (name quad) + > (modules quad) + > (foreign_stubs (language c) (names foo)) + > (foreign_archives bar qux) + > (foreign_stubs (language cxx) (names baz))) + > (rule + > (targets bar%{ext_obj}) + > (deps bar.c) + > (action (run %{ocaml-config:c_compiler} -c -I %{ocaml-config:standard_library} -o %{targets} %{deps}))) + > (rule + > (targets libbar.a) + > (deps bar%{ext_obj}) + > (action (run ar rcs %{targets} %{deps}))) + > (rule + > (targets dllbar%{ext_dll}) + > (deps bar%{ext_obj}) + > (action (run %{ocaml-config:c_compiler} -shared -o %{targets} %{deps}))) + > (rule + > (targets qux%{ext_obj}) + > (deps qux.cpp) + > (action (run %{ocaml-config:c_compiler} -c -I %{ocaml-config:standard_library} -o %{targets} %{deps}))) + > (rule + > (targets libqux.a) + > (deps qux%{ext_obj}) + > (action (run ar rcs %{targets} %{deps}))) + > (rule + > (targets dllqux%{ext_dll}) + > (deps qux%{ext_obj}) + > (action (run %{ocaml-config:c_compiler} -shared -o %{targets} %{deps}))) + > (executable + > (name main) + > (libraries quad) + > (modules main)) + > EOF + + $ rm -rf _build + $ dune build --display short + gcc bar$ext_obj + gcc dllbar$ext_dll + gcc baz$ext_obj + ocamlc foo$ext_obj + ocamlmklib dllquad_stubs$ext_dll,libquad_stubs$ext_lib + gcc qux$ext_obj + ar libqux$ext_lib + ocamldep .quad.objs/quad.mli.d + ocamlc .quad.objs/byte/quad.{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 .quad.objs/quad.ml.d + ocamlopt .quad.objs/native/quad.{cmx,o} + ocamlopt quad.{a,cmxa} + ar libbar$ext_lib + ocamlopt main.exe + gcc dllqux$ext_dll + ocamlc .quad.objs/byte/quad.{cmo,cmt} + ocamlc quad.cma + ocamlc main.bc + ocamlopt quad.cmxs + + $ dune exec ./main.exe + 2019 + + $ (cd _build/default && ocamlrun -I . ./main.bc) + 2019 diff --git a/test/blackbox-tests/test-cases/github1306/dune b/test/blackbox-tests/test-cases/github1306/dune deleted file mode 100644 index cc5b3229f60..00000000000 --- a/test/blackbox-tests/test-cases/github1306/dune +++ /dev/null @@ -1,4 +0,0 @@ -(library - (name foo) - (c_names foo) - (self_build_stubs_archive (bar))) diff --git a/test/blackbox-tests/test-cases/github1306/dune-project b/test/blackbox-tests/test-cases/github1306/dune-project deleted file mode 100644 index de4fc209200..00000000000 --- a/test/blackbox-tests/test-cases/github1306/dune-project +++ /dev/null @@ -1 +0,0 @@ -(lang dune 1.0) diff --git a/test/blackbox-tests/test-cases/github1306/run.t b/test/blackbox-tests/test-cases/github1306/run.t deleted file mode 100644 index d73350c87ad..00000000000 --- a/test/blackbox-tests/test-cases/github1306/run.t +++ /dev/null @@ -1,7 +0,0 @@ - $ dune build - File "dune", line 4, characters 1-33: - 4 | (self_build_stubs_archive (bar))) - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ - Error: A library cannot use (self_build_stubs_archive ...) and (c_names ...) - simultaneously. - [1] diff --git a/test/blackbox-tests/test-cases/github734/run.t b/test/blackbox-tests/test-cases/github734/run.t index 2546d08ee10..23cda35655c 100644 --- a/test/blackbox-tests/test-cases/github734/run.t +++ b/test/blackbox-tests/test-cases/github734/run.t @@ -2,6 +2,6 @@ File "src/dune", line 4, characters 10-17: 4 | (c_names stubs/x)) ^^^^^^^ - Error: relative part of stub is not necessary and should be removed. To - include sources in subdirectories, use the include_subdirs stanza + Error: Relative part of stub is not necessary and should be removed. To + include sources in subdirectories, use the (include_subdirs ...) stanza. [1] diff --git a/test/blackbox-tests/test-cases/multi-dir/run.t b/test/blackbox-tests/test-cases/multi-dir/run.t index 01da88b4d38..87f82d3c6db 100644 --- a/test/blackbox-tests/test-cases/multi-dir/run.t +++ b/test/blackbox-tests/test-cases/multi-dir/run.t @@ -22,8 +22,8 @@ Test with C stubs in sub-directories File "dune", line 9, characters 16-25: 9 | (c_names stub1 sub/stub2)) ^^^^^^^^^ - Error: relative part of stub is not necessary and should be removed. To - include sources in subdirectories, use the include_subdirs stanza + Error: Relative part of stub is not necessary and should be removed. To + include sources in subdirectories, use the (include_subdirs ...) stanza. [1] Test some error cases diff --git a/test/blackbox-tests/test-cases/path-variables/run.t b/test/blackbox-tests/test-cases/path-variables/run.t index 78d9a0f7258..105ec716e80 100644 --- a/test/blackbox-tests/test-cases/path-variables/run.t +++ b/test/blackbox-tests/test-cases/path-variables/run.t @@ -25,5 +25,5 @@ This form does not exist, but displays an hint: File "dune", line 7, characters 17-54: 7 | (echo "%{path-no-dep:file-that-does-not-exist}\n") ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ - Error: %{path-no-dep:..} was deleted in version 1.0 of the dune language + Error: %{path-no-dep:..} was deleted in version 1.0 of the dune language. [1] diff --git a/test/blackbox-tests/test-cases/syntax-versioning/run.t b/test/blackbox-tests/test-cases/syntax-versioning/run.t index ab2c20d157e..a5fc335ba5c 100644 --- a/test/blackbox-tests/test-cases/syntax-versioning/run.t +++ b/test/blackbox-tests/test-cases/syntax-versioning/run.t @@ -5,7 +5,7 @@ File "dune", line 1, characters 0-18: 1 | (jbuild_version 1) ^^^^^^^^^^^^^^^^^^ - Error: 'jbuild_version' was deleted in version 1.0 of the dune language + Error: 'jbuild_version' was deleted in version 1.0 of the dune language. [1] $ rm -f dune @@ -23,7 +23,7 @@ File "dune", line 1, characters 21-45: 1 | (executable (name x) (link_executables false)) ^^^^^^^^^^^^^^^^^^^^^^^^ - Error: 'link_executables' was deleted in version 1.0 of the dune language + Error: 'link_executables' was deleted in version 1.0 of the dune language. [1] $ rm -f dune @@ -32,7 +32,7 @@ File "dune", line 1, characters 40-42: 1 | (alias (name x) (deps x) (action (run %{<}))) ^^ - Error: %{<} was deleted in version 1.0 of the dune language + Error: %{<} was deleted in version 1.0 of the dune language. Use a named dependency instead: (deps (:x ) ...)