From f912887911ff6464172fb4a7d40a229cdde4b6f0 Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Tue, 16 Feb 2021 12:29:26 +0000 Subject: [PATCH] No longer edit or create dune-project files Signed-off-by: Jeremie Dimino --- CHANGES.md | 3 + bin/compute.ml | 7 + doc/test/run.t | 4 +- src/dune_engine/dune_project.ml | 241 ++++-------------- src/dune_engine/dune_project.mli | 12 - src/dune_engine/file_tree.ml | 6 +- src/dune_lang/syntax.ml | 73 ++++-- src/dune_lang/syntax.mli | 5 +- src/upgrader/dune_upgrader.ml | 39 ++- .../test-cases/coq/github3624.t/run.t | 14 +- .../test-cases/dune-init.t/run.t | 30 +-- .../test-cases/dune-project-edition.t/run.t | 18 -- .../test-cases/extensions-versionning.t/run.t | 22 +- .../using-and-dune-lang/dune | 1 + .../using-and-dune-lang/dune-project | 1 + .../using-generation/dune | 2 - .../test-cases/github1529.t/run.t | 8 +- .../test-cases/mdx-stanza.t/run.t | 7 +- .../test-cases/menhir/env.t/run.t | 6 +- .../test-cases/upgrader.t/run.t | 4 +- 20 files changed, 192 insertions(+), 311 deletions(-) delete mode 100644 test/blackbox-tests/test-cases/dune-project-edition.t/run.t create mode 100644 test/blackbox-tests/test-cases/extensions-versionning.t/using-and-dune-lang/dune create mode 100644 test/blackbox-tests/test-cases/extensions-versionning.t/using-and-dune-lang/dune-project delete mode 100644 test/blackbox-tests/test-cases/extensions-versionning.t/using-generation/dune diff --git a/CHANGES.md b/CHANGES.md index 25547d74e90..89f1bd9fae5 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -38,6 +38,9 @@ Unreleased - No longer call `chmod` on symbolic links (fixes #4195, @dannywillems) +- Dune no longer automatically create or edit `dune-project` files + (#4239, fixes #4108, @jeremiedimino) + 2.8.2 (21/01/2021) ------------------ diff --git a/bin/compute.ml b/bin/compute.ml index 6acddf68be4..60f5f89e7da 100644 --- a/bin/compute.ml +++ b/bin/compute.ml @@ -35,6 +35,13 @@ let term = let open Fiber.O in let* _setup = Memo.Build.run (Import.Main.setup common) in match (fn, inp) with + | "latest-lang-version", None -> + Fiber.return + (`Result + (Dyn.String + ( Dune_lang.Syntax.greatest_supported_version + Dune_engine.Stanza.syntax + |> Dune_lang.Syntax.Version.to_string ))) | "list", None -> Fiber.return `List | "list", Some _ -> Fiber.return (`Error "'list' doesn't take an argument") diff --git a/doc/test/run.t b/doc/test/run.t index d0103c2d3ac..5a3f706b8e5 100644 --- a/doc/test/run.t +++ b/doc/test/run.t @@ -6,9 +6,7 @@ When changing Dune version, you need to update the docs too to make this test pa Occasionally we do want to mention an older Dune version in documentation. This is fine, but you then need to update the list of such exceptions below. - $ touch dune - $ dune build > /dev/null 2> /dev/null - $ DUNE_LANG=$(cat dune-project) + $ DUNE_LANG=$(dune compute latest-lang-version | sed 's/"//g') $ grep '(lang dune' ../*.rst | grep -v "$DUNE_LANG" ../formatting.rst:If using ``(lang dune 2.0)``, there is nothing to setup in dune, formatting will ../formatting.rst:.. note:: This section applies only to projects with ``(lang dune 1.x)``. diff --git a/src/dune_engine/dune_project.ml b/src/dune_engine/dune_project.ml index 03471ae43de..9d86a15255b 100644 --- a/src/dune_engine/dune_project.ml +++ b/src/dune_engine/dune_project.ml @@ -117,22 +117,6 @@ end = struct | _ -> invalid s end -module Project_file = struct - type t = - { file : Path.Source.t - ; mutable exists : bool - ; project_name : Name.t - } - - let to_dyn { file; exists; project_name } = - let open Dyn.Encoder in - record - [ ("file", Path.Source.to_dyn file) - ; ("exists", bool exists) - ; ("project_name", Name.to_dyn project_name) - ] -end - module File_key = struct type t = string @@ -154,7 +138,7 @@ type t = ; info : Package.Info.t ; packages : Package.t Package.Name.Map.t ; stanza_parser : Stanza.t list Dune_lang.Decoder.t - ; project_file : Project_file.t + ; project_file : Path.Source.t ; extension_args : Univ_map.t ; parsing_context : Univ_map.t ; implicit_transitive_deps : bool @@ -185,7 +169,7 @@ let root t = t.root let stanza_parser t = t.stanza_parser -let file t = t.project_file.file +let file t = t.project_file let file_key t = t.file_key @@ -228,7 +212,7 @@ let to_dyn ; ("root", Path.Source.to_dyn root) ; ("version", (option string) version) ; ("info", Package.Info.to_dyn info) - ; ("project_file", Project_file.to_dyn project_file) + ; ("project_file", Path.Source.to_dyn project_file) ; ( "packages" , (list (pair Package.Name.to_dyn Package.to_dyn)) (Package.Name.Map.to_list packages) ) @@ -262,72 +246,6 @@ type created_or_already_exist = | Created | Already_exist -module Project_file_edit = struct - open Project_file - - let notify_user paragraphs = - Console.print_user_message - (User_message.make paragraphs - ~prefix: - (Pp.seq - (Pp.tag User_message.Style.Warning (Pp.verbatim "Info")) - (Pp.char ':'))) - - let lang_stanza () = - let ver = (Lang.get_exn "dune").version in - sprintf "(lang dune %s)" (Dune_lang.Syntax.Version.to_string ver) - - let ensure_exists t = - if t.exists then - Already_exist - else - let ver = !default_dune_language_version in - let lines = - [ sprintf "(lang dune %s)" (Dune_lang.Syntax.Version.to_string ver) ] - in - let lines = - match t.project_name with - | Anonymous _ -> lines - | Named s -> - lines - @ [ Dune_lang.to_string - (List - [ Dune_lang.atom "name"; Dune_lang.atom_or_quoted_string s ]) - ] - in - notify_user - [ Pp.textf "Creating file %s with this contents:" - (Path.Source.to_string_maybe_quoted t.file) - ; Pp.vbox - (Pp.concat_map lines ~sep:Pp.cut ~f:(fun line -> - Pp.seq (Pp.verbatim "| ") (Pp.verbatim line))) - ]; - Io.write_lines (Path.source t.file) lines ~binary:false; - t.exists <- true; - Created - - let append t sexp = - let what = ensure_exists t in - let prev = Io.read_file (Path.source t.file) ~binary:false in - let sexp = Dune_lang.to_string sexp in - notify_user - [ Pp.textf "Appending this line to %s: %s" - (Path.Source.to_string_maybe_quoted t.file) - sexp - ]; - Io.with_file_out (Path.source t.file) ~binary:false ~f:(fun oc -> - List.iter [ prev; sexp ] ~f:(fun s -> - output_string oc s; - let len = String.length s in - if len > 0 && s.[len - 1] <> '\n' then output_char oc '\n')); - what -end - -let lang_stanza = Project_file_edit.lang_stanza - -let ensure_project_file_exists t = - Project_file_edit.ensure_exists t.project_file - module Extension = struct type 'a t = 'a Univ_map.Key.t @@ -396,68 +314,22 @@ module Extension = struct Dune_lang.Syntax.check_supported ~dune_lang_ver e.syntax (ver_loc, ver); { extension = Packed e; version = ver; loc; parse_args } - (* Extensions that are not selected in the dune-project file are automatically - available at their latest version. When used, dune will automatically edit - the dune-project file. *) - type automatic = - | Disabled of packed_extension - | Enabled of instance + | Selected of instance + | Not_selected of packed_extension - let automatic ~lang ~project_file ~explicitly_selected : automatic list = + let automatic ~explicitly_selected : automatic list = Table.foldi extensions ~init:[] ~f:(fun name extension acc -> - if explicitly_selected name then - acc - else + match String.Map.find explicitly_selected name with + | Some instance -> Selected instance :: acc + | None -> ( match extension with | Deleted_in _ -> acc - | Extension (Packed e) -> ( - let version = - if Dune_lang.Syntax.experimental e.syntax then - Some (0, 0) - else - let dune_lang_ver = lang.Lang.Instance.version in - Dune_lang.Syntax.greatest_supported_version_for_dune_lang - ~dune_lang_ver e.syntax - in - match version with - | None -> Disabled (Packed e) :: acc - | Some version -> - let parse_args p = - let open Dune_lang.Decoder in - let dune_project_edited = ref false in - let arg, stanzas = - parse (enter p) Univ_map.empty (List (Loc.of_pos __POS__, [])) - in - let result_stanzas = - List.map stanzas ~f:(fun (name, p) -> - ( name - , let* () = return () in - if not !dune_project_edited then ( - dune_project_edited := true; - ignore - ( Project_file_edit.append project_file - (List - [ Dune_lang.atom "using" - ; Dune_lang.atom - (Dune_lang.Syntax.name e.syntax) - ; Dune_lang.atom - (Dune_lang.Syntax.Version.to_string - version) - ]) - : created_or_already_exist ) - ); - p )) - in - (arg, result_stanzas) - in - Enabled - { extension = Packed e; version; loc = Loc.none; parse_args } - :: acc )) + | Extension e -> Not_selected e :: acc )) end let interpret_lang_and_extensions ~(lang : Lang.Instance.t) ~explicit_extensions - ~project_file = + = match String.Map.of_list (List.map explicit_extensions ~f:(fun (e : Extension.instance) -> @@ -465,20 +337,13 @@ let interpret_lang_and_extensions ~(lang : Lang.Instance.t) ~explicit_extensions let (Packed e) = e.extension in e.syntax in - (Dune_lang.Syntax.name syntax, e.loc))) + (Dune_lang.Syntax.name syntax, e))) with - | Error (name, _, loc) -> - User_error.raise ~loc + | Error (name, _, ext) -> + User_error.raise ~loc:ext.loc [ Pp.textf "Extension %S specified for the second time." name ] | Ok map -> - let extensions = - let implicit_extensions = - Extension.automatic ~lang ~project_file - ~explicitly_selected:(String.Map.mem map) - in - List.map ~f:(fun e -> (Extension.Enabled e, true)) explicit_extensions - @ List.map ~f:(fun e -> (e, false)) implicit_extensions - in + let extensions = Extension.automatic ~explicitly_selected:map in let parsing_context = let init = Univ_map.singleton @@ -489,50 +354,62 @@ let interpret_lang_and_extensions ~(lang : Lang.Instance.t) ~explicit_extensions Univ_map.set init String_with_vars.decoding_env_key (Pform.Env.initial lang.version) in - List.fold_left extensions ~init - ~f:(fun acc ((ext : Extension.automatic), _) -> + List.fold_left extensions ~init ~f:(fun acc (ext : Extension.automatic) -> let syntax = let (Extension.Packed ext) = match ext with - | Extension.Enabled e -> e.extension - | Disabled e -> e + | Selected e -> e.extension + | Not_selected e -> e in ext.syntax in let status : Dune_lang.Syntax.Key.t = match ext with - | Enabled ext -> Active ext.version - | Disabled (Packed e) -> - let dune_lang_ver = lang.Lang.Instance.version in - let lang = e.syntax in - Disabled { lang; dune_lang_ver } + | Selected ext -> Active ext.version + | Not_selected (Packed e) -> + Inactive + { lang = e.syntax; dune_lang_ver = lang.Lang.Instance.version } in Univ_map.set acc (Dune_lang.Syntax.key syntax) status) in let extension_args, extension_stanzas = List.fold_left extensions ~init:(Univ_map.empty, []) - ~f:(fun - (args_acc, stanzas_acc) - ((ext : Extension.automatic), is_explicit) - -> + ~f:(fun (args_acc, stanzas_acc) (ext : Extension.automatic) -> match ext with - | Disabled _ -> (args_acc, stanzas_acc) - | Enabled instance -> + | Not_selected (Packed e) -> + let stanzas = + let open Dune_lang.Decoder in + let _arg, stanzas = + let parsing_context = + (* Temporarily mark the extension as active so that we can + call the parser and extract the list of stanza names this + extension registers *) + Univ_map.set parsing_context + (Dune_lang.Syntax.key e.syntax) + (Active + (Dune_lang.Syntax.greatest_supported_version e.syntax)) + in + parse (enter e.stanzas) parsing_context + (List (Loc.of_pos __POS__, [])) + in + List.map stanzas ~f:(fun (name, _) -> + ( name + , let+ _ = Dune_lang.Syntax.get_exn e.syntax in + (* The above [get_exn] will raise because the extension is + inactive *) + assert false )) + in + (args_acc, stanzas :: stanzas_acc) + | Selected instance -> let (Packed e) = instance.extension in let args = let+ arg, stanzas = Dune_lang.Decoder.set_many parsing_context e.stanzas in - let new_args_acc = - if is_explicit then - Univ_map.set args_acc e.key arg - else - args_acc - in - (new_args_acc, stanzas) + (Univ_map.set args_acc e.key arg, stanzas) in - let new_args_acc, stanzas = instance.parse_args args in - (new_args_acc, stanzas :: stanzas_acc)) + let args_acc, stanzas = instance.parse_args args in + (args_acc, stanzas :: stanzas_acc)) in let stanzas = List.concat (lang.data :: extension_stanzas) in let stanza_parser = @@ -592,14 +469,9 @@ let default_name ~dir ~(packages : Package.t Package.Name.Map.t) = let infer ~dir packages = let lang = get_dune_lang () in let name = default_name ~dir ~packages in - let project_file = - { Project_file.file = Path.Source.relative dir filename - ; exists = false - ; project_name = name - } - in + let project_file = Path.Source.relative dir filename in let parsing_context, stanza_parser, extension_args = - interpret_lang_and_extensions ~lang ~explicit_extensions:[] ~project_file + interpret_lang_and_extensions ~lang ~explicit_extensions:[] in let implicit_transitive_deps = implicit_transitive_deps_default ~lang in let wrapped_executables = wrapped_executables_default ~lang in @@ -813,11 +685,8 @@ let parse ~dir ~lang ~opam_packages ~file ~dir_status = | Some n -> n | None -> default_name ~dir ~packages in - let project_file : Project_file.t = - { file; exists = true; project_name = name } - in let parsing_context, stanza_parser, extension_args = - interpret_lang_and_extensions ~lang ~explicit_extensions ~project_file + interpret_lang_and_extensions ~lang ~explicit_extensions in let implicit_transitive_deps = Option.value implicit_transitive_deps @@ -886,7 +755,7 @@ let parse ~dir ~lang ~opam_packages ~file ~dir_status = ; info ; packages ; stanza_parser - ; project_file + ; project_file = file ; extension_args ; parsing_context ; implicit_transitive_deps diff --git a/src/dune_engine/dune_project.mli b/src/dune_engine/dune_project.mli index f7bec273c58..c3397c09966 100644 --- a/src/dune_engine/dune_project.mli +++ b/src/dune_engine/dune_project.mli @@ -29,12 +29,6 @@ module Name : sig module Map : Map.S with type key = t end -module Project_file : sig - type t - - val to_dyn : t -> Dyn.t -end - type t module File_key : sig @@ -144,12 +138,6 @@ type created_or_already_exist = | Created | Already_exist -(** Generate an appropriate project [lang] stanza *) -val lang_stanza : unit -> string - -(** Check that the dune-project file exists and create it otherwise. *) -val ensure_project_file_exists : t -> created_or_already_exist - (** Default language version to use for projects that don't have a [dune-project] file. The default value is the latest version of the dune language. *) diff --git a/src/dune_engine/file_tree.ml b/src/dune_engine/file_tree.ml index 30266a98fd5..cdd899692c4 100644 --- a/src/dune_engine/file_tree.ml +++ b/src/dune_engine/file_tree.ml @@ -512,13 +512,9 @@ end = struct let dune_file_absent = (not file_exists) && Option.is_none from_parent in if dune_file_absent then None - else ( - ignore - ( Dune_project.ensure_project_file_exists project - : Dune_project.created_or_already_exist ); + else let file = Path.Source.relative path Dune_file.fname in Some (Dune_file.load file ~file_exists ~project ~from_parent) - ) let contents { Readdir.dirs; files } ~dirs_visited ~project ~path ~(dir_status : Sub_dirs.Status.t) = diff --git a/src/dune_lang/syntax.ml b/src/dune_lang/syntax.ml index 183d532b70f..c919938b1ff 100644 --- a/src/dune_lang/syntax.ml +++ b/src/dune_lang/syntax.ml @@ -132,7 +132,7 @@ type t = and key = | Active of Version.t - | Disabled of + | Inactive of { lang : t ; dune_lang_ver : Version.t } @@ -149,7 +149,7 @@ let to_dyn { name; desc; key = _; supported_versions; experimental } = module Key = struct type nonrec t = key = | Active of Version.t - | Disabled of + | Inactive of { lang : t ; dune_lang_ver : Version.t } @@ -158,7 +158,7 @@ module Key = struct let open Dyn.Encoder in function | Active v -> Version.to_dyn v - | Disabled { lang; dune_lang_ver } -> + | Inactive { lang; dune_lang_ver } -> record [ ("lang", to_dyn lang) ; ("dune_lang_ver", Version.to_dyn dune_lang_ver) @@ -203,27 +203,48 @@ module Error = struct ] :: repl ) - let disabled loc t ~dune_lang_ver ~what = - let min_lang_version, min_dune_version = - let major, major_map = - Option.value_exn (Int.Map.min_binding t.supported_versions) - in - let minor, lang = Option.value_exn (Int.Map.min_binding major_map) in - ((major, minor), lang) + let inactive loc t ~dune_lang_ver ~what = + let greatest_supported_version = + Supported_versions.greatest_supported_version_for_dune_lang ~dune_lang_ver + t.supported_versions in User_error.raise ~loc - [ Pp.textf - "%s is available only when %s is enabled in the dune-project file. \ - It cannot be enabled automatically because the currently selected \ - version of dune (%s) does not support this plugin.\n\ - You must enable it using (using %s ..) in your dune-project file. \ - The first version of this plugin %s was introduced in dune %s." - what t.name - (Version.to_string dune_lang_ver) - t.name - (Version.to_string min_lang_version) - (Version.to_string min_dune_version) - ] + ( [ Pp.textf + "%s is available only when %s is enabled in the dune-project file. \ + You must enable it using (using %s %s) in your dune-project file." + what t.name t.name + ( match greatest_supported_version with + | Some v -> Version.to_string v + | None -> ".." ) + ] + @ + if t.experimental then + [ Pp.textf + "Note however that %s is experimental and might change without \ + notice in the future." + t.name + ] + else + match greatest_supported_version with + | None -> + let min_lang_version, min_dune_version = + let major, major_map = + Option.value_exn (Int.Map.min_binding t.supported_versions) + in + let minor, lang = + Option.value_exn (Int.Map.min_binding major_map) + in + ((major, minor), lang) + in + [ Pp.textf + "Note however that the currently selected version of dune (%s) \ + does not support this plugin. The first version of this plugin \ + is %s and was introduced in dune %s." + (Version.to_string dune_lang_ver) + (Version.to_string min_lang_version) + (Version.to_string min_dune_version) + ] + | Some _ -> [] ) end module Warning = struct @@ -292,10 +313,6 @@ let greatest_supported_version t = Option.value_exn (Supported_versions.greatest_supported_version t.supported_versions) -let greatest_supported_version_for_dune_lang t ~dune_lang_ver = - Supported_versions.greatest_supported_version_for_dune_lang - t.supported_versions ~dune_lang_ver - let key t = t.key let experimental t = t.experimental @@ -315,9 +332,9 @@ let desc () = let get_exn t = get t.key >>= function | Some (Active x) -> return x - | Some (Disabled { dune_lang_ver; lang }) -> + | Some (Inactive { dune_lang_ver; lang }) -> let* loc, what = desc () in - Error.disabled loc lang ~what ~dune_lang_ver + Error.inactive loc lang ~what ~dune_lang_ver | None -> let+ context = get_all in Code_error.raise "Syntax identifier is unset" diff --git a/src/dune_lang/syntax.mli b/src/dune_lang/syntax.mli index c67c7b0abd8..a5a1fd8aabc 100644 --- a/src/dune_lang/syntax.mli +++ b/src/dune_lang/syntax.mli @@ -74,9 +74,6 @@ val check_supported : dune_lang_ver:Version.t -> t -> Loc.t * Version.t -> unit val greatest_supported_version : t -> Version.t -val greatest_supported_version_for_dune_lang : - t -> dune_lang_ver:Version.t -> Version.t option - (** {1 S-expression parsing} *) (** {2 High-level functions} *) @@ -103,7 +100,7 @@ val since : ?fatal:bool -> t -> Version.t -> (unit, _) Decoder.parser module Key : sig type nonrec t = | Active of Version.t - | Disabled of + | Inactive of { lang : t ; dune_lang_ver : Version.t } diff --git a/src/upgrader/dune_upgrader.ml b/src/upgrader/dune_upgrader.ml index c411c7c2cef..bc06a852c6a 100644 --- a/src/upgrader/dune_upgrader.ml +++ b/src/upgrader/dune_upgrader.ml @@ -136,6 +136,28 @@ module Common = struct Dune_lang.Parser.insert_comments new_csts comments |> Format_dune_lang.pp_top_sexps ~version |> Format.asprintf "%a@?" Pp.to_fmt + + let ensure_project_file_exists project ~lang_version = + let fn = Path.source (Dune_project.file project) in + if not (Path.exists fn) then ( + Console.print + [ Pp.textf "Creating %s..." (Path.to_string_maybe_quoted fn) ]; + Io.write_lines fn ~binary:false + (List.concat + [ [ sprintf "(lang dune %s)" + (Dune_lang.Syntax.Version.to_string lang_version) + ] + ; ( match Dune_project.name project with + | Anonymous _ -> [] + | Named s -> + [ Dune_lang.to_string + (List + [ Dune_lang.atom "name" + ; Dune_lang.atom_or_quoted_string s + ]) + ] ) + ]) + ) end module V1 = struct @@ -446,16 +468,16 @@ module V1 = struct ) let upgrade todo dir = - Dune_project.default_dune_language_version := (1, 0); + let lang_version = (1, 0) in + Dune_project.default_dune_language_version := lang_version; let project = File_tree.Dir.project dir in let project_root = Dune_project.root project in - ( if project_root = File_tree.Dir.path dir then - let (_ : Dune_project.created_or_already_exist) = - Dune_project.ensure_project_file_exists project - in + if project_root = File_tree.Dir.path dir then ( + ensure_project_file_exists project ~lang_version; Package.Name.Map.iter (Dune_project.packages project) ~f:(fun pkg -> let fn = Package.opam_file pkg in - if Path.exists (Path.source fn) then upgrade_opam_file todo fn) ); + if Path.exists (Path.source fn) then upgrade_opam_file todo fn) + ); if String.Set.mem (File_tree.Dir.files dir) File_tree.Dune_file.jbuild_fname then let fn = @@ -619,10 +641,11 @@ module V2 = struct language. Use the (foreign_archives ...) field instead.|} let upgrade todo dir = - Dune_project.default_dune_language_version := (2, 0); + let lang_version = (2, 0) in + Dune_project.default_dune_language_version := lang_version; let project = File_tree.Dir.project dir in if Dune_project.root project = File_tree.Dir.path dir then - ignore (Dune_project.ensure_project_file_exists project); + ensure_project_file_exists project ~lang_version; update_project_file todo project; upgrade_dune_files todo dir end diff --git a/test/blackbox-tests/test-cases/coq/github3624.t/run.t b/test/blackbox-tests/test-cases/coq/github3624.t/run.t index 6dba3d9b862..c3914ff4f2b 100644 --- a/test/blackbox-tests/test-cases/coq/github3624.t/run.t +++ b/test/blackbox-tests/test-cases/coq/github3624.t/run.t @@ -1,8 +1,16 @@ -In github #3624, dune created a dune-project with an incorrect using line. +This used to be a reproduction case for #3624, where dune created a +dune-project with an incorrect using line. Since we dropped support +for automatically creating the dune-project file, this is now testing +that the error message is good when the coq extension is not enabled. $ cat >dune < (coq.theory > (name foo)) > EOF - $ dune build 2>&1 | grep using - Info: Appending this line to dune-project: (using coq 0.3) + $ dune build + File "dune", line 1, characters 0-24: + 1 | (coq.theory + 2 | (name foo)) + Error: 'coq.theory' is available only when coq is enabled in the dune-project + file. You must enable it using (using coq 0.3) in your dune-project file. + [1] diff --git a/test/blackbox-tests/test-cases/dune-init.t/run.t b/test/blackbox-tests/test-cases/dune-init.t/run.t index f9ec2fe9fb4..9bcdcb5cce4 100644 --- a/test/blackbox-tests/test-cases/dune-init.t/run.t +++ b/test/blackbox-tests/test-cases/dune-init.t/run.t @@ -19,10 +19,7 @@ Can init a public library Can build the public library - $ (cd _test_lib_dir && touch test_lib.opam && dune build 2>&1 | sed "s/(lang dune .*)/(lang dune )/") - Info: Creating file dune-project with this contents: - | (lang dune ) - | (name test_lib) + $ (cd _test_lib_dir && touch test_lib.opam && dune build) $ cat ./_test_lib_dir/dune (library (public_name test_lib) @@ -70,10 +67,7 @@ Can init a public executable Can build an executable - $ (cd _test_bin_dir && touch test_bin.opam && dune build 2>&1 | sed "s/(lang dune .*)/(lang dune )/") - Info: Creating file dune-project with this contents: - | (lang dune ) - | (name test_bin) + $ (cd _test_bin_dir && touch test_bin.opam && dune build) Can run the created executable @@ -150,10 +144,7 @@ Can init a library and dependent executable in a combo project Can build the combo project - $ (cd _test_lib_exe_dir && touch test_bin.opam && dune build 2>&1 | sed "s/(lang dune .*)/(lang dune )/") - Info: Creating file dune-project with this contents: - | (lang dune ) - | (name test_bin) + $ (cd _test_lib_exe_dir && touch test_bin.opam && dune build) Can run the combo project @@ -183,10 +174,7 @@ Can add multiple libraries in the same directory Can build the multiple library project - $ (cd _test_lib && touch test_lib1.opam && dune build 2>&1 | sed "s/(lang dune .*)/(lang dune )/") - Info: Creating file dune-project with this contents: - | (lang dune ) - | (name test_lib1) + $ (cd _test_lib && touch test_lib1.opam && dune build) Clan up the multiple library project @@ -314,11 +302,8 @@ Can init and build a new executable project dune test_exec_proj.ml - $ dune exec --root test_exec_proj ./bin/main.exe 2>&1 | sed "s/(lang dune .*)/(lang dune )/" + $ dune exec --root test_exec_proj ./bin/main.exe Entering directory 'test_exec_proj' - Info: Creating file dune-project with this contents: - | (lang dune ) - | (name test_exec_proj) Entering directory 'test_exec_proj' Hello, World! @@ -342,11 +327,8 @@ Can init and build a new library project dune test_lib_proj.ml - $ dune build --root test_lib_proj @install --display short 2>&1 | sed "s/(lang dune .*)/(lang dune )/" + $ dune build --root test_lib_proj @install --display short Entering directory 'test_lib_proj' - Info: Creating file dune-project with this contents: - | (lang dune ) - | (name test_lib_proj) ocamlc lib/.test_lib_proj.objs/byte/test_lib_proj.{cmi,cmo,cmt} ocamlopt lib/.test_lib_proj.objs/native/test_lib_proj.{cmx,o} ocamlc lib/test_lib_proj.cma diff --git a/test/blackbox-tests/test-cases/dune-project-edition.t/run.t b/test/blackbox-tests/test-cases/dune-project-edition.t/run.t deleted file mode 100644 index 532044bb6d1..00000000000 --- a/test/blackbox-tests/test-cases/dune-project-edition.t/run.t +++ /dev/null @@ -1,18 +0,0 @@ - $ [ -e dune-project ] || echo File does not exist - File does not exist - $ mkdir src - $ echo '(rule (alias runtest) (action (progn)))' > src/dune - $ dune build 2>&1 | sed "s/(lang dune .*)/(lang dune )/" - Info: Creating file dune-project with this contents: - | (lang dune ) - $ cat dune-project | sed "s/(lang dune .*)/(lang dune )/" - (lang dune ) - -Test that using menhir automatically update the dune-project file - - $ echo '(library (name x)) (menhir (modules x))' >> src/dune - $ dune build @install 2>&1 | sed "s/(using menhir .*)/(using menhir )/" - Info: Appending this line to dune-project: (using menhir ) - $ cat dune-project | sed "s/(lang dune .*)/(lang dune )/" | sed "s/(using menhir .*)/(using menhir )/" - (lang dune ) - (using menhir ) diff --git a/test/blackbox-tests/test-cases/extensions-versionning.t/run.t b/test/blackbox-tests/test-cases/extensions-versionning.t/run.t index f686182ff84..ac444532411 100644 --- a/test/blackbox-tests/test-cases/extensions-versionning.t/run.t +++ b/test/blackbox-tests/test-cases/extensions-versionning.t/run.t @@ -1,9 +1,5 @@ Test that version of extensions is compatible with dune_lang version - $ cat >using-generation/dune-project < (lang dune 1.2) - > EOF - $ dune build --root version-mismatch Entering directory 'version-mismatch' File "dune-project", line 2, characters 14-17: @@ -38,8 +34,16 @@ Test that version of extensions is compatible with dune_lang version TODO $ dune build --root version-mismatch-2.5 Should raise an error and not a warning as in $ dune build --root version-mismatch -Using fields in dune-project should be generated according to -the maximum supported version for the chosen dune lang version - $ dune build --root using-generation - Entering directory 'using-generation' - Info: Appending this line to dune-project: (using menhir 1.0) +Check the error message when using an extension that is not available +at the current language version: + $ dune build --root using-and-dune-lang + Entering directory 'using-and-dune-lang' + File "dune", line 1, characters 0-5: + 1 | (mdx) + ^^^^^ + Error: 'mdx' is available only when mdx is enabled in the dune-project file. + You must enable it using (using mdx ..) in your dune-project file. + Note however that the currently selected version of dune (1.0) does not + support this plugin. The first version of this plugin is 0.1 and was + introduced in dune 2.4. + [1] diff --git a/test/blackbox-tests/test-cases/extensions-versionning.t/using-and-dune-lang/dune b/test/blackbox-tests/test-cases/extensions-versionning.t/using-and-dune-lang/dune new file mode 100644 index 00000000000..b2542175724 --- /dev/null +++ b/test/blackbox-tests/test-cases/extensions-versionning.t/using-and-dune-lang/dune @@ -0,0 +1 @@ +(mdx) diff --git a/test/blackbox-tests/test-cases/extensions-versionning.t/using-and-dune-lang/dune-project b/test/blackbox-tests/test-cases/extensions-versionning.t/using-and-dune-lang/dune-project new file mode 100644 index 00000000000..de4fc209200 --- /dev/null +++ b/test/blackbox-tests/test-cases/extensions-versionning.t/using-and-dune-lang/dune-project @@ -0,0 +1 @@ +(lang dune 1.0) diff --git a/test/blackbox-tests/test-cases/extensions-versionning.t/using-generation/dune b/test/blackbox-tests/test-cases/extensions-versionning.t/using-generation/dune deleted file mode 100644 index 1791fba8f57..00000000000 --- a/test/blackbox-tests/test-cases/extensions-versionning.t/using-generation/dune +++ /dev/null @@ -1,2 +0,0 @@ -(menhir - (modules parser.mly)) diff --git a/test/blackbox-tests/test-cases/github1529.t/run.t b/test/blackbox-tests/test-cases/github1529.t/run.t index 9b602fbe5e9..c258d1e2d8f 100644 --- a/test/blackbox-tests/test-cases/github1529.t/run.t +++ b/test/blackbox-tests/test-cases/github1529.t/run.t @@ -2,6 +2,8 @@ Reproduction case for #1529: using an extension when no dune-project file is present. $ dune build @install 2>&1 | sed "s/(lang dune .*)/(lang dune )/" | sed "s/(using menhir .*)/(using menhir )/" - Info: Creating file dune-project with this contents: - | (lang dune ) - Info: Appending this line to dune-project: (using menhir ) + File "dune", line 1, characters 0-25: + 1 | (menhir (modules parser)) + ^^^^^^^^^^^^^^^^^^^^^^^^^ + Error: 'menhir' is available only when menhir is enabled in the dune-project + file. You must enable it using (using menhir ) in your dune-project file. diff --git a/test/blackbox-tests/test-cases/mdx-stanza.t/run.t b/test/blackbox-tests/test-cases/mdx-stanza.t/run.t index f3080229f62..f56e1f21943 100644 --- a/test/blackbox-tests/test-cases/mdx-stanza.t/run.t +++ b/test/blackbox-tests/test-cases/mdx-stanza.t/run.t @@ -7,7 +7,12 @@ dune-project $ dune build @install --root using-mdx/ Entering directory 'using-mdx' - Info: Appending this line to dune-project: (using mdx 0.1) + File "dune", line 1, characters 0-5: + 1 | (mdx) + ^^^^^ + Error: 'mdx' is available only when mdx is enabled in the dune-project file. + You must enable it using (using mdx 0.1) in your dune-project file. + [1] It also requires dune lang 2.4 or higher diff --git a/test/blackbox-tests/test-cases/menhir/env.t/run.t b/test/blackbox-tests/test-cases/menhir/env.t/run.t index 354d32e93b1..c34db846dd2 100644 --- a/test/blackbox-tests/test-cases/menhir/env.t/run.t +++ b/test/blackbox-tests/test-cases/menhir/env.t/run.t @@ -1,4 +1,7 @@ - $ echo "(lang dune 2.2)" > dune-project + $ cat > dune-project < (lang dune 2.2) + > (using menhir 2.1) + > EOF $ cat >dune < (env (_ (menhir_flags :standard "--comment"))) > (menhir @@ -7,5 +10,4 @@ > (library (name test)) > EOF $ dune printenv --field menhir_flags 2>&1 | sed "s/(using menhir .*)/(using menhir )/" - Info: Appending this line to dune-project: (using menhir ) (menhir_flags (--comment)) diff --git a/test/blackbox-tests/test-cases/upgrader.t/run.t b/test/blackbox-tests/test-cases/upgrader.t/run.t index 6460f783432..d2630d4f663 100644 --- a/test/blackbox-tests/test-cases/upgrader.t/run.t +++ b/test/blackbox-tests/test-cases/upgrader.t/run.t @@ -79,9 +79,7 @@ Project in dir partv2/partv1bis will be upgraded to dune v2. Project in dir partv2/partv1 will be upgraded to dune v2. Project in dir . will be upgraded to dune v1. - Info: Creating file dune-project with this contents: - | (lang dune 1.0) - | (name foo) + Creating dune-project... Upgrading foo.opam... Upgrading partv2/partv1/dune.inc... Upgrading partv2/partv1/dune...