Skip to content

Commit

Permalink
Added parentheses in Dyn.pp output.
Browse files Browse the repository at this point in the history
  • Loading branch information
@jtov-js
jtov-js committed Aug 30, 2024
1 parent 4403e9f commit 22dd0b7
Show file tree
Hide file tree
Showing 17 changed files with 390 additions and 354 deletions.
2 changes: 1 addition & 1 deletion otherlibs/dune-build-info/test/run.t
100755 → 100644
View file
Original file line number Diff line number Diff line change
Expand Up @@ -132,7 +132,7 @@ craft an example with a single placeholder to make the output stable:
$ dune build d/d.install
$ dune install d --prefix _install --debug-artifact-substitution
Found placeholder in _build/install/default/bin/d:
- placeholder: Vcs_describe In_source_tree "d"
- placeholder: Vcs_describe (In_source_tree "d")
- evaluates to: "1.0+d"

Test substitution when promoting
Expand Down
36 changes: 19 additions & 17 deletions otherlibs/dyn/dyn.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -68,12 +68,14 @@ let pp_sequence start stop x ~f =
let sep = ";" ^ String.make (String.length start) ' ' in
Pp.hvbox
(Pp.concat_mapi ~sep:Pp.cut x ~f:(fun i x ->
Pp.box ((if i = 0 then Pp.verbatim (start ^ " ") else Pp.verbatim sep) ++ f x))
Pp.box
~indent:2
((if i = 0 then Pp.verbatim (start ^ " ") else Pp.verbatim sep) ++ f x))
++ Pp.space
++ Pp.verbatim stop)
;;

let rec pp =
let rec pp ?(in_arg = false) =
let open Pp.O in
function
| Opaque -> Pp.verbatim "<opaque>"
Expand All @@ -87,8 +89,8 @@ let rec pp =
| Bytes b -> string_in_ocaml_syntax (Bytes.to_string b)
| Char c -> Pp.char c
| Float f -> Pp.verbatim (string_of_float f)
| Option None -> pp (Variant ("None", []))
| Option (Some x) -> pp (Variant ("Some", [ x ]))
| Option None -> pp ~in_arg (Variant ("None", []))
| Option (Some x) -> pp ~in_arg (Variant ("Some", [ x ]))
| List xs -> pp_sequence "[" "]" xs ~f:pp
| Array xs -> pp_sequence "[|" "|]" (Array.to_list xs) ~f:pp
| Set xs ->
Expand All @@ -100,25 +102,25 @@ let rec pp =
++ Pp.space
++ pp_sequence "{" "}" xs ~f:(fun (k, v) ->
Pp.box ~indent:2 (pp k ++ Pp.space ++ Pp.char ':' ++ Pp.space ++ pp v)))
| Tuple x ->
Pp.box
(Pp.char '('
++ Pp.concat_map ~sep:(Pp.seq (Pp.char ',') Pp.space) x ~f:pp
++ Pp.char ')')
| Tuple xs ->
Pp.char '('
++ Pp.hvbox (Pp.concat_map ~sep:(Pp.seq (Pp.char ',') Pp.space) xs ~f:pp)
++ Pp.char ')'
| Record fields ->
pp_sequence "{" "}" fields ~f:(fun (f, v) ->
Pp.box ~indent:2 (Pp.verbatim f ++ Pp.space ++ Pp.char '=' ++ Pp.space ++ pp v))
| Variant (v, []) -> Pp.verbatim v
| Variant (v, xs) ->
Pp.hvbox
~indent:2
(Pp.concat
[ Pp.verbatim v
; Pp.space
; Pp.concat_map ~sep:(Pp.seq (Pp.char ',') Pp.space) xs ~f:pp
])
| Variant (v, (_ :: _ as xs)) ->
let arg =
match xs with
| [ x ] -> x
| _ -> Tuple xs
in
let app = Pp.hvbox ~indent:2 (Pp.verbatim v ++ Pp.space ++ pp ~in_arg:true arg) in
if in_arg then Pp.char '(' ++ app ++ Pp.char ')' else app
;;

let pp t = pp t
let to_string t = Format.asprintf "%a" Pp.to_fmt (pp t)

type 'a builder = 'a -> t
Expand Down
44 changes: 22 additions & 22 deletions otherlibs/ocamlc-loc/test/ocamlc_loc_tests.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -64,7 +64,7 @@ Error (warning 32 [unused-value-declaration]): unused value foo.
{ loc = { path = "test.ml"; line = Single 1; chars = Some (4, 7) }
; message = "unused value foo."
; related = []
; severity = Error Some { code = 32; name = "unused-value-declaration" }
; severity = Error (Some { code = 32; name = "unused-value-declaration" })
} |}]
;;

