diff --git a/src/common.ml b/src/common.ml index d0e9dbd0e..9841c7047 100644 --- a/src/common.ml +++ b/src/common.ml @@ -148,7 +148,7 @@ let loc_of_attribute { attr_name; attr_payload; attr_loc = _ } = from older asts. *) (* "ocaml.doc" attributes are generated with [Location.none], which is not helpful for error messages. *) - if Poly.( = ) attr_name.loc Location.none then + if Location.is_none attr_name.loc then loc_of_name_and_payload attr_name attr_payload else { @@ -157,7 +157,7 @@ let loc_of_attribute { attr_name; attr_payload; attr_loc = _ } = } let loc_of_extension (name, payload) = - if Poly.( = ) name.loc Location.none then loc_of_name_and_payload name payload + if Location.is_none name.loc then loc_of_name_and_payload name payload else { name.loc with loc_end = (loc_of_name_and_payload name payload).loc_end } diff --git a/src/location.ml b/src/location.ml index 54daa6397..884cc06e1 100644 --- a/src/location.ml +++ b/src/location.ml @@ -18,6 +18,14 @@ let set_filename loc fn = let none = in_file "_none_" +let none_4_08_0_plus = + let loc = + { pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0; pos_cnum = -1 } + in + { loc_start = loc; loc_end = loc; loc_ghost = true } + +let is_none v = Poly.( = ) v none || Poly.( = ) v none_4_08_0_plus + let init lexbuf fname = let open Lexing in lexbuf.lex_curr_p <- diff --git a/src/location.mli b/src/location.mli index a6f4f6b54..a45e68f26 100644 --- a/src/location.mli +++ b/src/location.mli @@ -23,6 +23,12 @@ val set_filename : t -> string -> t val none : t (** An arbitrary value of type [t]; describes an empty ghost range. *) +val is_none : t -> bool +(** Checks whether a given location is equal to [none]. + + Note that this function returns [true] for none locations from all supported + compiler versions. *) + val init : Lexing.lexbuf -> string -> unit (** Set the file name and line number of the [lexbuf] to be the start of the named file. *) diff --git a/test/location/attributes/dune b/test/location/attributes/dune new file mode 100644 index 000000000..9dd7e34ed --- /dev/null +++ b/test/location/attributes/dune @@ -0,0 +1,7 @@ +(executable + (name pp) + (libraries ppxlib)) + +(cram + (applies_to print_attr_loc) + (deps pp.exe)) diff --git a/test/location/attributes/pp.ml b/test/location/attributes/pp.ml new file mode 100644 index 000000000..65cb51025 --- /dev/null +++ b/test/location/attributes/pp.ml @@ -0,0 +1,18 @@ +open Ppxlib + +let pp_attr str = + let iter = + object + inherit Ast_traverse.iter as super + + method! attribute v = + let loc = loc_of_attribute v in + Format.printf "%a %s" Location.print loc v.attr_name.txt; + super#attribute v + end + in + iter#structure str; + str + +let () = Driver.register_transformation ~impl:pp_attr "print-attributes" +let () = Ppxlib.Driver.standalone () diff --git a/test/location/attributes/print_attr_loc.t b/test/location/attributes/print_attr_loc.t new file mode 100644 index 000000000..fdf31a93a --- /dev/null +++ b/test/location/attributes/print_attr_loc.t @@ -0,0 +1,15 @@ +The compiler inserts documentation comments with their location set to +`Location.none`. The value for `Location.none` has changed in the compiler (at +4.08.0). We provide a function, `loc_of_attribute` to handle deriving better location +errors for attributes with a none location. + + $ cat > test.ml << EOF + > let v = 1 + > (** A documentation comment! *) + > EOF + +We run an identity driver that prints the locations of attributes. + + $ ./pp.exe --impl test.ml -o ignore.ml + File "test.ml", line 2, characters 0-31: ocaml.doc +