Empty documentation comment (**)

This commit adds (**) as a special empty documentation comment that
can influence the attachment of other documentation comments but is
never emitted as an attribute in the parsetree. An important use of
this empty comment would be to attach a documentation comment to the
type t and not its last constructor Label, without spurious empty
attribute, in the following construction:

type t = Label (**)
(**doc for t*)

parsing/ast_helper.ml

@@ -188,9 +188,10 @@ module Sig = struct
   let extension ?loc ?(attrs = []) a = mk ?loc (Psig_extension (a, attrs))
   let attribute ?loc a = mk ?loc (Psig_attribute a)
   let text txt =
+    let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in
     List.map
       (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds))
-      txt
+      f_txt
 end
 
 module Str = struct
@@ -212,9 +213,10 @@ module Str = struct
   let extension ?loc ?(attrs = []) a = mk ?loc (Pstr_extension (a, attrs))
   let attribute ?loc a = mk ?loc (Pstr_attribute a)
   let text txt =
+    let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in
     List.map
       (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds))
-      txt
+      f_txt
 end
 
 module Cl = struct
@@ -266,9 +268,10 @@ module Ctf = struct
   let extension ?loc ?attrs a = mk ?loc ?attrs (Pctf_extension a)
   let attribute ?loc a = mk ?loc (Pctf_attribute a)
   let text txt =
-    List.map
+   let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in
+     List.map
       (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds))
-      txt
+      f_txt
 
   let attr d a = {d with pctf_attributes = d.pctf_attributes @ [a]}
 
@@ -291,9 +294,10 @@ module Cf = struct
   let extension ?loc ?attrs a = mk ?loc ?attrs (Pcf_extension a)
   let attribute ?loc a = mk ?loc (Pcf_attribute a)
   let text txt =
+    let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in
     List.map
       (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds))
-      txt
+      f_txt
 
   let virtual_ ct = Cfk_virtual ct
   let concrete o e = Cfk_concrete (o, e)

parsing/docstrings.ml

@@ -59,7 +59,7 @@ let warn_bad_docstrings () =
       (List.rev !docstrings)
 end
 
-(* Docstring constructors and descturctors *)
+(* Docstring constructors and destructors *)
 
 let docstring body loc =
   let ds =
@@ -100,17 +100,17 @@ let docs_attr ds =
 let add_docs_attrs docs attrs =
   let attrs =
     match docs.docs_pre with
-    | None -> attrs
+    | None | Some { ds_body=""; _ } -> attrs
     | Some ds -> docs_attr ds :: attrs
   in
   let attrs =
     match docs.docs_post with
-    | None -> attrs
+    | None | Some { ds_body=""; _ } -> attrs
     | Some ds -> attrs @ [docs_attr ds]
   in
   attrs
 
-(* Docstrings attached to consturctors or fields *)
+(* Docstrings attached to constructors or fields *)
 
 type info = docstring option
 
@@ -120,7 +120,7 @@ let info_attr = docs_attr
 
 let add_info_attrs info attrs =
   match info with
-  | None -> attrs
+  | None | Some {ds_body=""; _} -> attrs
   | Some ds -> attrs @ [info_attr ds]
 
 (* Docstrings not attached to a specifc item *)
@@ -145,7 +145,8 @@ let text_attr ds =
     (text_loc, PStr [item])
 
 let add_text_attrs dsl attrs =
-  (List.map text_attr dsl) @ attrs
+  let fdsl = List.filter (function {ds_body=""} -> false| _ ->true) dsl in
+  (List.map text_attr fdsl) @ attrs
 
 (* Find the first non-info docstring in a list, attach it and return it *)
 let get_docstring ~info dsl =

parsing/lexer.mll

@@ -413,7 +413,11 @@ rule token = parse
         let s, loc = with_comment_buffer comment lexbuf in
         COMMENT (s, loc) }
   | "(*" ('*'*) as stars "*)"
-      { COMMENT (stars, Location.curr lexbuf) }
+      { if !handle_docstrings && stars="(*" then
+         (* (**) is an empty docstring *)
+          DOCSTRING(Docstrings.docstring "" (Location.curr lexbuf))
+        else
+          COMMENT (stars, Location.curr lexbuf) }
   | "*)"
       { let loc = Location.curr lexbuf in
         Location.prerr_warning loc Warnings.Comment_not_end;

testsuite/tests/docstrings/Makefile

@@ -0,0 +1,4 @@
+
+BASEDIR=../..
+include $(BASEDIR)/makefiles/Makefile.dparsetree
+include $(BASEDIR)/makefiles/Makefile.common

testsuite/tests/docstrings/empty.ml

@@ -0,0 +1,8 @@
+type t = Label (**)
+(** attached to t *)
+
+(**)
+
+(** Empty docstring comments should not generate attributes *)
+
+type w (**)

testsuite/tests/docstrings/empty.ml.reference

@@ -0,0 +1,52 @@
+[
+  structure_item (empty.ml[1,0+0]..[1,0+14])
+    Pstr_type Rec
+    [
+      type_declaration "t" (empty.ml[1,0+5]..[1,0+6]) (empty.ml[1,0+0]..[1,0+14])
+        attribute "ocaml.doc"
+          [
+            structure_item (empty.ml[2,20+0]..[2,20+20])
+              Pstr_eval
+              expression (empty.ml[2,20+0]..[2,20+20])
+                Pexp_constant PConst_string(" attached to t ",None)
+          ]
+        ptype_params =
+          []
+        ptype_cstrs =
+          []
+        ptype_kind =
+          Ptype_variant
+            [
+              (empty.ml[1,0+9]..[1,0+14])
+                "Label" (empty.ml[1,0+9]..[1,0+14])
+                []
+                None
+            ]
+        ptype_private = Public
+        ptype_manifest =
+          None
+    ]
+  structure_item (empty.ml[6,48+0]..[6,48+62])
+    Pstr_attribute "ocaml.text"
+    [
+      structure_item (empty.ml[6,48+0]..[6,48+62])
+        Pstr_eval
+        expression (empty.ml[6,48+0]..[6,48+62])
+          Pexp_constant PConst_string(" Empty docstring comments should not generate attributes ",None)
+    ]
+  structure_item (empty.ml[8,112+0]..[8,112+6])
+    Pstr_type Rec
+    [
+      type_declaration "w" (empty.ml[8,112+5]..[8,112+6]) (empty.ml[8,112+0]..[8,112+6])
+        ptype_params =
+          []
+        ptype_cstrs =
+          []
+        ptype_kind =
+          Ptype_abstract
+        ptype_private = Public
+        ptype_manifest =
+          None
+    ]
+]
+