Fix after review

Signed-off-by: ArthurW <[email protected]>
ocaml · Jan 16, 2025 · 4a0eb43 · 4a0eb43
1 parent e491be8
commit 4a0eb43
Show file tree

Hide file tree

Showing 3 changed files with 116 additions and 34 deletions.
diff --git a/doc/changes/11308.md b/doc/changes/11308.md
@@ -0,0 +1 @@
+- Validate opam `maintenance_intent` (#11308, @art-w)
diff --git a/src/dune_lang/package_info.ml b/src/dune_lang/package_info.ml
@@ -109,45 +109,59 @@ let encode_fields
     ]
 ;;
 
+let maintenance_intent_list = [ "any"; "latest"; "none" ]
+
+let rec pp_or_list () = function
+  | [] -> ""
+  | [ x ] -> x
+  | [ x; y ] -> sprintf "%S or %S" x y
+  | x :: xs -> sprintf "%S, %a" x pp_or_list xs
+;;
+
 let valid_maintenance_intent =
   let open Decoder in
   map_validate (located string) ~f:(fun (loc, str) ->
-    let rec loop i =
+    let rec parse_part i =
       if i >= String.length str
-      then Ok ()
+      then if i > 0 then Error "version ends with a dot" else Error "empty version"
       else (
         match str.[i] with
-        | '.' -> after_dot (i + 1)
-        | '(' | ')' -> Error "unexpected parenthesis"
-        | _ -> loop (i + 1))
-    and after_dot i =
+        | '(' -> parse_token (i + 1) (i + 1)
+        | '.' -> Error "unexpected dot"
+        | _ -> inside_part (i + 1))
+    and inside_part i =
       if i >= String.length str
-      then Error "version ends with a dot"
+      then Ok ()
       else (
         match str.[i] with
-        | '(' -> parse_token (i + 1) (i + 1)
-        | '.' -> Error "unexpected dot"
-        | _ -> loop (i + 1))
+        | '.' -> parse_part (i + 1)
+        | '(' | ')' -> Error "unexpected parenthesis"
+        | _ -> inside_part (i + 1))
     and parse_token start i =
       if i >= String.length str
       then Error "unclosed parenthesis"
       else (
         match str.[i] with
         | ')' ->
           let token = String.sub str ~pos:start ~len:(i - start) in
-          if List.mem ~equal:String.equal [ "any"; "latest"; "none" ] token
+          if List.mem ~equal:String.equal maintenance_intent_list token
           then after_token (i + 1)
           else
-            Error (Printf.sprintf "unknown intent %S, expected any, latest or none" token)
+            Error
+              (sprintf
+                 "unknown intent %S, expected %a"
+                 token
+                 pp_or_list
+                 maintenance_intent_list)
         | '-' ->
           let token = String.sub str ~pos:start ~len:(i - start) in
           if String.equal token "latest"
           then parse_num (i + 1) (i + 1)
-          else Error (Printf.sprintf "substraction only allowed for latest, not %S" token)
+          else Error (sprintf "substraction only allowed for \"latest\", not %S" token)
         | _ -> parse_token start (i + 1))
     and parse_num start i =
       if i >= String.length str
-      then Error ""
+      then Error "unclosed parenthesis"
       else (
         match str.[i] with
         | ')' when i > start -> after_token (i + 1)
@@ -160,10 +174,10 @@ let valid_maintenance_intent =
       then Ok ()
       else (
         match str.[i] with
-        | '.' -> after_dot (i + 1)
+        | '.' -> parse_part (i + 1)
         | _ -> Error "missing dot after intent")
     in
-    match after_dot 0 with
+    match parse_part 0 with
     | Ok () -> Ok str
     | Error msg -> Error (User_error.make ~loc [ Pp.text msg ]))
 ;;

