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

Add test for 2664 #4408

Merged
merged 6 commits into from
Mar 30, 2021
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
@@ -1,6 +1,9 @@
Unreleased
----------

- Improve interpretation of ansi escape sequence when spawning processes (#4408,
fixes #2665, @rgrinberg)

- Allow `(package pkg)` in dependencies even if `pkg` is an installed package
(#4170, @bobot)

Expand Down
53 changes: 50 additions & 3 deletions otherlibs/stdune-unstable/ansi_color.ml
Original file line number Diff line number Diff line change
@@ -1,6 +1,8 @@
module Style = struct
type t = string

let to_dyn s = Dyn.Encoder.string s

let fg_black = "30"

let fg_red = "31"
Expand Down Expand Up @@ -35,6 +37,24 @@ module Style = struct

let fg_bright_white = "97"

let fg_all =
[ fg_black
; fg_green
; fg_yellow
; fg_blue
; fg_magenta
; fg_cyan
; fg_white
; fg_bright_black
; fg_bright_red
; fg_bright_green
; fg_bright_yellow
; fg_bright_blue
; fg_bright_magenta
; fg_bright_cyan
; fg_bright_white
]

let bg_black = "40"

let bg_red = "41"
Expand Down Expand Up @@ -69,6 +89,26 @@ module Style = struct

let bg_bright_white = "107"

let bg_all =
[ bg_black
; bg_red
; bg_green
; bg_yellow
; bg_blue
; bg_magenta
; bg_cyan
; bg_white
; bg_default
; bg_bright_black
; bg_bright_red
; bg_bright_green
; bg_bright_yellow
; bg_bright_blue
; bg_bright_magenta
; bg_bright_cyan
; bg_bright_white
]

let bold = "1"

let dim = "2"
Expand Down Expand Up @@ -178,9 +218,16 @@ let parse_line str styles =
String.sub str ~pos:seq_start ~len:(seq_end - seq_start)
|> String.split ~on:';'
|> List.fold_left ~init:(List.rev styles) ~f:(fun styles s ->
match s with
| "0" -> []
| _ -> s :: styles)
if s = Style.fg_default then
List.filter styles ~f:(fun s ->
not (List.mem Style.fg_all s ~equal:String.equal))
else if s = Style.bg_default then
List.filter styles ~f:(fun s ->
not (List.mem Style.bg_all s ~equal:String.equal))
else if s = "0" then
[]
else
s :: styles)
|> List.rev
in
loop styles (seq_end + 1) acc)
Expand Down
5 changes: 5 additions & 0 deletions otherlibs/stdune-unstable/ansi_color.mli
Original file line number Diff line number Diff line change
@@ -1,6 +1,8 @@
module Style : sig
type t

val to_dyn : t -> Dyn.t

val fg_default : t

val fg_black : t
Expand Down Expand Up @@ -79,6 +81,9 @@ module Style : sig
val escape_sequence : t list -> string
end

val make_printer :
bool Lazy.t -> Format.formatter -> (Style.t list Pp.t -> unit) Staged.t

(** Print to [Format.std_formatter] *)
val print : Style.t list Pp.t -> unit

Expand Down
108 changes: 108 additions & 0 deletions test/expect-tests/stdune/ansi_color_tests.ml
Original file line number Diff line number Diff line change
@@ -0,0 +1,108 @@
open Stdune

let dyn_of_pp tag pp =
let open Dyn.Encoder in
let rec conv = function
| Pp.Ast.Nop -> constr "Nop" []
| Seq (x, y) -> constr "Seq" [ conv x; conv y ]
| Concat (x, y) -> constr "Concat" [ conv x; list conv y ]
| Box (i, x) -> constr "Box" [ int i; conv x ]
| Vbox (i, x) -> constr "Vbox" [ int i; conv x ]
| Hbox x -> constr "Hbox" [ conv x ]
| Hvbox (i, x) -> constr "Hvbox" [ int i; conv x ]
| Hovbox (i, x) -> constr "Hovbox" [ int i; conv x ]
| Verbatim s -> constr "Verbatim" [ string s ]
| Char c -> constr "Char" [ char c ]
| Break (x, y) ->
let f = triple string int string in
constr "Break" [ f x; f y ]
| Newline -> constr "Newline" []
| Tag (ta, t) -> constr "Tag" [ tag ta; conv t ]
| Text s -> constr "Text" [ string s ]
in
conv
(match Pp.to_ast pp with
| Ok s -> s
| Error () -> assert false)