Expand Down Expand Up @@ -98,9 +98,9 @@ Error: The implementation test.ml does not match the interface test.cmi:
The type bool is not compatible with the type int"
; related =
[ ({ path = "test.mli"; line = Single 1; chars = Some (0, 11) },
"Expected declaration")
"Expected declaration")
; ({ path = "test.ml"; line = Single 1; chars = Some (4, 5) },
"Actual declaration")
"Actual declaration")
]
; severity = Error None
} |}]
Expand Down Expand Up @@ -169,7 +169,7 @@ Error: Signature mismatch:
[%expect
{|
>> error 0
{ loc = { path = "test.ml"; line = Range 3, 5; chars = Some (6, 3) }
{ loc = { path = "test.ml"; line = Range (3, 5); chars = Some (6, 3) }
; message =
"Signature mismatch:\n\
Modules do not match:\n\
Expand All @@ -184,9 +184,9 @@ Error: Signature mismatch:
Type float is not compatible with type int"
; related =
[ ({ path = "test.ml"; line = Single 2; chars = Some (2, 20) },
"Expected declaration")
"Expected declaration")
; ({ path = "test.ml"; line = Single 4; chars = Some (6, 7) },
"Actual declaration")
"Actual declaration")
]
; severity = Error None
} |}]
Expand Down Expand Up @@ -242,12 +242,12 @@ Error: The implementation src/dune_rules/artifacts.ml
; line = Single 20
; chars = Some (4, 33)
},
"Expected declaration")
"Expected declaration")
; ({ path = "src/dune_rules/artifacts.ml"
; line = Single 50
; chars = Some (8, 13)
},
"Actual declaration")
"Actual declaration")
]
; severity = Error None
} |}]
Expand Down Expand Up @@ -280,23 +280,23 @@ Will be removed past 2020-20-20. Use Mylib.Intf_only instead.
"module Bar\n\
Will be removed past 2020-20-20. Use Mylib.Bar instead."
; related = []
; severity = Error Some "deprecated"
; severity = Error (Some "deprecated")
}
>> error 1
{ loc = { path = "fooexe.ml"; line = Single 4; chars = Some (0, 7) }
; message =
"module Foo\n\
Will be removed past 2020-20-20. Use Mylib.Foo instead."
; related = []
; severity = Error Some "deprecated"
; severity = Error (Some "deprecated")
}
>> error 2
{ loc = { path = "fooexe.ml"; line = Single 7; chars = Some (11, 22) }
; message =
"module Intf_only\n\
Will be removed past 2020-20-20. Use Mylib.Intf_only instead."
; related = []
; severity = Error Some "deprecated"
; severity = Error (Some "deprecated")
} |}]
;;

Expand All @@ -315,7 +315,7 @@ Error: Some record fields are undefined: signal_watcher
>> error 0
{ loc =
{ path = "test/expect-tests/timer_tests.ml"
; line = Range 6, 10
; line = Range (6, 10)
; chars = Some (2, 3)
}
; message = "Some record fields are undefined: signal_watcher"
Expand Down Expand Up @@ -387,7 +387,7 @@ Error: The implementation src/dune_engine/build_system.ml
; line = Single 8
; chars = Some (0, 40)
},
"Expected declaration")
"Expected declaration")
]
; severity = Error None
} |}]
Expand Down Expand Up @@ -503,7 +503,7 @@ testing
; message = "A.f\n\
testing"
; related = []
; severity = Error Some "foobar"
; severity = Error (Some "foobar")
} |}]
;;

Expand Down Expand Up @@ -572,54 +572,54 @@ Case
>> error 0
{ loc =
{ path = "src/dune_engine/action.ml"
; line = Range 34, 96
; line = Range (34, 96)
; chars = Some (4, 64)
}
; message =
"this pattern-matching is not exhaustive.\n\
Here is an example of a case that is not matched:\n\
Case"
; related = []
; severity = Error Some { code = 8; name = "partial-match" }
; severity = Error (Some { code = 8; name = "partial-match" })
}
>> error 1
{ loc =
{ path = "src/dune_engine/action.ml"
; line = Range 291, 315
; line = Range (291, 315)
; chars = Some (2, 22)
}
; message =
"this pattern-matching is not exhaustive.\n\
Here is an example of a case that is not matched:\n\
Case"
; related = []
; severity = Error Some { code = 8; name = "partial-match" }
; severity = Error (Some { code = 8; name = "partial-match" })
}
>> error 2
{ loc =
{ path = "src/dune_engine/action.ml"
; line = Range 339, 363
; line = Range (339, 363)
; chars = Some (21, 24)
}
; message =
"this pattern-matching is not exhaustive.\n\
Here is an example of a case that is not matched:\n\
Case"
; related = []
; severity = Error Some { code = 8; name = "partial-match" }
; severity = Error (Some { code = 8; name = "partial-match" })
}
>> error 3
{ loc =
{ path = "src/dune_engine/action.ml"
; line = Range 391, 414
; line = Range (391, 414)
; chars = Some (4, 70)
}
; message =
"this pattern-matching is not exhaustive.\n\
Here is an example of a case that is not matched:\n\
Case"
; related = []
; severity = Error Some { code = 8; name = "partial-match" }
; severity = Error (Some { code = 8; name = "partial-match" })
} |}]
;;

Expand Down
Loading

0 comments on commit 22dd0b7

Please sign in to comment.