diff --git a/test/blackbox-tests/test-cases/opam-maintenance-intent.t b/test/blackbox-tests/test-cases/opam-maintenance-intent.t
@@ -60,114 +60,181 @@ numbers, possibly using the special keywords (latest), (any) and (none):
 
 The following are all invalid maintenance intents:
 
-  $ echo '(lang dune 3.18)\n(maintenance_intent "(latest")' >dune-project
+  $ cat >dune-project <<EOF
+  > (lang dune 3.18)
+  > (maintenance_intent "")
+  > EOF
+  $ dune build
+  File "dune-project", line 2, characters 20-22:
+  2 | (maintenance_intent "")
+                          ^^
+  Error: empty version
+  [1]
+
+  $ cat >dune-project <<EOF
+  > (lang dune 3.18)
+  > (maintenance_intent "(latest")
+  > EOF
   $ dune build
   File "dune-project", line 2, characters 20-29:
   2 | (maintenance_intent "(latest")
                           ^^^^^^^^^
   Error: unclosed parenthesis
   [1]
 
-  $ echo '(lang dune 3.18)\n(maintenance_intent ").1")' >dune-project
+  $ cat >dune-project <<EOF
+  > (lang dune 3.18)
+  > (maintenance_intent ").1")
+  > EOF
   $ dune build
 
-  $ echo '(lang dune 3.18)\n(maintenance_intent ".1")' >dune-project
+  $ cat >dune-project <<EOF
+  > (lang dune 3.18)
+  > (maintenance_intent ".1")
+  > EOF
   $ dune build
   File "dune-project", line 2, characters 20-24:
   2 | (maintenance_intent ".1")
                           ^^^^
   Error: unexpected dot
   [1]
 
-  $ echo '(lang dune 3.18)\n(maintenance_intent "1.2.")' >dune-project
+  $ cat >dune-project <<EOF
+  > (lang dune 3.18)
+  > (maintenance_intent "1.2.")
+  > EOF
   $ dune build
   File "dune-project", line 2, characters 20-26:
   2 | (maintenance_intent "1.2.")
                           ^^^^^^
   Error: version ends with a dot
   [1]
 
-  $ echo '(lang dune 3.18)\n(maintenance_intent "1.2(latest).3")' >dune-project
+  $ cat >dune-project <<EOF
+  > (lang dune 3.18)
+  > (maintenance_intent "1.2(latest).3")
+  > EOF
   $ dune build
   File "dune-project", line 2, characters 20-35:
   2 | (maintenance_intent "1.2(latest).3")
                           ^^^^^^^^^^^^^^^
   Error: unexpected parenthesis
   [1]
 
-  $ echo '(lang dune 3.18)\n(maintenance_intent "(none-3)")' >dune-project
+  $ cat >dune-project <<EOF
+  > (lang dune 3.18)
+  > (maintenance_intent "(none-3)")
+  > EOF
   $ dune build
   File "dune-project", line 2, characters 20-30:
   2 | (maintenance_intent "(none-3)")
                           ^^^^^^^^^^
-  Error: substraction only allowed for latest, not "none"
+  Error: substraction only allowed for "latest", not "none"
   [1]
 
-  $ echo '(lang dune 3.18)\n(maintenance_intent "(any-3)")' >dune-project
+  $ cat >dune-project <<EOF
+  > (lang dune 3.18)
+  > (maintenance_intent "(any-3)")
+  > EOF
   $ dune build
   File "dune-project", line 2, characters 20-29:
   2 | (maintenance_intent "(any-3)")
                           ^^^^^^^^^
-  Error: substraction only allowed for latest, not "any"
+  Error: substraction only allowed for "latest", not "any"
   [1]
 
-  $ echo '(lang dune 3.18)\n(maintenance_intent "(latest)1")' >dune-project
+  $ cat >dune-project <<EOF
+  > (lang dune 3.18)
+  > (maintenance_intent "(latest)1")
+  > EOF
   $ dune build
   File "dune-project", line 2, characters 20-31:
   2 | (maintenance_intent "(latest)1")
                           ^^^^^^^^^^^
   Error: missing dot after intent
   [1]
 
