From e56fba9a57e8b5fe909499a1c4c6e1dfabe796c8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=A9mie=20Dimino?= Date: Tue, 3 Jul 2018 10:10:09 +0100 Subject: [PATCH 1/5] Do not use opam-installer to copy files (#941) Instead of calling opam-installer, manually parse .install files and copy the files. Signed-off-by: Jeremie Dimino --- CHANGES.md | 2 + bin/main.ml | 85 +++++++++++----- src/action.ml | 6 +- src/build_system.ml | 2 +- src/install.ml | 175 ++++++++++++++++++++++++++------- src/install.mli | 37 ++++++- src/install_rules.ml | 13 ++- src/stdune/io.ml | 4 +- src/stdune/io.mli | 2 +- src/stdune/path.ml | 4 +- vendor/boot/opamParserTypes.ml | 61 ++++++++++-- 11 files changed, 303 insertions(+), 88 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 4401941f..427426fe 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -106,6 +106,8 @@ next - Add `%{profile}` variable. (#938, @rgrinberg) +- Do not require opam-installer anymore (#941, @diml) + 1.0+beta20 (10/04/2018) ----------------------- diff --git a/bin/main.ml b/bin/main.ml index b135def1..a248f18a 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -1053,16 +1053,6 @@ let rules = & Arg.info [] ~docv:"TARGET")) , Term.info "rules" ~doc ~man) -let opam_installer () = - match Bin.which "opam-installer" with - | None -> - die "\ -Sorry, you need the opam-installer tool to be able to install or -uninstall packages. - -I couldn't find the opam-installer binary :-(" - | Some fn -> fn - let get_prefix context ~from_command_line = match from_command_line with | Some p -> Fiber.return (Path.of_string p) @@ -1073,6 +1063,16 @@ let get_libdir context ~libdir_from_command_line = | Some p -> Fiber.return (Some (Path.of_string p)) | None -> Context.install_ocaml_libdir context +let print_unix_error f = + try + f () + with Unix.Unix_error (e, _, _) -> + Format.eprintf "@{Error@}: %s@." + (Unix.error_message e) + +let set_executable_bits x = x lor 0o111 +let clear_executable_bits x = x land (lnot 0o111) + let install_uninstall ~what = let doc = sprintf "%s packages using opam-installer." (String.capitalize what) @@ -1080,7 +1080,6 @@ let install_uninstall ~what = let name_ = Arg.info [] ~docv:"PACKAGE" in let go common prefix_from_command_line libdir_from_command_line pkgs = set_common common ~targets:[]; - let opam_installer = opam_installer () in let log = Log.create common in Scheduler.go ~log ~common (Main.setup ~log common >>= fun setup -> @@ -1095,7 +1094,7 @@ let install_uninstall ~what = List.map setup.contexts ~f:(fun ctx -> let fn = Path.append ctx.Context.build_dir fn in if Path.exists fn then - Left (ctx, fn) + Left (ctx, (pkg, fn)) else Right fn)) |> List.partition_map ~f:(fun x -> x) @@ -1121,23 +1120,57 @@ let install_uninstall ~what = in Fiber.parallel_iter install_files_by_context ~f:(fun (context, install_files) -> - let install_files_set = Path.Set.of_list install_files in get_prefix context ~from_command_line:prefix_from_command_line >>= fun prefix -> get_libdir context ~libdir_from_command_line - >>= fun libdir -> - Fiber.parallel_iter install_files ~f:(fun path -> - let purpose = Process.Build_job install_files_set in - Process.run ~purpose ~env:setup.env Strict opam_installer - ([ sprintf "-%c" what.[0] - ; Path.to_string path - ; "--prefix" - ; Path.to_string prefix - ] @ - match libdir with - | None -> [] - | Some p -> [ "--libdir"; Path.to_string p ] - )))) + >>| fun libdir -> + List.iter install_files ~f:(fun (package, path) -> + let entries = Install.load_install_file path in + let paths = + Install.Section.Paths.make + ~package + ~destdir:prefix + ?libdir + () + in + let files_deleted_in = ref Path.Set.empty in + List.iter entries ~f:(fun { Install.Entry. src; dst; section } -> + let src = src in + let dst = Option.value dst ~default:(Path.basename src) in + let dst = + Path.relative (Install.Section.Paths.get paths section) dst + in + let dir = Path.parent_exn dst in + if what = "install" then begin + Printf.eprintf "Installing %s\n%!" + (Path.to_string_maybe_quoted dst); + Path.mkdir_p dir; + Io.copy_file () ~src ~dst + ~chmod:( + if Install.Section.should_set_executable_bit section then + set_executable_bits + else + clear_executable_bits) + end else begin + if Path.exists dst then begin + Printf.eprintf "Deleting %s\n%!" + (Path.to_string_maybe_quoted dst); + print_unix_error (fun () -> Path.unlink dst) + end; + files_deleted_in := Path.Set.add !files_deleted_in dir; + end; + Path.Set.to_list !files_deleted_in + (* This [List.rev] is to ensure we process children + directories before their parents *) + |> List.rev + |> List.iter ~f:(fun dir -> + if Path.exists dir then + match Path.readdir_unsorted dir with + | [] -> + Printf.eprintf "Deleting empty directory %s\n%!" + (Path.to_string_maybe_quoted dst); + print_unix_error (fun () -> Path.rmdir dir) + | _ -> ()))))) in ( Term.(const go $ common diff --git a/src/action.ml b/src/action.ml index 0f68ebe5..fbf63064 100644 --- a/src/action.ml +++ b/src/action.ml @@ -637,7 +637,7 @@ module Promotion = struct Format.eprintf "Promoting %s to %s.@." (Path.to_string_maybe_quoted src) (Path.to_string_maybe_quoted dst); - Io.copy_file ~src ~dst + Io.copy_file ~src ~dst () end module P = Utils.Persistent(struct @@ -785,11 +785,11 @@ let rec exec t ~ectx ~dir ~env ~stdout_to ~stderr_to = Io.copy_channels ic oc); Fiber.return () | Copy (src, dst) -> - Io.copy_file ~src ~dst; + Io.copy_file ~src ~dst (); Fiber.return () | Symlink (src, dst) -> if Sys.win32 then - Io.copy_file ~src ~dst + Io.copy_file ~src ~dst () else begin let src = match Path.parent dst with diff --git a/src/build_system.ml b/src/build_system.ml index ea71d66d..95aa1ac1 100644 --- a/src/build_system.ml +++ b/src/build_system.ml @@ -826,7 +826,7 @@ let rec compile_rule t ?(copy_source=false) pre_rule = Utils.Cached_digest.file in_source_tree) then begin if mode = Promote_but_delete_on_clean then Promoted_to_delete.add in_source_tree; - Io.copy_file ~src:path ~dst:in_source_tree + Io.copy_file ~src:path ~dst:in_source_tree () end) end; t.hook Rule_completed diff --git a/src/install.ml b/src/install.ml index ccccae6d..40ab01d1 100644 --- a/src/install.ml +++ b/src/install.ml @@ -31,6 +31,21 @@ module Section = struct | Man -> "man" | Misc -> "misc" + let of_string = function + | "lib" -> Some Lib + | "libexec" -> Some Libexec + | "bin" -> Some Bin + | "sbin" -> Some Sbin + | "toplevel" -> Some Toplevel + | "share" -> Some Share + | "share_root" -> Some Share_root + | "etc" -> Some Etc + | "doc" -> Some Doc + | "stublibs" -> Some Stublibs + | "man" -> Some Man + | "misc" -> Some Misc + | _ -> None + let t = let open Sexp.Of_sexp in enum @@ -48,35 +63,65 @@ module Section = struct ; "misc" , Misc ] - module Paths = struct - let lib = Path.in_source "lib" - let libexec = Path.in_source "lib" - let bin = Path.in_source "bin" - let sbin = Path.in_source "sbin" - let toplevel = Path.in_source "lib/toplevel" - let share = Path.in_source "share" - let share_root = Path.in_source "share_root" - let etc = Path.in_source "etc" - let doc = Path.in_source "doc" - let stublibs = Path.in_source "lib/stublibs" - let man = Path.in_source "man" - end + let should_set_executable_bit = function + | Lib -> false + | Libexec -> true + | Bin -> true + | Sbin -> true + | Toplevel -> false + | Share -> false + | Share_root -> false + | Etc -> false + | Doc -> false + | Stublibs -> true + | Man -> false + | Misc -> false - let install_dir t ~(package : Package.Name.t) = - let package = Package.Name.to_string package in - match t with - | Bin -> Paths.bin - | Sbin -> Paths.sbin - | Toplevel -> Paths.toplevel - | Share_root -> Paths.share_root - | Stublibs -> Paths.stublibs - | Man -> Paths.man - | Lib -> Path.relative Paths.lib package - | Libexec -> Path.relative Paths.libexec package - | Share -> Path.relative Paths.share package - | Etc -> Path.relative Paths.etc package - | Doc -> Path.relative Paths.doc package - | Misc -> invalid_arg "Install.Section.install_dir" + module Paths = struct + type t = + { lib : Path.t + ; libexec : Path.t + ; bin : Path.t + ; sbin : Path.t + ; toplevel : Path.t + ; share : Path.t + ; share_root : Path.t + ; etc : Path.t + ; doc : Path.t + ; stublibs : Path.t + ; man : Path.t + } + + let make ~package ~destdir ?(libdir=Path.relative destdir "lib") () = + let package = Package.Name.to_string package in + { bin = Path.relative destdir "bin" + ; sbin = Path.relative destdir "sbin" + ; toplevel = Path.relative libdir "toplevel" + ; share_root = Path.relative libdir "share" + ; stublibs = Path.relative libdir "lib/stublibs" + ; man = Path.relative destdir "man" + ; lib = Path.relative libdir package + ; libexec = Path.relative libdir package + ; share = Path.relative destdir ("share/" ^ package) + ; etc = Path.relative destdir ("etc/" ^ package) + ; doc = Path.relative destdir ("doc/" ^ package) + } + + let get t section = + match section with + | Lib -> t.lib + | Libexec -> t.libexec + | Bin -> t.bin + | Sbin -> t.sbin + | Toplevel -> t.toplevel + | Share -> t.share + | Share_root -> t.share_root + | Etc -> t.etc + | Doc -> t.doc + | Stublibs -> t.stublibs + | Man -> t.man + | Misc -> invalid_arg "Install.Paths.get" + end end module Entry = struct @@ -112,8 +157,8 @@ module Entry = struct let set_src t src = { t with src } - let relative_installed_path t ~package = - let main_dir = Section.install_dir t.section ~package in + let relative_installed_path t ~paths = + let main_dir = Section.Paths.get paths t.section in let dst = match t.dst with | Some x -> x @@ -129,15 +174,14 @@ module Entry = struct in Path.relative main_dir dst - let add_install_prefix t ~package ~prefix = - let opam_will_install_in_this_dir = - Section.install_dir t.section ~package - in + let add_install_prefix t ~paths ~prefix = + let opam_will_install_in_this_dir = Section.Paths.get paths t.section in let i_want_to_install_the_file_as = - Path.append prefix (relative_installed_path t ~package) + Path.append prefix (relative_installed_path t ~paths) in let dst = - Path.reach i_want_to_install_the_file_as ~from:opam_will_install_in_this_dir + Path.reach i_want_to_install_the_file_as + ~from:opam_will_install_in_this_dir in { t with dst = Some dst } end @@ -165,3 +209,62 @@ let gen_install_file entries = | Some dst -> pr " %S {%S}" src dst); pr "]"); Buffer.contents buf + +let pos_of_opam_value : OpamParserTypes.value -> OpamParserTypes.pos = function + | Bool (pos, _) -> pos + | Int (pos, _) -> pos + | String (pos, _) -> pos + | Relop (pos, _, _, _) -> pos + | Prefix_relop (pos, _, _) -> pos + | Logop (pos, _, _, _) -> pos + | Pfxop (pos, _, _) -> pos + | Ident (pos, _) -> pos + | List (pos, _) -> pos + | Group (pos, _) -> pos + | Option (pos, _, _) -> pos + | Env_binding (pos, _, _, _) -> pos + +let load_install_file path = + let open OpamParserTypes in + let file = Opam_file.load path in + let fail (fname, line, col) fmt = + let pos : Lexing.position = + { pos_fname = fname + ; pos_lnum = line + ; pos_bol = 0 + ; pos_cnum = col + } + in + Loc.fail { start = pos; stop = pos } fmt + in + List.concat_map file.file_contents ~f:(function + | Variable (pos, section, files) -> begin + match Section.of_string section with + | None -> fail pos "Unknown install section" + | Some section -> begin + match files with + | List (_, l) -> + List.map l ~f:(function + | String (_, src) -> + { Entry. + src = Path.of_string src + ; dst = None + ; section + } + | Option (_, String (_, src), + [String (_, dst)]) -> + { Entry. + src = Path.of_string src + ; dst = Some dst + ; section + } + | v -> + fail (pos_of_opam_value v) + "Invalid value in .install file") + | v -> + fail (pos_of_opam_value v) + "Invalid value for install section" + end + end + | Section (pos, _) -> + fail pos "Sections are not allowed in .install file") diff --git a/src/install.mli b/src/install.mli index 225b0442..6d7f120d 100644 --- a/src/install.mli +++ b/src/install.mli @@ -18,6 +18,37 @@ module Section : sig | Misc val t : t Sexp.Of_sexp.t + + (** [true] iff the executable bit should be set for files installed + in this location. *) + val should_set_executable_bit : t -> bool + + module Paths : sig + type section = t + + type t = + { lib : Path.t + ; libexec : Path.t + ; bin : Path.t + ; sbin : Path.t + ; toplevel : Path.t + ; share : Path.t + ; share_root : Path.t + ; etc : Path.t + ; doc : Path.t + ; stublibs : Path.t + ; man : Path.t + } + + val make + : package:Package.Name.t + -> destdir:Path.t + -> ?libdir:Path.t + -> unit + -> t + + val get : t -> section -> Path.t + end with type section := t end module Entry : sig @@ -30,9 +61,11 @@ module Entry : sig val make : Section.t -> ?dst:string -> Path.t -> t val set_src : t -> Path.t -> t - val relative_installed_path : t -> package:Package.Name.t -> Path.t - val add_install_prefix : t -> package:Package.Name.t -> prefix:Path.t -> t + val relative_installed_path : t -> paths:Section.Paths.t -> Path.t + val add_install_prefix : t -> paths:Section.Paths.t -> prefix:Path.t -> t end val files : Entry.t list -> Path.Set.t val gen_install_file : Entry.t list -> string + +val load_install_file : Path.t -> Entry.t list diff --git a/src/install_rules.ml b/src/install_rules.ml index 3c679e40..44625876 100644 --- a/src/install_rules.ml +++ b/src/install_rules.ml @@ -216,12 +216,13 @@ module Gen(P : Install_params) = struct List.exists [ "README"; "LICENSE"; "CHANGE"; "HISTORY"] ~f:(fun prefix -> String.is_prefix fn ~prefix) - let local_install_rules (entries : Install.Entry.t list) ~package = + let local_install_rules (entries : Install.Entry.t list) + ~install_paths ~package = let install_dir = Config.local_install_dir ~context:ctx.name in List.map entries ~f:(fun entry -> let dst = Path.append install_dir - (Install.Entry.relative_installed_path entry ~package) + (Install.Entry.relative_installed_path entry ~paths:install_paths) in Build_system.set_package (SC.build_system sctx) entry.src package; SC.add_rule sctx (Build.symlink ~src:entry.src ~dst); @@ -255,7 +256,10 @@ module Gen(P : Install_params) = struct Path.relative (Path.append ctx.build_dir package_path) (Utils.install_file ~package ~findlib_toolchain:ctx.findlib_toolchain) in - let entries = local_install_rules entries ~package in + let install_paths = + Install.Section.Paths.make ~package ~destdir:Path.root () + in + let entries = local_install_rules entries ~package ~install_paths in let files = Install.files entries in SC.add_alias_deps sctx (Alias.package_install ~context:ctx ~pkg:package) @@ -284,7 +288,8 @@ module Gen(P : Install_params) = struct | Some toolchain -> let prefix = Path.of_string (toolchain ^ "-sysroot") in List.map entries - ~f:(Install.Entry.add_install_prefix ~prefix ~package) + ~f:(Install.Entry.add_install_prefix + ~paths:install_paths ~prefix) in Install.gen_install_file entries) >>> diff --git a/src/stdune/io.ml b/src/stdune/io.ml index faaf865c..1a5bcb34 100644 --- a/src/stdune/io.ml +++ b/src/stdune/io.ml @@ -66,9 +66,9 @@ let copy_channels = in loop -let copy_file ~src ~dst = +let copy_file ?(chmod=fun x -> x) ~src ~dst () = with_file_in src ~f:(fun ic -> - let perm = (Unix.fstat (Unix.descr_of_in_channel ic)).st_perm in + let perm = (Unix.fstat (Unix.descr_of_in_channel ic)).st_perm |> chmod in Exn.protectx (P.open_out_gen [Open_wronly; Open_creat; Open_trunc; Open_binary] perm diff --git a/src/stdune/io.mli b/src/stdune/io.mli index 3b4a85f0..c236b3b1 100644 --- a/src/stdune/io.mli +++ b/src/stdune/io.mli @@ -23,7 +23,7 @@ val write_lines : Path.t -> string list -> unit val copy_channels : in_channel -> out_channel -> unit -val copy_file : src:Path.t -> dst:Path.t -> unit +val copy_file : ?chmod:(int -> int) -> src:Path.t -> dst:Path.t -> unit -> unit val read_all : in_channel -> string diff --git a/src/stdune/path.ml b/src/stdune/path.ml index 3fba5483..c8c00eaa 100644 --- a/src/stdune/path.ml +++ b/src/stdune/path.ml @@ -874,9 +874,7 @@ let rm_rf = | _ -> loop fn let mkdir_p = function - | External s -> - Exn.code_error "Path.mkdir_p cannot create external path" - ["s", External.sexp_of_t s] + | External s -> External.mkdir_p s | In_source_tree s -> Exn.code_error "Path.mkdir_p cannot dir in source" ["s", Local.sexp_of_t s] diff --git a/vendor/boot/opamParserTypes.ml b/vendor/boot/opamParserTypes.ml index 668f388c..02b8a5cf 100644 --- a/vendor/boot/opamParserTypes.ml +++ b/vendor/boot/opamParserTypes.ml @@ -1,13 +1,54 @@ +(**************************************************************************) +(* *) +(* Copyright 2012-2015 OCamlPro *) +(* Copyright 2012 INRIA *) +(* *) +(* All rights reserved. This file is distributed under the terms of the *) +(* GNU Lesser General Public License version 2.1, with the special *) +(* exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +type relop = [ `Eq | `Neq | `Geq | `Gt | `Leq | `Lt ] +type logop = [ `And | `Or ] +type pfxop = [ `Not ] + +type file_name = string + +(** Source file positions: filename, line, column *) +type pos = file_name * int * int + +type env_update_op = Eq | PlusEq | EqPlus | ColonEq | EqColon | EqPlusEq + +(** Base values *) type value = - | String of unit * string - | List of unit * value list - | Other + | Bool of pos * bool + | Int of pos * int + | String of pos * string + | Relop of pos * relop * value * value + | Prefix_relop of pos * relop * value + | Logop of pos * logop * value * value + | Pfxop of pos * pfxop * value + | Ident of pos * string + | List of pos * value list + | Group of pos * value list + | Option of pos * value * value list + | Env_binding of pos * value * env_update_op * value -type opamfile_item = - | Variable of unit * string * value - | Other +(** An opamfile section *) +type opamfile_section = { + section_kind : string; + section_name : string option; + section_items : opamfile_item list; +} -type opamfile = - { file_contents : opamfile_item list - ; file_name : string - } +(** An opamfile is composed of sections and variable definitions *) +and opamfile_item = + | Section of pos * opamfile_section + | Variable of pos * string * value + +(** A file is a list of items and the filename *) +type opamfile = { + file_contents: opamfile_item list; + file_name : file_name; +} From dee6c9aa96e21267010176d46226cf73a67c0967 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Tue, 3 Jul 2018 00:27:39 +0700 Subject: [PATCH 2/5] Disable fallback in dune files Signed-off-by: Rudi Grinberg --- src/jbuild.ml | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/jbuild.ml b/src/jbuild.ml index 7b460de3..e6e6c150 100644 --- a/src/jbuild.ml +++ b/src/jbuild.ml @@ -1130,6 +1130,10 @@ module Rule = struct field "locks" (list String_with_vars.t) ~default:[] >>= fun locks -> map_validate (field_b "fallback" >>= fun fallback -> + (if fallback then + Syntax.renamed_in Stanza.syntax (1, 0) ~to_:"(mode fallback)" + else + return ()) >>= fun () -> field_o "mode" Mode.t >>= fun mode -> return (fallback, mode)) ~f:(function From aee019577be0a32685d784de2f4da148e5540cb2 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Tue, 3 Jul 2018 13:54:42 +0700 Subject: [PATCH 3/5] Change fallback check to use ?check param Signed-off-by: Rudi Grinberg --- src/jbuild.ml | 8 +++----- src/stdune/sexp.ml | 5 +++-- src/stdune/sexp.mli | 2 +- 3 files changed, 7 insertions(+), 8 deletions(-) diff --git a/src/jbuild.ml b/src/jbuild.ml index e6e6c150..9a2c780d 100644 --- a/src/jbuild.ml +++ b/src/jbuild.ml @@ -1129,11 +1129,9 @@ module Rule = struct field "deps" (list Dep_conf.t) ~default:[] >>= fun deps -> field "locks" (list String_with_vars.t) ~default:[] >>= fun locks -> map_validate - (field_b "fallback" >>= fun fallback -> - (if fallback then - Syntax.renamed_in Stanza.syntax (1, 0) ~to_:"(mode fallback)" - else - return ()) >>= fun () -> + (field_b + ~check:(Syntax.renamed_in Stanza.syntax (1, 0) ~to_:"(mode fallback)") + "fallback" >>= fun fallback -> field_o "mode" Mode.t >>= fun mode -> return (fallback, mode)) ~f:(function diff --git a/src/stdune/sexp.ml b/src/stdune/sexp.ml index 4ef365ff..e98d1886 100644 --- a/src/stdune/sexp.ml +++ b/src/stdune/sexp.ml @@ -481,9 +481,10 @@ module Of_sexp = struct | None -> (None, add_known name state) - let field_b name = + let field_b ?check name = field name ~default:false - (eos >>= function + (Option.value check ~default:(return ()) >>= fun () -> + eos >>= function | true -> return true | _ -> bool) diff --git a/src/stdune/sexp.mli b/src/stdune/sexp.mli index f1f62e3b..6c147db1 100644 --- a/src/stdune/sexp.mli +++ b/src/stdune/sexp.mli @@ -216,7 +216,7 @@ module Of_sexp : sig -> 'a t -> 'a option fields_parser - val field_b : string -> bool fields_parser + val field_b : ?check:(unit t) -> string -> bool fields_parser (** A field that can appear multiple times *) val multi_field From 8b5e1a9a1324edc216aef6927a4adc2ecc59544f Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Tue, 3 Jul 2018 13:54:54 +0700 Subject: [PATCH 4/5] Add tests for fallback Signed-off-by: Rudi Grinberg --- test/blackbox-tests/dune.inc | 10 ++++++++++ .../test-cases/fallback-dune/dune1/dune | 4 ++++ .../test-cases/fallback-dune/dune2/dune | 4 ++++ .../test-cases/fallback-dune/jbuild/jbuild | 5 +++++ .../test-cases/fallback-dune/run.t | 20 +++++++++++++++++++ 5 files changed, 43 insertions(+) create mode 100644 test/blackbox-tests/test-cases/fallback-dune/dune1/dune create mode 100644 test/blackbox-tests/test-cases/fallback-dune/dune2/dune create mode 100644 test/blackbox-tests/test-cases/fallback-dune/jbuild/jbuild create mode 100644 test/blackbox-tests/test-cases/fallback-dune/run.t diff --git a/test/blackbox-tests/dune.inc b/test/blackbox-tests/dune.inc index 28390f9e..efcea69d 100644 --- a/test/blackbox-tests/dune.inc +++ b/test/blackbox-tests/dune.inc @@ -128,6 +128,14 @@ test-cases/exec-cmd (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) +(alias + (name fallback-dune) + (deps (package dune) (source_tree test-cases/fallback-dune)) + (action + (chdir + test-cases/fallback-dune + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (alias (name findlib) (deps (package dune) (source_tree test-cases/findlib)) @@ -606,6 +614,7 @@ (alias env) (alias exclude-missing-module) (alias exec-cmd) + (alias fallback-dune) (alias findlib) (alias findlib-error) (alias force-test) @@ -678,6 +687,7 @@ (alias env) (alias exclude-missing-module) (alias exec-cmd) + (alias fallback-dune) (alias findlib) (alias findlib-error) (alias force-test) diff --git a/test/blackbox-tests/test-cases/fallback-dune/dune1/dune b/test/blackbox-tests/test-cases/fallback-dune/dune1/dune new file mode 100644 index 00000000..020ea118 --- /dev/null +++ b/test/blackbox-tests/test-cases/fallback-dune/dune1/dune @@ -0,0 +1,4 @@ +(rule + (fallback) + (targets) + (action (with-stdout-to foo.txt (echo "testing")))) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/fallback-dune/dune2/dune b/test/blackbox-tests/test-cases/fallback-dune/dune2/dune new file mode 100644 index 00000000..fdf0a419 --- /dev/null +++ b/test/blackbox-tests/test-cases/fallback-dune/dune2/dune @@ -0,0 +1,4 @@ +(rule + (fallback false) + (targets) + (action (with-stdout-to foo.txt (echo "testing")))) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/fallback-dune/jbuild/jbuild b/test/blackbox-tests/test-cases/fallback-dune/jbuild/jbuild new file mode 100644 index 00000000..9792612a --- /dev/null +++ b/test/blackbox-tests/test-cases/fallback-dune/jbuild/jbuild @@ -0,0 +1,5 @@ + +(rule + ((fallback) + (targets (foo.txt)) + (action (with-stdout-to foo.txt (echo "testing"))))) diff --git a/test/blackbox-tests/test-cases/fallback-dune/run.t b/test/blackbox-tests/test-cases/fallback-dune/run.t new file mode 100644 index 00000000..27b03976 --- /dev/null +++ b/test/blackbox-tests/test-cases/fallback-dune/run.t @@ -0,0 +1,20 @@ +fallback isn't allowed in dune + + $ dune build --root dune1 + Info: creating file dune-project with this contents: (lang dune 1.0) + File "dune", line 2, characters 1-11: + Error: 'fallback' was renamed to '(mode fallback)' in 1.0 of the dune language + [1] + +2nd fallback form isn't allowed either + + $ dune build --root dune2 + Info: creating file dune-project with this contents: (lang dune 1.0) + File "dune", line 2, characters 1-17: + Error: 'fallback' was renamed to '(mode fallback)' in 1.0 of the dune language + [1] + +But it is allowed in jbuilder + + $ jbuilder build --root jbuild + Entering directory 'jbuild' From 8e09749f12382d793721d513a47c24008ecbbf8d Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Tue, 3 Jul 2018 16:11:29 +0700 Subject: [PATCH 5/5] Add missing words to syntax error message Signed-off-by: Rudi Grinberg --- src/syntax.ml | 2 +- test/blackbox-tests/test-cases/fallback-dune/run.t | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/syntax.ml b/src/syntax.ml index dae362fa..8a95138c 100644 --- a/src/syntax.ml +++ b/src/syntax.ml @@ -124,7 +124,7 @@ let renamed_in t ver ~to_ = else begin desc () >>= fun (loc, what) -> Loc.fail loc - "%s was renamed to '%s' in %s of %s" what to_ + "%s was renamed to '%s' in the %s version of %s" what to_ (Version.to_string ver) t.desc end diff --git a/test/blackbox-tests/test-cases/fallback-dune/run.t b/test/blackbox-tests/test-cases/fallback-dune/run.t index 27b03976..d2580573 100644 --- a/test/blackbox-tests/test-cases/fallback-dune/run.t +++ b/test/blackbox-tests/test-cases/fallback-dune/run.t @@ -3,7 +3,7 @@ fallback isn't allowed in dune $ dune build --root dune1 Info: creating file dune-project with this contents: (lang dune 1.0) File "dune", line 2, characters 1-11: - Error: 'fallback' was renamed to '(mode fallback)' in 1.0 of the dune language + Error: 'fallback' was renamed to '(mode fallback)' in the 1.0 version of the dune language [1] 2nd fallback form isn't allowed either @@ -11,7 +11,7 @@ fallback isn't allowed in dune $ dune build --root dune2 Info: creating file dune-project with this contents: (lang dune 1.0) File "dune", line 2, characters 1-17: - Error: 'fallback' was renamed to '(mode fallback)' in 1.0 of the dune language + Error: 'fallback' was renamed to '(mode fallback)' in the 1.0 version of the dune language [1] But it is allowed in jbuilder