Match compilers dummy loc

CHANGES.md

@@ -32,6 +32,11 @@ details.
 - Support class type declarations in derivers with the new, optional arguments
   `{str,sig}_class_type_decl` in `Deriving.add` (#538, @patricoferris)
 
+- Change `Location.none` to match the compiler's `Location.none` as of OCaml
+  4.08. Also provide `Location.is_none` which checks if a location is none for
+  all versions of the compiler we support. This has been used to fix a bug in
+  `loc_of_attribute` (#540, @ncik-roberts, @patricoferris)
+
 0.33.0 (2024-07-22)
 -------------------
 

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 }
 

src/location.ml

@@ -8,7 +8,7 @@ type t = location = {
 }
 
 let in_file name =
-  let loc = { pos_fname = name; pos_lnum = 1; pos_bol = 0; pos_cnum = -1 } in
+  let loc = { pos_fname = name; pos_lnum = 0; pos_bol = 0; pos_cnum = -1 } in
   { loc_start = loc; loc_end = loc; loc_ghost = true }
 
 let set_filename loc fn =
@@ -18,6 +18,15 @@ let set_filename loc fn =
 
 let none = in_file "_none_"
 
+(* Can be removed once ppxlib only supports 4.08.0+ *)
+let none_4_07_and_less =
+  let loc =
+    { pos_fname = "_none_"; pos_lnum = 1; 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_07_and_less
+
 let init lexbuf fname =
   let open Lexing in
   lexbuf.lex_curr_p <-

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. *)

test/location/attributes/dune

@@ -0,0 +1,7 @@
+(executable
+ (name pp)
+ (libraries ppxlib))
+
+(cram
+ (applies_to print_attr_loc)
+ (deps pp.exe))

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 ()

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
+