|
| 1 | +open Ocamlformat_stdlib |
| 2 | +open Ocamlformat_lib |
| 3 | + |
| 4 | +let check_updated_test source expected = |
| 5 | + let source1 = "" in |
| 6 | + let source2 = |
| 7 | + (* Shift all the locations down, in case the parser consults location |
| 8 | + information somehow. *) |
| 9 | + String.make 1000 '\n' ^ source |
| 10 | + in |
| 11 | + let conf = Ocamlformat_lib.Conf.default in |
| 12 | + let ast ~input_name ~source = |
| 13 | + Ocamlformat_lib.Parse_with_comments.parse |
| 14 | + (Ocamlformat_lib.Parse_with_comments.parse_ast conf) |
| 15 | + Structure conf ~input_name ~source |
| 16 | + in |
| 17 | + let ast1 = ast ~input_name:"source1" ~source:source1 in |
| 18 | + let ast2 = |
| 19 | + let ast = ast ~input_name:"source2" ~source:source2 in |
| 20 | + let ghostify = |
| 21 | + { Ocamlformat_parser_extended.Ast_mapper.default_mapper with |
| 22 | + location= (fun _ loc -> {loc with loc_ghost= true}) } |
| 23 | + in |
| 24 | + {ast with ast= ghostify.structure ghostify ast.ast} |
| 25 | + in |
| 26 | + let ast_replaced = {ast1 with ast= ast2.ast} in |
| 27 | + let with_buffer_formatter ~buffer_size k = |
| 28 | + let buffer = Buffer.create buffer_size in |
| 29 | + let fs = Format_.formatter_of_buffer buffer in |
| 30 | + Fmt.eval fs k ; |
| 31 | + Format_.pp_print_flush fs () ; |
| 32 | + if Buffer.length buffer > 0 then Format_.pp_print_newline fs () ; |
| 33 | + Buffer.contents buffer |
| 34 | + in |
| 35 | + let print (ast : _ Parse_with_comments.with_comments) = |
| 36 | + let open Fmt in |
| 37 | + let debug = conf.opr_opts.debug.v in |
| 38 | + with_buffer_formatter ~buffer_size:1000 |
| 39 | + ( set_margin conf.fmt_opts.margin.v |
| 40 | + $ set_max_indent conf.fmt_opts.max_indent.v |
| 41 | + $ Fmt_ast.fmt_ast Structure ~debug ast.source |
| 42 | + (Ocamlformat_lib.Cmts.init Structure ~debug ast.source ast.ast |
| 43 | + ast.comments ) |
| 44 | + conf ast.ast ) |
| 45 | + in |
| 46 | + let printed_ast_replaced = String.strip (print ast_replaced) in |
| 47 | + (* Ideally we'd improve two things about this test: |
| 48 | +
|
| 49 | + - check the new string parses, to the same AST as the original one - use |
| 50 | + ppx_expect, so we have a nicer workflow and more readable errors *) |
| 51 | + Alcotest.check Alcotest.string |
| 52 | + ("updated AST: " ^ source) |
| 53 | + expected printed_ast_replaced |
| 54 | + |
| 55 | +let updated_ast_tests = |
| 56 | + [ ( "updated AST" |
| 57 | + , `Quick |
| 58 | + , fun () -> |
| 59 | + (* We try to ensure that modified ASTs can be printed by ocamlformat, |
| 60 | + which can fail due to assumption about certain constructions |
| 61 | + having corresponding bits of syntax in the Source.t. *) |
| 62 | + (* exercise every expression construct *) |
| 63 | + check_updated_test "x" "x" ; |
| 64 | + check_updated_test "1_2" "1_2" ; |
| 65 | + check_updated_test "12l" "12l" ; |
| 66 | + check_updated_test "'a'" "'a'" ; |
| 67 | + check_updated_test {|'\n'|} {|'\n'|} ; |
| 68 | + check_updated_test {|"a\013"|} {|"a\r"|} ; |
| 69 | + check_updated_test "{|a|}" "{|a|}" ; |
| 70 | + check_updated_test "12e1" "12e1" ; |
| 71 | + check_updated_test "let rec x = 1 and y = 2 in ()" |
| 72 | + "let rec x = 1 and y = 2 in\n()" ; |
| 73 | + check_updated_test "let x = 1 and y = 2 in ()" |
| 74 | + "let x = 1 and y = 2 in\n()" ; |
| 75 | + check_updated_test "fun x y : a -> function 1 -> 1" |
| 76 | + "fun x y : a -> function 1 -> 1" ; |
| 77 | + check_updated_test "f a ~b ?c" "f a ~b ?c" ; |
| 78 | + check_updated_test "match () with () -> () | () -> ()" |
| 79 | + "match () with () -> () | () -> ()" ; |
| 80 | + check_updated_test "try () with () -> () | () -> ()" |
| 81 | + "try () with () -> () | () -> ()" ; |
| 82 | + check_updated_test "((), ())" "(), ()" ; |
| 83 | + check_updated_test "Some (); None" "Some ();\nNone" ; |
| 84 | + check_updated_test "`Some (); `None" "`Some ();\n`None" ; |
| 85 | + check_updated_test "{ a = 1; b : float = 2 }, { r with a }" |
| 86 | + "{ a = 1; b : float = 2 }, { r with a }" ; |
| 87 | + check_updated_test "a.x" "a.x" ; |
| 88 | + check_updated_test "a.x <- 1" "a.x <- 1" ; |
| 89 | + check_updated_test "[| 1; 2 |]" "[| 1; 2 |]" ; |
| 90 | + check_updated_test "[ 1; 2 ]" "[ 1; 2 ]" ; |
| 91 | + check_updated_test "if a then b else if c then d else e" |
| 92 | + "if a then b else if c then d else e" ; |
| 93 | + check_updated_test "a; b" "a;\nb" ; |
| 94 | + check_updated_test "while a do b done" "while a do\n b\ndone" ; |
| 95 | + check_updated_test "for a = b to c do d done" |
| 96 | + "for a = b to c do\n d\ndone" ; |
| 97 | + check_updated_test "(a : b)" "(a : b)" ; |
| 98 | + check_updated_test "(a : b :> c)" "(a : b :> c)" ; |
| 99 | + check_updated_test "a#b" "a#b" ; |
| 100 | + check_updated_test "x <- 2" "x <- 2" ; |
| 101 | + check_updated_test "{<x = 1>}" "{<x = 1>}" ; |
| 102 | + check_updated_test "let module M = struct end in ()" |
| 103 | + "let module M = struct end in\n()" ; |
| 104 | + check_updated_test "let exception E in ()" "let exception E in\n()" ; |
| 105 | + check_updated_test "assert ()" "assert ()" ; |
| 106 | + check_updated_test "lazy 1" "lazy 1" ; |
| 107 | + check_updated_test "object val x = 1 end" "object\n val x = 1\nend" ; |
| 108 | + check_updated_test "(module M)" "(module M)" ; |
| 109 | + check_updated_test "(module M : S)" "(module M : S)" ; |
| 110 | + check_updated_test "let open M in 1" "let open M in\n1" ; |
| 111 | + check_updated_test "M.(1)" "M.(1)" ; |
| 112 | + check_updated_test "let+ x = 1 and+ y = 2 in ()" |
| 113 | + "let+ x = 1 and+ y = 2 in\n()" ; |
| 114 | + check_updated_test "[%extension 1]" "[%extension 1]" ; |
| 115 | + check_updated_test "function _ -> ." "function _ -> ." ; |
| 116 | + check_updated_test "_" "_" ; |
| 117 | + check_updated_test "begin () end" "()" ; |
| 118 | + check_updated_test "a :: b" "a :: b" ; |
| 119 | + check_updated_test "a.!(b)" "a.!(b)" ; |
| 120 | + check_updated_test "a.!(b) <- c" "a.!(b) <- c" ; |
| 121 | + check_updated_test "!a" "!a" ; |
| 122 | + check_updated_test "a + b" "a + b" ) ] |
| 123 | + |
| 124 | +let tests = updated_ast_tests |
0 commit comments