Improve support for comma separated fields

NAMESPACE

@@ -15,7 +15,6 @@ S3method(escape,"NULL")
 S3method(escape,character)
 S3method(escape,rd)
 S3method(format,object)
-S3method(format,rd_r6_bindings)
 S3method(format,rd_r6_class)
 S3method(format,rd_r6_field)
 S3method(format,rd_r6_fields)

NEWS.md

@@ -6,6 +6,7 @@
   * R6 method usage now shows `ClassName$new(args)` for constructors and `obj$method(args)` for other methods, making it clearer how each method is actually called (#1026).
   * `@returns` now works as a method-level tag in R6 classes, just like `@return` (#1148).
   * The "Super classes" section now omits the `pkg::` prefix for parent classes from the same package, making the inheritance chain easier to read (#1567).
+  * `@field` with comma-separated names (e.g., `@field var_1,var_2 description`) no longer produces spurious warnings about undocumented active bindings or unknown fields (#1600).
   * R6 classes with only active bindings and `cloneable = FALSE` no longer error during documentation (#1610).
   * `@example` (singular, with a file path) now works correctly in R6 class documentation (#1158).
   * Inherited method links now only link to parent classes that have documentation, avoiding broken links when parent classes are undocumented (#963, #1155).

R/rd-r6-class.R

@@ -2,8 +2,8 @@ rd_r6_class <- function(
   class,
   alias = class,
   superclasses = rd_r6_super(class),
-  fields = rd_r6_fields(),
-  active_bindings = rd_r6_bindings(),
+  fields = rd_r6_fields(type = "field"),
+  active_bindings = rd_r6_fields(type = "active"),
   methods = rd_r6_methods(alias)
 ) {
   structure(
@@ -38,8 +38,8 @@ r6_class_from_block <- function(block, env) {
     class = class,
     alias = alias,
     superclasses = r6_extract_superclasses(r6data, env, class),
-    fields = r6_extract_fields(block, r6data),
-    active_bindings = r6_extract_active_bindings(block, r6data),
+    fields = r6_extract_field_tags(block, r6data, type = "field"),
+    active_bindings = r6_extract_field_tags(block, r6data, type = "active"),
     methods = r6_extract_methods(r6data, alias, block)
   )
 }

R/rd-r6-field.R

@@ -1,81 +1,47 @@
-r6_extract_fields <- function(block, r6data) {
-  self <- r6data$self
-  fields <- self$name[self$type == "field"]
-  active <- self$name[self$type == "active"]
+r6_extract_field_tags <- function(block, r6data, type = c("field", "active")) {
+  type <- match.arg(type)
+  other_type <- if (type == "field") "active" else "field"
+  label <- if (type == "field") "field" else "active binding"
 
-  tags <- keep(
-    block$tags,
-    function(t) t$tag == "field" && !t$val$name %in% active
-  )
+  self <- r6data$self
+  expected <- self$name[self$type == type]
+  other <- self$name[self$type == other_type]
 
-  labels <- gsub(",", ", ", map_chr(tags, \(x) x[["val"]][["name"]]))
-  docd <- str_trim(unlist(strsplit(labels, ",")))
+  tags <- keep(block$tags, \(t) tag_is(t, "field") && !tag_has_name(t, other))
+  docd <- unlist(lapply(tags, tag_names))
 
-  miss <- setdiff(fields, docd)
+  miss <- setdiff(expected, docd)
   if (length(miss) > 0) {
-    warn_roxy_block(block, "Undocumented R6 field{?s}: {miss}")
+    warn_roxy_block(block, "Undocumented R6 {label}{?s}: {miss}")
   }
 
   dup <- unique(docd[duplicated(docd)])
   if (length(dup) > 0) {
-    warn_roxy_block(block, "R6 field{?s} documented multiple times: {dup}")
+    warn_roxy_block(block, "R6 {label}{?s} documented multiple times: {dup}")
   }
 
-  xtra <- setdiff(docd, fields)
-  if (length(xtra) > 0) {
-    warn_roxy_block(block, "Unknown R6 field{?s}: {xtra}")
+  if (type == "field") {
+    xtra <- setdiff(docd, expected)
+    if (length(xtra) > 0) {
+      warn_roxy_block(block, "Unknown R6 {label}{?s}: {xtra}")
+    }
   }
 
-  rd_r6_fields(lapply(tags, function(t) {
+  items <- lapply(tags, function(t) {
     rd_r6_field(
       name = gsub(",", ", ", t$val$name),
       description = t$val$description
     )
-  }))
-}
-
-r6_extract_active_bindings <- function(block, r6data) {
-  self <- r6data$self
-  fields <- self$name[self$type == "field"]
-  active <- self$name[self$type == "active"]
-
-  tags <- keep(
-    block$tags,
-    function(t) t$tag == "field" && !t$val$name %in% fields
-  )
-
-  labels <- gsub(",", ", ", map_chr(tags, \(x) x[["val"]][["name"]]))
-  docd <- str_trim(unlist(strsplit(labels, ",")))
+  })
 
-  miss <- setdiff(active, docd)
-  if (length(miss) > 0) {
-    warn_roxy_block(block, "Undocumented R6 active binding{?s}: {miss}")
-  }
-
-  dup <- unique(docd[duplicated(docd)])
-  if (length(dup) > 0) {
-    warn_roxy_block(
-      block,
-      "R6 active binding{?s} documented multiple times: {dup}"
-    )
-  }
-
-  rd_r6_bindings(lapply(tags, function(t) {
-    rd_r6_field(
-      name = gsub(",", ", ", t$val$name),
-      description = t$val$description
-    )
-  }))
+  rd_r6_fields(items, type = type)
 }
 
 # Rd ---------------------------------------------------------------------------
 
-rd_r6_fields <- function(fields = list()) {
-  structure(list(fields = fields), class = "rd_r6_fields")
-}
-
-rd_r6_bindings <- function(bindings = list()) {
-  structure(list(fields = bindings), class = "rd_r6_bindings")
+rd_r6_fields <- function(fields = list(), type = c("field", "active")) {
+  type <- match.arg(type)
+  structure(list(fields = fields, type = type), class = "rd_r6_fields")
 }
 
 rd_r6_field <- function(name, description) {
@@ -92,12 +58,11 @@ format.rd_r6_field <- function(x, ...) {
 
 #' @export
 format.rd_r6_fields <- function(x, ...) {
-  format_r6_field_section(x$fields, "Public fields", "r6-fields")
-}
-
-#' @export
-format.rd_r6_bindings <- function(x, ...) {
-  format_r6_field_section(x$fields, "Active bindings", "r6-active-bindings")
+  if (x$type == "field") {
+    format_r6_field_section(x$fields, "Public fields", "r6-fields")
+  } else {
+    format_r6_field_section(x$fields, "Active bindings", "r6-active-bindings")
+  }
 }
 
 format_r6_field_section <- function(fields, title, css_class) {

R/rd-r6-methods-self.R

@@ -146,9 +146,7 @@ r6_method_from_row <- function(method, block) {
 r6_resolve_params <- function(method, block) {
   tags <- method$tags[[1]]
   par <- keep(tags, \(t) t$tag == "param")
-  nms <- gsub(",", ", ", map_chr(par, \(x) x[["val"]][["name"]]))
-
-  mnames <- str_trim(unlist(strsplit(nms, ",")))
+  mnames <- unlist(lapply(par, tag_names))
   dup <- unique(mnames[duplicated(mnames)])
   for (m in dup) {
     warn_roxy_block(
@@ -172,21 +170,20 @@ r6_resolve_params <- function(method, block) {
     function(t) {
       !is.na(t$line) &&
         t$line < block$line &&
-        t$tag == "param" &&
-        t$val$name %in% miss
+        tag_is(t, "param") &&
+        tag_has_name(t, miss)
     }
   )
   par <- c(par, block$tags[is_in_cls])
 
   # For initialize(), inherit from @field tags for any still-missing params
   if (method$name == "initialize") {
-    nms <- gsub(",", ", ", map_chr(par, \(x) x[["val"]][["name"]]))
-    mnames <- str_trim(unlist(strsplit(nms, ",")))
+    mnames <- unlist(lapply(par, tag_names))
     miss <- setdiff(fnames, mnames)
 
     if (length(miss) > 0) {
       field_tags <- keep(block$tags, function(t) {
-        t$tag == "field" && t$val$name %in% miss
+        tag_is(t, "field") && tag_has_name(t, miss)
       })
       field_as_param <- lapply(field_tags, function(t) {
         val <- list(name = t$val$name, description = t$val$description)
@@ -197,8 +194,7 @@ r6_resolve_params <- function(method, block) {
   }
 
   # Check if anything is still missing
-  nms <- gsub(",", ", ", map_chr(par, \(x) x[["val"]][["name"]]))
-  mnames <- str_trim(unlist(strsplit(nms, ",")))
+  mnames <- unlist(lapply(par, tag_names))
   miss <- setdiff(fnames, mnames)
   for (m in miss) {
     warn_roxy_block(
@@ -211,8 +207,7 @@ r6_resolve_params <- function(method, block) {
   }
 
   # Order them according to formals
-  firstnames <- str_trim(
-    map_chr(strsplit(map_chr(par, \(x) x[["val"]][["name"]]), ","), \(x) x[[1]])
+  firstnames <- map_chr(par, \(t) tag_names(t)[[1]]
   )
   par <- par[order(match(firstnames, fnames))]
 

R/rd-r6.R

@@ -65,3 +65,15 @@ r6_tag_type <- function(tag, block) {
     "class"
   }
 }
+
+tag_is <- function(tag, name) {
+  tag$tag == name
+}
+
+tag_names <- function(tag) {
+  str_trim(strsplit(tag$val$name, ",")[[1]])
+}
+
+tag_has_name <- function(tag, names) {
+  any(tag_names(tag) %in% names)
+}

tests/testthat/_snaps/rd-r6-field.md

@@ -20,28 +20,14 @@
       x <text>:4: Undocumented R6 field: x.
       x <text>:4: Unknown R6 field: nosuch.
 
-# warns about undocumented active bindings
-
-    Code
-      docs <- r6_doc(text)
-    Message
-      x <text>:3: Undocumented R6 active binding: undocumented.
-
-# warns about active bindings documented multiple times
-
-    Code
-      docs <- r6_doc(text)
-    Message
-      x <text>:5: R6 active binding documented multiple times: b.
-
 # format.rd_r6_field produces \item markup
 
     Code
       cat(format(rd_r6_field("x", "A number.")))
     Output
       \item{\code{x}}{A number.}
 
-# format.rd_r6_fields produces Public fields section
+# format.rd_r6_fields produces fields & bindings sections
 
     Code
       cat(format(fields), sep = "\n")
@@ -56,7 +42,7 @@
         \if{html}{\out{</div>}}
       }
 
-# format.rd_r6_bindings produces Active bindings section
+---
 
     Code
       cat(format(bindings), sep = "\n")

tests/testthat/test-rd-r6-class.R

@@ -9,7 +9,7 @@ test_that("can construct empty class", {
   expect_s3_class(docs, "rd_r6_class")
   expect_equal(docs$methods, rd_r6_methods("C"))
   expect_equal(docs$fields, rd_r6_fields())
-  expect_equal(docs$active_bindings, rd_r6_bindings())
+  expect_equal(docs$active_bindings, rd_r6_fields(type = "active"))
 })
 
 test_that("class description is not duplicated", {
@@ -92,7 +92,7 @@ test_that("format.rd_r6_class with fields", {
 test_that("format.rd_r6_class with active bindings", {
   docs <- rd_r6_class(
     class = "Foo",
-    active_bindings = rd_r6_bindings(list(rd_r6_field("val", "A value.")))
+    active_bindings = rd_r6_fields(list(rd_r6_field("val", "A value.")), type = "active")
   )
   expect_snapshot(cat(format(docs), sep = "\n"))
 })