From e42b8816697b8b18fe17e914d25e4cab6658a6b5 Mon Sep 17 00:00:00 2001
From: Hadley Wickham <h.wickham@gmail.com>
Date: Wed, 18 Mar 2026 12:38:51 -0500
Subject: [PATCH] Fix duplicated description for R6 classes with methods

The first bug arises because `parse_description()` thinks the method `@description` belongs to the class, so the second line of text becomes the details. There's no easy way to change this without significant changes to the parser, so the simplest approach seems to be to patch it up after the fact.

The second bug arises about because we were adding the default title twice.

Fixes #1504
---
 R/rd-r6-methods.R                 | 11 +++++----
 R/rd-r6.R                         | 35 ++++++++++++++++++++++++-----
 tests/testthat/_snaps/rd-r6.md    |  1 +
 tests/testthat/test-rd-r6-class.R | 37 +++++++++++++++++++++++++++++++
 4 files changed, 75 insertions(+), 9 deletions(-)

diff --git a/R/rd-r6-methods.R b/R/rd-r6-methods.R
index 89e45e70..f2f19a89 100644
--- a/R/rd-r6-methods.R
+++ b/R/rd-r6-methods.R
@@ -114,10 +114,13 @@ find_method_for_tag <- function(methods, tag) {
   if (nrow(methods) == 0) {
     return(NA_character_)
   }
-  w <- which(
-    basename(methods$file) == basename(tag$file) &
-      methods$line > tag$line
-  )[1]
+  if (tag$file == "<text>") {
+    # for testing
+    same_file <- TRUE
+  } else {
+    same_file <- basename(methods$file) == basename(tag$file)
+  }
+  w <- which(same_file & methods$line > tag$line)[1]
   methods$name[w]
 }
 
diff --git a/R/rd-r6.R b/R/rd-r6.R
index 9cc20398..1090008f 100644
--- a/R/rd-r6.R
+++ b/R/rd-r6.R
@@ -1,5 +1,6 @@
 topic_add_r6_methods <- function(rd, block, env, base_path) {
   docs <- r6_class_from_block(block, env)
+  block <- r6_fix_intro(block)
 
   # Add class-level tags
   for (tag in block$tags) {
@@ -20,22 +21,46 @@ topic_add_r6_methods <- function(rd, block, env, base_path) {
   }
 }
 
+# When an R6 class has inline @description tags for methods, parse_description()
+# parser puts the class description into @details instead of @description.
+# This function detects that case and promotes the class-level @details back
+# to @description.
+r6_fix_intro <- function(block) {
+  types <- map_chr(block$tags, \(t) r6_tag_type(t, block))
+  tags <- map_chr(block$tags, \(t) t$tag)
+
+  has_class_desc <- any(tags == "description" & types == "class")
+  has_class_details <- any(tags == "details" & types == "class")
+  has_method_desc <- any(tags == "description" & types == "method")
+
+  if (!has_class_desc && has_class_details && has_method_desc) {
+    # Promote the first class-level @details to @description
+    for (i in seq_along(block$tags)) {
+      if (tags[[i]] == "details" && types[[i]] == "class") {
+        block$tags[[i]]$tag <- "description"
+        break
+      }
+    }
+  }
+
+  block
+}
+
 # Classify an R6 block tag:
 # - "class": top-level Rd (e.g. @title, @description before class body)
 # - "method": inline tag associated with a method
 # - "other": @field/@param tags consumed by field/param extraction
 r6_tag_type <- function(tag, block) {
   inline <- !is.na(tag$line) && tag$line >= block$line
-  method_tags <- c(
-    "description", "details", "param", "return", "returns", "examples"
-  )
+  method_tags <- c("description", "details", "return", "returns", "examples")
 
-  if (tag$tag == "field") {
+  if (tag$tag %in% c("field", "name", "title")) {
     "other"
   } else if (tag$tag %in% method_tags && inline) {
     "method"
   } else if (tag$tag == "param") {
-    "other"
+    # class-level @param are used as defaults for all methods
+    if (inline) "method" else "other"
   } else {
     "class"
   }
diff --git a/tests/testthat/_snaps/rd-r6.md b/tests/testthat/_snaps/rd-r6.md
index 64586579..3d31bede 100644
--- a/tests/testthat/_snaps/rd-r6.md
+++ b/tests/testthat/_snaps/rd-r6.md
@@ -359,3 +359,4 @@
       
       }
       }
+
diff --git a/tests/testthat/test-rd-r6-class.R b/tests/testthat/test-rd-r6-class.R
index ae50105c..1a91a3fb 100644
--- a/tests/testthat/test-rd-r6-class.R
+++ b/tests/testthat/test-rd-r6-class.R
@@ -12,6 +12,43 @@ test_that("can construct empty class", {
   expect_equal(docs$active_bindings, rd_r6_bindings())
 })
 
+test_that("class description is not duplicated", {
+  text <- "
+    #' Title
+    #'
+    #' Description
+    foo <- R6::R6Class(
+      public = list(
+        #' @description foo
+        foo = function() {}
+      )
+    )
+  "
+
+  out <- roc_proc_text(rd_roclet(), text)[[1]]
+  expect_equal(out$get_value("description"), "Description")
+})
+
+test_that("title-only class has single description", {
+  out <- roc_proc_text(
+    rd_roclet(),
+    "
+    #' Title
+    foo <- R6::R6Class(cloneable = FALSE)
+  "
+  )[[1]]
+  expect_equal(out$get_value("description"), "Title")
+
+  out <- roc_proc_text(
+    rd_roclet(),
+    "
+    #' @title Title
+    foo <- R6::R6Class(cloneable = FALSE)
+  "
+  )[[1]]
+  expect_equal(out$get_value("description"), "Title")
+})
+
 test_that("class with only active bindings doesn't error (#1610)", {
   text <- "
     #' Class