let%expect_test "reproduce #2664" =
(* https://github.com/ocaml/dune/issues/2664 *)
let b = Buffer.create 100 in
let f s = Buffer.add_string b ("\027[34m" ^ s ^ "\027[39m") in
for i = 1 to 20 do
f (string_of_int i)
done;
let string_with_ansi_colors = Buffer.contents b in
let pp = Ansi_color.parse string_with_ansi_colors in
let ansi_colors_from_pp =
let b = Buffer.create 16 in
let ppf = Format.formatter_of_buffer b in
Staged.unstage (Ansi_color.make_printer (lazy true) ppf) pp;
Buffer.contents b
in
printfn "Original : %S" string_with_ansi_colors;
printfn "From PP : %S" ansi_colors_from_pp;
[%expect
{|
Original : "\027[34m1\027[39m\027[34m2\027[39m\027[34m3\027[39m\027[34m4\027[39m\027[34m5\027[39m\027[34m6\027[39m\027[34m7\027[39m\027[34m8\027[39m\027[34m9\027[39m\027[34m10\027[39m\027[34m11\027[39m\027[34m12\027[39m\027[34m13\027[39m\027[34m14\027[39m\027[34m15\027[39m\027[34m16\027[39m\027[34m17\027[39m\027[34m18\027[39m\027[34m19\027[39m\027[34m20\027[39m"
From PP : "\027[34m1\027[0m\027[34m2\027[0m\027[34m3\027[0m\027[34m4\027[0m\027[34m5\027[0m\027[34m6\027[0m\027[34m7\027[0m\027[34m8\027[0m\027[34m9\027[0m\027[34m10\027[0m\027[34m11\027[0m\027[34m12\027[0m\027[34m13\027[0m\027[34m14\027[0m\027[34m15\027[0m\027[34m16\027[0m\027[34m17\027[0m\027[34m18\027[0m\027[34m19\027[0m\027[34m20\027[0m" |}];
let pp = dyn_of_pp (Dyn.Encoder.list Ansi_color.Style.to_dyn) pp |> Dyn.pp in
Format.printf "%a@.%!" Pp.to_fmt pp;
[%expect
{|
Vbox
0,Seq
Seq
Seq
Seq
Seq
Seq
Seq
Seq
Seq
Seq
Seq
Seq
Seq
Seq
Seq
Seq
Seq
Seq
Seq
Seq Nop,Tag [ "34" ],Verbatim "1",
Tag
[ "34" ],Verbatim "2",Tag
[ "34" ],
Verbatim
"3",
Tag
[ "34" ],Verbatim "4",Tag
[ "34" ],
Verbatim
"5",
Tag
[ "34" ],Verbatim "6",Tag
[ "34" ],
Verbatim
"7",Tag
[ "34" ],
Verbatim
"8",
Tag
[ "34" ],Verbatim "9",Tag
[ "34" ],Verbatim "10",
Tag
[ "34" ],Verbatim "11",Tag [ "34" ],Verbatim "12",
Tag
[ "34" ],Verbatim "13",Tag [ "34" ],Verbatim "14",
Tag
[ "34" ],Verbatim "15",Tag [ "34" ],Verbatim "16",Tag
[ "34" ],
Verbatim
"17",
Tag
[ "34" ],Verbatim "18",Tag [ "34" ],Verbatim "19",Tag
[ "34" ],
Verbatim
"20" |}]