diff --git a/R/rd-r6-methods.R b/R/rd-r6-methods.R index be8761ad..a66f54e1 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 == "") { + # 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 4543619d..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,27 +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" - ) - - if (tag$tag == "field") { + method_tags <- c("description", "details", "return", "returns", "examples") + + 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/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