Improve error when parsing several licenses (#6114)

* Refactor: add since ?what Signed-off-by: Etienne Millon <me@emillon.org> * Improve error when parsing several licenses Closes #6103 Signed-off-by: Etienne Millon <me@emillon.org>
ocaml · Sep 6, 2022 · e58b375 · e58b375
1 parent 810e3e9
commit e58b375
Show file tree

Hide file tree

Showing 6 changed files with 30 additions and 24 deletions.
diff --git a/CHANGES.md b/CHANGES.md
@@ -42,6 +42,9 @@
 
 - Fix compilation of Dune under esy on Windows (#6109, fixes #6098, @nojb)
 
+- Improve error message when parsing several licenses in `(license)` (#6114,
+  fixes #6103, @emillon)
+
 3.4.1 (26-07-2022)
 ------------------
 

diff --git a/src/dune_engine/package.ml b/src/dune_engine/package.ml
@@ -498,10 +498,14 @@ module Info = struct
         (Dune_lang.Syntax.since Stanza.syntax (v (1, 9)) >>> repeat string)
     and+ license =
       field_o "license"
-        (Dune_lang.Syntax.since Stanza.syntax (v (3, 2))
-        >>> repeat1 string
-        <|> ( Dune_lang.Syntax.since Stanza.syntax (v (1, 9)) >>> string
-            >>| fun s -> [ s ] ))
+        (Dune_lang.Syntax.since Stanza.syntax (v (1, 9))
+        >>> let* l = repeat1 string in
+            (if List.length l > 1 then
+             Dune_lang.Syntax.since ~what:"Parsing several licenses"
+               Stanza.syntax
+               (v (3, 2))
+            else return ())
+            >>> return l)
     and+ homepage =
       field_o "homepage"
         (Dune_lang.Syntax.since Stanza.syntax (v (1, 10)) >>> string)

diff --git a/src/dune_lang/action.ml b/src/dune_lang/action.ml
@@ -215,15 +215,12 @@ let decode =
             and+ xs = repeat sw in
             Echo (x :: xs) )
         ; ( "cat"
-          , let+ x = sw
-            and+ xs = repeat sw
-            and+ version = Syntax.get_exn Stanza.syntax
-            and+ loc = loc in
-            let minimum_version = (3, 4) in
-            if List.is_non_empty xs && version < minimum_version then
-              Syntax.Error.since loc Stanza.syntax minimum_version
-                ~what:"Passing several arguments to 'cat'";
-            Cat (x :: xs) )
+          , let* xs = repeat1 sw in
+            (if List.length xs > 1 then
+             Syntax.since ~what:"Passing several arguments to 'cat'"
+               Stanza.syntax (3, 4)
+            else return ())
+            >>> return (Cat xs) )
         ; ( "copy"
           , let+ src = sw
             and+ dst = sw in

diff --git a/src/dune_sexp/syntax.ml b/src/dune_sexp/syntax.ml
@@ -361,13 +361,13 @@ let renamed_in t ver ~to_ =
     let+ loc, what = desc () in
     Error.renamed_in loc t ver ~what ~to_
 
-let since ?(fatal = true) t ver =
+let since ?what ?(fatal = true) t ver =
   let open Version.Infix in
   let* current_ver = get_exn t in
   if current_ver >= ver then return ()
   else
-    desc () >>= function
-    | loc, what when fatal -> Error.since loc t ver ~what
-    | loc, what ->
-      User_warning.emit ~loc [ Pp.text (Error_msg.since t ver ~what) ];
-      return ()
+    let* loc, what_ctx = desc () in
+    let what = Option.value what ~default:what_ctx in
+    if fatal then Error.since loc t ver ~what
+    else User_warning.emit ~loc [ Pp.text (Error_msg.since t ver ~what) ];
+    return ()
diff --git a/src/dune_sexp/syntax.mli b/src/dune_sexp/syntax.mli
@@ -100,8 +100,9 @@ val renamed_in : t -> Version.t -> to_:string -> (unit, _) Decoder.parser
 
 (** Indicate the field/constructor being parsed was introduced in the given
     version. When [fatal] is false, simply emit a warning instead of error.
-    [fatal] defaults to true. *)
-val since : ?fatal:bool -> t -> Version.t -> (unit, _) Decoder.parser
+    [fatal] defaults to true. [what] allows customizing the error message. *)
+val since :
+  ?what:string -> ?fatal:bool -> t -> Version.t -> (unit, _) Decoder.parser
 
 (** {2 Low-level functions} *)
 

diff --git a/test/blackbox-tests/test-cases/dune-project-meta/main.t/run.t b/test/blackbox-tests/test-cases/dune-project-meta/main.t/run.t
@@ -606,10 +606,11 @@ Reject multiple licences in version [1.9, 3.2)
   > EOF
 
   $ dune build
-  File "dune-project", line 4, characters 13-16:
+  File "dune-project", line 4, characters 0-17:
   4 | (license MIT ISC)
-                   ^^^
-  Error: Too many argument for license
+      ^^^^^^^^^^^^^^^^^
+  Error: Parsing several licenses is only available since version 3.2 of the
+  dune language. Please update your dune-project file to have (lang dune 3.2).
   [1]
 
 Allow multiple licences in version >= 3.2