-  $ echo '(lang dune 3.18)\n(maintenance_intent "(latest-)")' >dune-project
+  $ cat >dune-project <<EOF
+  > (lang dune 3.18)
+  > (maintenance_intent "(latest-)")
+  > EOF
   $ dune build
   File "dune-project", line 2, characters 20-31:
   2 | (maintenance_intent "(latest-)")
                           ^^^^^^^^^^^
   Error: invalid substraction
   [1]
 
-  $ echo '(lang dune 3.18)\n(maintenance_intent "(latest-0)")' >dune-project
+  $ cat >dune-project <<EOF
+  > (lang dune 3.18)
+  > (maintenance_intent "(latest-0)")
+  > EOF
   $ dune build
   File "dune-project", line 2, characters 20-32:
   2 | (maintenance_intent "(latest-0)")
                           ^^^^^^^^^^^^
   Error: invalid substraction
   [1]
 
-  $ echo '(lang dune 3.18)\n(maintenance_intent "(latest-00)")' >dune-project
+  $ cat >dune-project <<EOF
+  > (lang dune 3.18)
+  > (maintenance_intent "(latest-00)")
+  > EOF
   $ dune build
   File "dune-project", line 2, characters 20-33:
   2 | (maintenance_intent "(latest-00)")
                           ^^^^^^^^^^^^^
   Error: invalid substraction
   [1]
 
-  $ echo '(lang dune 3.18)\n(maintenance_intent "(latest--1)")' >dune-project
+  $ cat >dune-project <<EOF
+  > (lang dune 3.18)
+  > (maintenance_intent "(latest--1)")
+  > EOF
   $ dune build
   File "dune-project", line 2, characters 20-33:
   2 | (maintenance_intent "(latest--1)")
                           ^^^^^^^^^^^^^
   Error: invalid substraction
   [1]
 
-  $ echo '(lang dune 3.18)\n(maintenance_intent "(latest-a)")' >dune-project
+  $ cat >dune-project <<EOF
+  > (lang dune 3.18)
+  > (maintenance_intent "(latest-a)")
+  > EOF
   $ dune build
   File "dune-project", line 2, characters 20-32:
   2 | (maintenance_intent "(latest-a)")
                           ^^^^^^^^^^^^
   Error: invalid substraction
   [1]
 
-  $ echo '(lang dune 3.18)\n(maintenance_intent "(lates)")' >dune-project
+  $ cat >dune-project <<EOF
+  > (lang dune 3.18)
+  > (maintenance_intent "(latest-1")
+  > EOF
+  $ dune build
+  File "dune-project", line 2, characters 20-31:
+  2 | (maintenance_intent "(latest-1")
+                          ^^^^^^^^^^^
+  Error: unclosed parenthesis
+  [1]
+
+  $ cat >dune-project <<EOF
+  > (lang dune 3.18)
+  > (maintenance_intent "(lates)")
+  > EOF
   $ dune build
   File "dune-project", line 2, characters 20-29:
   2 | (maintenance_intent "(lates)")
                           ^^^^^^^^^
-  Error: unknown intent "lates", expected any, latest or none
+  Error: unknown intent "lates", expected "any", "latest" or "none"
   [1]
 
-  $ echo '(lang dune 3.18)\n(maintenance_intent "1.2" "(latest)" "err)" "3.4")' >dune-project
+  $ cat >dune-project <<EOF
+  > (lang dune 3.18)
+  > (maintenance_intent "1.2" "(latest)" "err)" "3.4")
+  > EOF
   $ dune build
   File "dune-project", line 2, characters 37-43:
   2 | (maintenance_intent "1.2" "(latest)" "err)" "3.4")
Original file line number	Diff line number	Diff line change
		@@ -0,0 +1 @@
		- Validate opam `maintenance_intent` (#11308, @art-w)