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

Implement a Fuzzy CI to catch ocamlmerlin regressions #1716

Merged
merged 2 commits into from
Jan 29, 2024
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
45 changes: 45 additions & 0 deletions .github/fuzzy-ci-helpers/create_diff.ml
Original file line number Diff line number Diff line change
@@ -0,0 +1,45 @@
type read_result = Success | Eof

let read_line_opt () = try Some (read_line ()) with End_of_file -> None
let delimiter1 = Sys.argv.(1)
let delimiter2 = Sys.argv.(2)
let diff_file = Sys.argv.(3)

let rec loop () =
let rec stdin_to_file ~until file_oc =
match read_line_opt () with
| None -> Eof
| Some line ->
if String.equal line until then Success
else (
output_string file_oc (line ^ "\n");
stdin_to_file ~until file_oc)
in
let label1 = read_line_opt () in
let tmp1 = Filename.temp_file "tmp1" "" in
let oc = open_out tmp1 in
let read_result1 = stdin_to_file ~until:delimiter1 oc in
close_out oc;
let label2 = read_line_opt () in
let tmp2 = Filename.temp_file "tmp2" "" in
let oc = open_out tmp2 in
let read_result2 = stdin_to_file ~until:delimiter2 oc in
close_out oc;
match (label1, read_result1, label2, read_result2) with
| Some label1, Success, Some label2, Success ->
let diff_cmd =
Printf.sprintf
"diff -U 5 --label=\"%s\" --label=\"%s\" \"%s\" \"%s\" >> %s" label1
label2 tmp1 tmp2 diff_file
in
let _ = Sys.command diff_cmd in
loop ()
| Some _, Success, Some _, Eof ->
raise (Failure "EOF before reaching delimiter2 when reading second JSON.")
| Some _, Success, None, _ ->
raise (Failure "EOF before reaching delimiter2 when second label.")
| Some _, Eof, _, _ ->
raise (Failure "EOF before reaching delimiter1 when reading first JSON.")
| None, _, _, _ -> ()

let () = loop ()
Loading