Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

opam_constraint t result should respect precedence #7682

Merged
merged 1 commit into from
Jun 21, 2023
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 3 additions & 0 deletions CHANGES.md
Original file line number Diff line number Diff line change
Expand Up @@ -57,6 +57,9 @@ Unreleased
- Add `(build_if)` to the `(test)` stanza. When it evaluates to false, the
executable is not built. (#7899, fixes #6938, @emillon)

- Add necessary parentheses in generated opam constraints (#7682, fixes #3431,
@Lucccyo)

3.8.2 (2023-06-16)
------------------

Expand Down
59 changes: 42 additions & 17 deletions src/dune_rules/package.ml
Original file line number Diff line number Diff line change
Expand Up @@ -250,25 +250,50 @@ module Dependency = struct
<|> let+ name = Name.decode in
{ name; constraint_ = None }

let rec opam_constraint : Constraint.t -> OpamParserTypes.FullPos.value =
let open OpamParserTypes.FullPos in
function
| Bvar v -> Constraint.Var.to_opam v
| Uop (op, x) ->
nopos (Prefix_relop (Op.to_relop op, Constraint.Var.to_opam x))
| Bop (op, x, y) ->
nopos
(Relop
(Op.to_relop op, Constraint.Var.to_opam x, Constraint.Var.to_opam y))
| And [ c ] -> opam_constraint c
| And (c :: cs) ->
nopos (Logop (nopos `And, opam_constraint c, opam_constraint (And cs)))
| Or [ c ] -> opam_constraint c
| Or (c :: cs) ->
nopos (Logop (nopos `Or, opam_constraint c, opam_constraint (And cs)))
| And [] | Or [] ->
type context =
| Root
| Ctx_and
| Ctx_or

(* The printer in opam-file-format does not insert parentheses on its own,
but it is possible to use the [Group] constructor with a singleton to
force insertion of parentheses. *)
let group e = nopos (Group (nopos [ e ]) : OpamParserTypes.FullPos.value_kind)

let group_if b e = if b then group e else e

let op_list op = function
| [] ->
User_error.raise
[ Pp.textf "logical operations with no arguments are not supported" ]
| v :: vs ->
List.fold_left ~init:v vs ~f:(fun a b ->
nopos (OpamParserTypes.FullPos.Logop (nopos op, a, b)))

let opam_constraint t : OpamParserTypes.FullPos.value =
let open OpamParserTypes.FullPos in
let rec opam_constraint context = function
| Constraint.Bvar v -> Constraint.Var.to_opam v
| Uop (op, x) ->
nopos (Prefix_relop (Op.to_relop op, Constraint.Var.to_opam x))
| Bop (op, x, y) ->
nopos
(Relop
(Op.to_relop op, Constraint.Var.to_opam x, Constraint.Var.to_opam y))
| And cs -> logical_op `And cs ~inner_ctx:Ctx_and ~group_needed:false
| Or cs ->
let group_needed =
match context with
| Root -> false
| Ctx_and -> true
| Ctx_or -> false
in
logical_op `Or cs ~inner_ctx:Ctx_or ~group_needed
and logical_op op cs ~inner_ctx ~group_needed =
List.map cs ~f:(opam_constraint inner_ctx)
|> op_list op |> group_if group_needed
in
opam_constraint Root t

let opam_depend { name; constraint_ } =
let constraint_ = Option.map ~f:opam_constraint constraint_ in
Expand Down
8 changes: 4 additions & 4 deletions test/blackbox-tests/test-cases/opam-constraints.t
Original file line number Diff line number Diff line change
Expand Up @@ -23,9 +23,9 @@ constraints.
> ; or
> (p_or2 (or :a :b))
> (p_or1 (or :a))
> (p_or3 (or :a :b :c)) ; buggy output
> (p_or3 (or :a :b :c))
> ; mixed operations
> (p_and_in_or (or :a (and :b :c))) ; buggy output, see #3431
> (p_and_in_or (or :a (and :b :c)))
> (p_or_in_and (and :a (or :b :c)))
> ))
> EOF
Expand All @@ -49,9 +49,9 @@ constraints.
"p_and3" {a & b & c}
"p_or2" {a | b}
"p_or1" {a}
"p_or3" {a | b & c}
"p_or3" {a | b | c}
"p_and_in_or" {a | b & c}
"p_or_in_and" {a & b | c}
"p_or_in_and" {a & (b | c)}
]
build: [
["dune" "subst"] {pinned}
Expand Down