diff --git a/src/jbuild.ml b/src/jbuild.ml index 1f250a06..db050cb4 100644 --- a/src/jbuild.ml +++ b/src/jbuild.ml @@ -262,21 +262,16 @@ module Named = struct let t elem = let binding = peek_exn >>= function - | Atom (loc, A s) when String.length s > 1 && s.[0] = ':' -> - begin - string >>= fun name -> - peek >>= function - | None -> of_sexp_errorf loc "Naked binding %s" s - | Some _ -> - elem >>| fun elem -> - Left (name, (loc, elem)) - end + | List (_, Atom (loc, A s) :: _) when + String.length s > 1 && s.[0] = ':' -> + binding elem >>| fun (name, values) -> + Left (name, (loc, values)) | _ -> elem >>| fun elem -> Right elem in list binding >>| (fun bindings -> let (named, unnamed) = List.partition_map bindings ~f:(fun x -> x) in - { unnamed = List.flatten unnamed + { unnamed ; named = (match String.Map.of_list named with | Ok x -> x @@ -331,15 +326,6 @@ module Dep_conf = struct let t = make_dep_parser ~single:(fun x -> x) ~many:(sum dep_cons) - let bindings = - let dep = - make_dep_parser ~single:List.singleton ~many:( - ("list", repeat t) - :: List.map dep_cons ~f:(fun (n, d) -> (n, d >>| List.singleton)) - |> sum) - in - Named.t dep - open Sexp let sexp_of_t = function | File t -> @@ -1202,7 +1188,7 @@ module Rule = struct >>= fun action -> field "targets" (list file_in_current_dir) >>= fun targets -> - field "deps" Dep_conf.bindings ~default:Named.empty + field "deps" (Named.t Dep_conf.t) ~default:Named.empty >>= fun deps -> field "locks" (list String_with_vars.t) ~default:[] >>= fun locks -> map_validate @@ -1421,7 +1407,7 @@ module Alias_conf = struct field_o "package" Pkg.t >>= fun package -> field_o "action" (located Action.Unexpanded.t) >>= fun action -> field "locks" (list String_with_vars.t) ~default:[] >>= fun locks -> - field "deps" Dep_conf.bindings ~default:Named.empty + field "deps" (Named.t Dep_conf.t) ~default:Named.empty >>= fun deps -> return { name @@ -1445,7 +1431,7 @@ module Tests = struct (Buildable.t >>= fun buildable -> field_oslu "link_flags" >>= fun link_flags -> names >>= fun names -> - field "deps" Dep_conf.bindings ~default:Named.empty >>= fun deps -> + field "deps" (Named.t Dep_conf.t) ~default:Named.empty >>= fun deps -> field_o "package" Pkg.t >>= fun package -> field "locks" (list String_with_vars.t) ~default:[] >>= fun locks -> field "modes" Executables.Link_mode.Set.t diff --git a/src/stdune/sexp.ml b/src/stdune/sexp.ml index 01134809..651e4688 100644 --- a/src/stdune/sexp.ml +++ b/src/stdune/sexp.ml @@ -380,6 +380,26 @@ module Of_sexp = struct } "Unknown constructor %s" name + let binding t = + let t name = repeat t >>| fun t -> (name, t) in + next_with_user_context (fun uc sexp -> + match sexp with + | Atom (loc, A s) -> + let ctx = Values (loc, Some s, uc) in + result ctx (t s ctx []) + | Template { loc; _ } + | Quoted_string (loc, _) -> + of_sexp_error loc "Atom expected" + | List (loc, []) -> + of_sexp_error loc "Non-empty list expected" + | List (loc, name :: args) -> + match name with + | Quoted_string (loc, _) | List (loc, _) | Template { loc; _ } -> + of_sexp_error loc "Atom expected" + | Atom (s_loc, A s) -> + let ctx loc = Values (loc, Some s, uc) in + result (ctx s_loc) (t s (ctx loc) args)) + let sum cstrs = next_with_user_context (fun uc sexp -> match sexp with diff --git a/src/stdune/sexp.mli b/src/stdune/sexp.mli index 948a3d80..de2aa7ee 100644 --- a/src/stdune/sexp.mli +++ b/src/stdune/sexp.mli @@ -201,6 +201,8 @@ module Of_sexp : sig list parser. *) val sum : (string * 'a t) list -> 'a t + val binding : 'a t -> (string * ('a list)) t + (** Check the result of a list parser, and raise a properly located error in case of failure. *) val map_validate diff --git a/test/blackbox-tests/test-cases/dep-vars/dune b/test/blackbox-tests/test-cases/dep-vars/dune index cd26888c..96a8945f 100644 --- a/test/blackbox-tests/test-cases/dep-vars/dune +++ b/test/blackbox-tests/test-cases/dep-vars/dune @@ -1,5 +1,5 @@ (rule - (deps :foo (list a b) :baz foo (list (alias test)) (list a b c)) + (deps (:foo a b) (:baz foo (alias test)) a b c) (targets bar) (action (with-stdout-to bar (echo "foo")))) diff --git a/test/blackbox-tests/test-cases/merlin-tests/run.t b/test/blackbox-tests/test-cases/merlin-tests/run.t index 91b53db1..b1659de9 100644 --- a/test/blackbox-tests/test-cases/merlin-tests/run.t +++ b/test/blackbox-tests/test-cases/merlin-tests/run.t @@ -4,18 +4,6 @@ ocamlopt sanitize-dot-merlin/.sanitize_dot_merlin.eobjs/sanitize_dot_merlin.{cmx,o} ocamlopt sanitize-dot-merlin/sanitize_dot_merlin.exe sanitize_dot_merlin alias print-merlins - # Processing exe/.merlin - B $LIB_PREFIX/lib/bytes - B $LIB_PREFIX/lib/findlib - B $LIB_PREFIX/lib/ocaml - B ../_build/default/exe/.x.eobjs - B ../_build/default/lib/.foo.objs - S $LIB_PREFIX/lib/bytes - S $LIB_PREFIX/lib/findlib - S $LIB_PREFIX/lib/ocaml - S . - S ../lib - FLG -w -40 # Processing lib/.merlin B $LIB_PREFIX/lib/bytes B $LIB_PREFIX/lib/findlib @@ -28,6 +16,18 @@ S . FLG -ppx '$PPX/fooppx@./ppx.exe --as-ppx --cookie '\''library-name="foo"'\''' FLG -open Foo -w -40 -open Bar -w -40 + # Processing exe/.merlin + B $LIB_PREFIX/lib/bytes + B $LIB_PREFIX/lib/findlib + B $LIB_PREFIX/lib/ocaml + B ../_build/default/exe/.x.eobjs + B ../_build/default/lib/.foo.objs + S $LIB_PREFIX/lib/bytes + S $LIB_PREFIX/lib/findlib + S $LIB_PREFIX/lib/ocaml + S . + S ../lib + FLG -w -40 Make sure a ppx directive is generated diff --git a/test/blackbox-tests/test-cases/misc/run.t b/test/blackbox-tests/test-cases/misc/run.t index 4b02d83e..0cc002ad 100644 --- a/test/blackbox-tests/test-cases/misc/run.t +++ b/test/blackbox-tests/test-cases/misc/run.t @@ -2,5 +2,22 @@ File "dune", line 44, characters 19-42: Warning: Directory dir-that-doesnt-exist doesn't exist. diff alias runtest - diff alias runtest - diff alias runtest + diff alias runtest (exit 1) + (cd _build/default && /usr/bin/diff -u result expected) + --- result 2018-07-09 21:13:11.000000000 +0700 + +++ expected 2018-07-09 21:13:11.000000000 +0700 + @@ -1 +1 @@ + -c.txt b.txt a.txt dune + \ No newline at end of file + +dune a.txt b.txt c.txt + \ No newline at end of file + diff alias runtest (exit 1) + (cd _build/default && /usr/bin/diff -u result2 expected2) + --- result2 2018-07-09 21:13:11.000000000 +0700 + +++ expected2 2018-07-09 21:13:11.000000000 +0700 + @@ -1 +1 @@ + -sub-tree/dir/b sub-tree/a + \ No newline at end of file + +sub-tree/a sub-tree/dir/b + \ No newline at end of file + [1]