diff --git a/parsing/jane_syntax_parsing.ml b/parsing/jane_syntax_parsing.ml index 545d0025675..6198d3e2dd6 100644 --- a/parsing/jane_syntax_parsing.ml +++ b/parsing/jane_syntax_parsing.ml @@ -800,8 +800,8 @@ module Make_ast (AST : AST_internal) : AST with type ast = AST.ast = struct let make_entire_jane_syntax ~loc feature ast = AST.with_location - (make_jane_syntax feature [] - (Ast_helper.with_default_loc { loc with loc_ghost = true } ast)) + (Ast_helper.with_default_loc { loc with loc_ghost = true } (fun () -> + make_jane_syntax feature [] (ast ()))) loc (** Generically lift our custom ASTs for our novel syntax from OCaml ASTs. *) diff --git a/testsuite/tests/jane-modular-syntax/attribute_locations.ml b/testsuite/tests/jane-modular-syntax/attribute_locations.ml new file mode 100644 index 00000000000..4d2897f41ca --- /dev/null +++ b/testsuite/tests/jane-modular-syntax/attribute_locations.ml @@ -0,0 +1,70 @@ +(* TEST + include ocamlcommon *) + +let () = Language_extension.enable Comprehensions ();; + + module Location_map = struct + include Map.Make (struct + type t = Location.t + let compare = compare + end) + + let add_multi key data t = + update key (function + | None -> Some [data] + | Some x -> Some (data :: x)) + t +end + +let gather_attributes_by_location program_text = + let program_text_buf = Lexing.from_string program_text in + Lexing.set_filename program_text_buf ""; + let parsed = Parse.expression program_text_buf in + let attrs_by_location = ref Location_map.empty in + let record_attribute { Parsetree.attr_name; attr_loc } = + attrs_by_location := + Location_map.add_multi attr_loc attr_name.txt !attrs_by_location + in + (* We can't use an [attribute] iterator because Jane Syntax attributes are + skipped by the default iterator. To undo this behavior, we instead override + the expression iterator to look at attributes literally. + *) + let expr iterator (x : Parsetree.expression) = + List.iter record_attribute x.pexp_attributes; + Ast_iterator.default_iterator.expr iterator { x with pexp_attributes = [] } + in + let iterator = { Ast_iterator.default_iterator with expr } in + iterator.expr iterator parsed; + !attrs_by_location +;; + +let run_test program_text ~summary = + print_endline "---"; + Printf.printf "Test: %s\n" summary; + print_endline "Program text:"; + print_endline program_text; + print_endline "Attributes and their locations:"; + let attributes_by_location = gather_attributes_by_location program_text in + Location_map.iter + (fun loc at_loc -> + let printf fmt = Format.fprintf Format.std_formatter fmt in + printf "\tAt location %a:\n" Location.print_loc loc; + List.iter (printf "\t\t%s\n") at_loc) + attributes_by_location +;; + +let () = + run_test ~summary:"single Jane Syntax construct" + "[ x for x in [ 1; 2; 3 ]]" +;; + +let () = + run_test ~summary:"multiple Jane Syntax constructs" + "let x1 = [ x for x in [ 1; 2; 3 ]] in\n\ + let x2 = [ y for y = 1 to 100 ] in\n\ + let x3 = [ y for y = 1 to 100 ] in\n\ + let x4 = [ y for y = 100 downto 1 ] in\n\ + let x6 = [| y for y = 100 downto 1 |] in\n\ + let x7 = [ y for y = 1 to 100 when y = 50 ] in\n\ + ()" +;; diff --git a/testsuite/tests/jane-modular-syntax/attribute_locations.reference b/testsuite/tests/jane-modular-syntax/attribute_locations.reference new file mode 100644 index 00000000000..1e95728d965 --- /dev/null +++ b/testsuite/tests/jane-modular-syntax/attribute_locations.reference @@ -0,0 +1,59 @@ +--- +Test: single Jane Syntax construct +Program text: +[ x for x in [ 1; 2; 3 ]] +Attributes and their locations: + At location File "", line 1, characters 0-25: + jane.non_erasable.comprehensions.body + jane.non_erasable.comprehensions.for.in + jane.non_erasable.comprehensions.for + jane.non_erasable.comprehensions.list + jane.non_erasable.comprehensions +--- +Test: multiple Jane Syntax constructs +Program text: +let x1 = [ x for x in [ 1; 2; 3 ]] in +let x2 = [ y for y = 1 to 100 ] in +let x3 = [ y for y = 1 to 100 ] in +let x4 = [ y for y = 100 downto 1 ] in +let x6 = [| y for y = 100 downto 1 |] in +let x7 = [ y for y = 1 to 100 when y = 50 ] in +() +Attributes and their locations: + At location File "", line 1, characters 9-34: + jane.non_erasable.comprehensions.body + jane.non_erasable.comprehensions.for.in + jane.non_erasable.comprehensions.for + jane.non_erasable.comprehensions.list + jane.non_erasable.comprehensions + At location File "", line 2, characters 9-31: + jane.non_erasable.comprehensions.body + jane.non_erasable.comprehensions.for.range.upto + jane.non_erasable.comprehensions.for + jane.non_erasable.comprehensions.list + jane.non_erasable.comprehensions + At location File "", line 3, characters 9-31: + jane.non_erasable.comprehensions.body + jane.non_erasable.comprehensions.for.range.upto + jane.non_erasable.comprehensions.for + jane.non_erasable.comprehensions.list + jane.non_erasable.comprehensions + At location File "", line 4, characters 9-35: + jane.non_erasable.comprehensions.body + jane.non_erasable.comprehensions.for.range.downto + jane.non_erasable.comprehensions.for + jane.non_erasable.comprehensions.list + jane.non_erasable.comprehensions + At location File "", line 5, characters 9-37: + jane.non_erasable.comprehensions.body + jane.non_erasable.comprehensions.for.range.downto + jane.non_erasable.comprehensions.for + jane.non_erasable.comprehensions.array.mutable + jane.non_erasable.comprehensions + At location File "", line 6, characters 9-43: + jane.non_erasable.comprehensions.body + jane.non_erasable.comprehensions.when + jane.non_erasable.comprehensions.for.range.upto + jane.non_erasable.comprehensions.for + jane.non_erasable.comprehensions.list + jane.non_erasable.comprehensions