From 4a0eb4324306dea71691f0c2936708c3b3a4edc4 Mon Sep 17 00:00:00 2001 From: ArthurW Date: Thu, 16 Jan 2025 16:13:21 +0100 Subject: [PATCH] Fix after review Signed-off-by: ArthurW --- doc/changes/11308.md | 1 + src/dune_lang/package_info.ml | 46 +++++--- .../test-cases/opam-maintenance-intent.t | 103 +++++++++++++++--- 3 files changed, 116 insertions(+), 34 deletions(-) create mode 100644 doc/changes/11308.md diff --git a/doc/changes/11308.md b/doc/changes/11308.md new file mode 100644 index 000000000000..6098f0876fa9 --- /dev/null +++ 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 index d48e1dba28bf..e54bd7580c29 100644 --- a/src/dune_lang/package_info.ml +++ b/src/dune_lang/package_info.ml @@ -109,25 +109,34 @@ 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" @@ -135,19 +144,24 @@ let valid_maintenance_intent = 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 index 2fe1419f0809..2be376f896bd 100644 --- a/test/blackbox-tests/test-cases/opam-maintenance-intent.t +++ b/test/blackbox-tests/test-cases/opam-maintenance-intent.t @@ -60,7 +60,21 @@ 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 < (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 < (lang dune 3.18) + > (maintenance_intent "(latest") + > EOF $ dune build File "dune-project", line 2, characters 20-29: 2 | (maintenance_intent "(latest") @@ -68,10 +82,16 @@ The following are all invalid maintenance intents: Error: unclosed parenthesis [1] - $ echo '(lang dune 3.18)\n(maintenance_intent ").1")' >dune-project + $ cat >dune-project < (lang dune 3.18) + > (maintenance_intent ").1") + > EOF $ dune build - $ echo '(lang dune 3.18)\n(maintenance_intent ".1")' >dune-project + $ cat >dune-project < (lang dune 3.18) + > (maintenance_intent ".1") + > EOF $ dune build File "dune-project", line 2, characters 20-24: 2 | (maintenance_intent ".1") @@ -79,7 +99,10 @@ The following are all invalid maintenance intents: Error: unexpected dot [1] - $ echo '(lang dune 3.18)\n(maintenance_intent "1.2.")' >dune-project + $ cat >dune-project < (lang dune 3.18) + > (maintenance_intent "1.2.") + > EOF $ dune build File "dune-project", line 2, characters 20-26: 2 | (maintenance_intent "1.2.") @@ -87,7 +110,10 @@ The following are all invalid maintenance intents: Error: version ends with a dot [1] - $ echo '(lang dune 3.18)\n(maintenance_intent "1.2(latest).3")' >dune-project + $ cat >dune-project < (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") @@ -95,23 +121,32 @@ The following are all invalid maintenance intents: Error: unexpected parenthesis [1] - $ echo '(lang dune 3.18)\n(maintenance_intent "(none-3)")' >dune-project + $ cat >dune-project < (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 < (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 < (lang dune 3.18) + > (maintenance_intent "(latest)1") + > EOF $ dune build File "dune-project", line 2, characters 20-31: 2 | (maintenance_intent "(latest)1") @@ -119,7 +154,10 @@ The following are all invalid maintenance intents: Error: missing dot after intent [1] - $ echo '(lang dune 3.18)\n(maintenance_intent "(latest-)")' >dune-project + $ cat >dune-project < (lang dune 3.18) + > (maintenance_intent "(latest-)") + > EOF $ dune build File "dune-project", line 2, characters 20-31: 2 | (maintenance_intent "(latest-)") @@ -127,7 +165,10 @@ The following are all invalid maintenance intents: Error: invalid substraction [1] - $ echo '(lang dune 3.18)\n(maintenance_intent "(latest-0)")' >dune-project + $ cat >dune-project < (lang dune 3.18) + > (maintenance_intent "(latest-0)") + > EOF $ dune build File "dune-project", line 2, characters 20-32: 2 | (maintenance_intent "(latest-0)") @@ -135,7 +176,10 @@ The following are all invalid maintenance intents: Error: invalid substraction [1] - $ echo '(lang dune 3.18)\n(maintenance_intent "(latest-00)")' >dune-project + $ cat >dune-project < (lang dune 3.18) + > (maintenance_intent "(latest-00)") + > EOF $ dune build File "dune-project", line 2, characters 20-33: 2 | (maintenance_intent "(latest-00)") @@ -143,7 +187,10 @@ The following are all invalid maintenance intents: Error: invalid substraction [1] - $ echo '(lang dune 3.18)\n(maintenance_intent "(latest--1)")' >dune-project + $ cat >dune-project < (lang dune 3.18) + > (maintenance_intent "(latest--1)") + > EOF $ dune build File "dune-project", line 2, characters 20-33: 2 | (maintenance_intent "(latest--1)") @@ -151,7 +198,10 @@ The following are all invalid maintenance intents: Error: invalid substraction [1] - $ echo '(lang dune 3.18)\n(maintenance_intent "(latest-a)")' >dune-project + $ cat >dune-project < (lang dune 3.18) + > (maintenance_intent "(latest-a)") + > EOF $ dune build File "dune-project", line 2, characters 20-32: 2 | (maintenance_intent "(latest-a)") @@ -159,15 +209,32 @@ The following are all invalid maintenance intents: Error: invalid substraction [1] - $ echo '(lang dune 3.18)\n(maintenance_intent "(lates)")' >dune-project + $ cat >dune-project < (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 < (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 < (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")