Skip to content

Commit

Permalink
WIP
Browse files Browse the repository at this point in the history
  • Loading branch information
hhugo committed Dec 13, 2023
1 parent 51b1ccf commit 6cffba0
Show file tree
Hide file tree
Showing 2 changed files with 100 additions and 71 deletions.
2 changes: 1 addition & 1 deletion .github/workflows/build.yml
Original file line number Diff line number Diff line change
Expand Up @@ -159,7 +159,7 @@ jobs:
- run: opam install sedlex menhir

- run: rm compiler/tests-js-parser/test262/package.json

- run: rm -rf compiler/tests-js-parser/test262/test/language/module-code/import-assertions/
- run: opam exec -- dune build @runtest-parser --profile release

lint-fmt:
Expand Down
169 changes: 99 additions & 70 deletions compiler/tests-js-parser/run.ml
Original file line number Diff line number Diff line change
Expand Up @@ -45,6 +45,10 @@ let () =

let unsupported_syntax = ref []

let negative = ref []

let noStrict = ref []

let fail = ref []

let pass = ref []
Expand Down Expand Up @@ -173,6 +177,8 @@ let rec check_toks
false)

let () =
let negative_r = Str.regexp_string "\nnegative:" in
let noStrict_r = Str.regexp_string "noStrict" in
let total = List.length files in
List.iteri files ~f:(fun i filename ->
let () = if !progress then Printf.eprintf "%d/%d\r%!" i total in
Expand All @@ -182,77 +188,100 @@ let () =
let errors = ref [] in
let add r = r := (filename, content) :: !r in
close_in ic;
try
let p1, toks1 =
Parse_js.Lexer.of_string
~report_error:(fun e -> errors := e :: !errors)
~filename
content
|> Parse_js.parse'
in
let p1 = List.concat_map p1 ~f:snd in
(match List.rev !errors with
| [] -> (
let s = p_to_string p1 in
try
let p2, toks2 =
Parse_js.Lexer.of_string
~report_error:(fun e -> errors := e :: !errors)
~filename
s
|> Parse_js.parse'
in
let p2 = List.concat_map p2 ~f:snd in
if Poly.(clean_loc p1 = clean_loc p2)
then ()
else if not (check_toks toks1 [] toks2 [])
then Printf.eprintf "error for %s\n%s\n%s\n" filename s (p_to_string p2)
with _ -> if false then Printf.eprintf "cannot parse back %s\n" filename)
| l -> if accepted_by_node filename then List.iter ~f:Parse_js.Lexer.print_error l);
if patdiff
then (
let s = p_to_string (clean_loc p1) in
let jsoo_name = filename ^ ".jsoo" in
let oc = open_out_bin jsoo_name in
output_string oc s;
close_out oc;
let _ret = Sys.command (Printf.sprintf "patdiff %s %s" filename jsoo_name) in
());
(if vs_explicit
then
try
let explicit =
Filename.(
concat
(concat (dirname (dirname filename)) "pass-explicit")
(basename filename))
in
let ic = open_in_bin explicit in
let content = In_channel.input_all ic in
close_in ic;
let p2 =
Parse_js.Lexer.of_string ~filename:explicit content |> Parse_js.parse
in
let p1 = clean_loc p1 and p2 = clean_loc p2 in
let p1s = p_to_string p1 and p2s = p_to_string p2 in
if Poly.(p1 <> p2)
then
if String.equal p1s p2s
then (
Printf.printf ">>>>>>> AST MISMATCH %s <<<<<<<<<<\n" filename;
Printf.printf "%s\n\n" p1s)
else (
Printf.printf ">>>>>>> MISMATCH %s <<<<<<<<<<\n" filename;
Printf.printf "%s\n\n%s\n" p1s p2s)
with _ -> ());
add pass
with
| Parse_js.Parsing_error loc ->
if not (accepted_by_node filename)
then add unsupported_syntax
else fail := (filename, loc, content) :: !fail
| e -> Printf.eprintf "Unexpected error %s\n%s\n" filename (Printexc.to_string e));
match Str.search_forward negative_r content 0 with
| _ -> negative := filename :: !negative
| exception Not_found -> (
match Str.search_forward noStrict_r content 0 with
| _ -> noStrict := filename :: !noStrict
| exception Not_found -> (
try
let p1, toks1 =
Parse_js.Lexer.of_string
~report_error:(fun e -> errors := e :: !errors)
~filename
content
|> Parse_js.parse'
in
let p1 = List.concat_map p1 ~f:snd in
(match List.rev !errors with
| [] -> (
let s = p_to_string p1 in
try
let p2, toks2 =
Parse_js.Lexer.of_string
~report_error:(fun e -> errors := e :: !errors)
~filename
s
|> Parse_js.parse'
in
let p2 = List.concat_map p2 ~f:snd in
if Poly.(clean_loc p1 = clean_loc p2)
then ()
else if not (check_toks toks1 [] toks2 [])
then
Printf.eprintf
"error for %s\n%s\n%s\n"
filename
s
(p_to_string p2)
with _ ->
if false then Printf.eprintf "cannot parse back %s\n" filename)
| l ->
if accepted_by_node filename
then List.iter ~f:Parse_js.Lexer.print_error l);
if patdiff
then (
let s = p_to_string (clean_loc p1) in
let jsoo_name = filename ^ ".jsoo" in
let oc = open_out_bin jsoo_name in
output_string oc s;
close_out oc;
let _ret =
Sys.command (Printf.sprintf "patdiff %s %s" filename jsoo_name)
in
());
(if vs_explicit
then
try
let explicit =
Filename.(
concat
(concat (dirname (dirname filename)) "pass-explicit")
(basename filename))
in
let ic = open_in_bin explicit in
let content = In_channel.input_all ic in
close_in ic;
let p2 =
Parse_js.Lexer.of_string ~filename:explicit content
|> Parse_js.parse
in
let p1 = clean_loc p1 and p2 = clean_loc p2 in
let p1s = p_to_string p1 and p2s = p_to_string p2 in
if Poly.(p1 <> p2)
then
if String.equal p1s p2s
then (
Printf.printf ">>>>>>> AST MISMATCH %s <<<<<<<<<<\n" filename;
Printf.printf "%s\n\n" p1s)
else (
Printf.printf ">>>>>>> MISMATCH %s <<<<<<<<<<\n" filename;
Printf.printf "%s\n\n%s\n" p1s p2s)
with _ -> ());
add pass
with
| Parse_js.Parsing_error loc ->
if false && not (accepted_by_node filename)
then add unsupported_syntax
else fail := (filename, loc, content) :: !fail
| e ->
Printf.eprintf
"Unexpected error %s\n%s\n"
filename
(Printexc.to_string e))));
Printf.printf "Summary:\n";
Printf.printf " invalid : %d\n" (List.length !negative);
Printf.printf " no scrict : %d\n" (List.length !noStrict);
Printf.printf " skip : %d\n" (List.length !unsupported_syntax);
Printf.printf " fail : %d\n" (List.length !fail);
Printf.printf " pass : %d\n" (List.length !pass);
Expand Down

0 comments on commit 6cffba0

Please sign in to comment.