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