From 6cffba0ddfff464afbae7f28607fa3a3773f5562 Mon Sep 17 00:00:00 2001 From: Hugo Heuzard Date: Wed, 13 Dec 2023 18:10:46 +0100 Subject: [PATCH] WIP --- .github/workflows/build.yml | 2 +- compiler/tests-js-parser/run.ml | 169 +++++++++++++++++++------------- 2 files changed, 100 insertions(+), 71 deletions(-) diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index e1d474c5e0..15bb25fcf9 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -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: diff --git a/compiler/tests-js-parser/run.ml b/compiler/tests-js-parser/run.ml index ea84ded2a0..c2e2fd0d61 100644 --- a/compiler/tests-js-parser/run.ml +++ b/compiler/tests-js-parser/run.ml @@ -45,6 +45,10 @@ let () = let unsupported_syntax = ref [] +let negative = ref [] + +let noStrict = ref [] + let fail = ref [] let pass = ref [] @@ -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 @@ -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);