fix: 3 testdown issues — get_desc multiline (#18), kable bleed (#4), empty test_that (#15)

R/tomarkdown.R

@@ -124,9 +124,17 @@ test_down <- function(
     unname() %>%
     unlist()
 
-  were_skipped <- which(
-    ! basename(names(all_tests_read)) %in% .tr$df$location
-  )
+  # An empty test_that() body produces no `expect_*` line, so
+  # `all_tests_read` ends up as a zero-length character vector with no
+  # names — `basename(NULL)` would then error out (#15). Guard the lookup.
+  if (is.null(all_tests_read) || !length(all_tests_read)) {
+    all_tests_read <- stats::setNames(character(), character())
+    were_skipped <- integer()
+  } else {
+    were_skipped <- which(
+      ! basename(names(all_tests_read)) %in% .tr$df$location
+    )
+  }
 
   were_skipped_df <- build_were_skipped(
     were_skipped = all_tests_read[were_skipped]

R/utils.R

@@ -104,22 +104,71 @@ get_desc <- function(
   fls <- readLines(normalizePath(attr(result$srcref, "srcfile")$filename))
   parsed <- parse_text(fls, NULL)
   tags <- map(parsed, "tags") %>% flatten()
-  lines <- keep(
-    tags,
-    map(tags, "line") == result$srcref[1] - 1
+  expectation_line <- result$srcref[1]
+
+  # Scope the search to the current test_that() block so a description
+  # belonging to a previous test_that doesn't bleed into this one — found
+  # while reviewing my own #18 fix. The block starts at the most recent
+  # line at or above `expectation_line` that opens a test_that() call.
+  block_start <- find_test_that_start(fls, expectation_line)
+
+  # Pick the closest @description tag *above* this expectation, but
+  # within the same test_that block. Previously the code only looked
+  # exactly 1 or 2 lines above, which missed descriptions placed further
+  # up (e.g. before intermediate setup calls inside the same block).
+  tag_lines <- vapply(tags, function(x) x$line %||% NA_integer_, integer(1))
+  candidates_idx <- which(
+    !is.na(tag_lines) &
+      tag_lines < expectation_line &
+      tag_lines >= block_start
   )
-  if (!length(lines)){
-    lines <- keep(
-      tags,
-      map(tags, "line") == result$srcref[1] - 2
-    )
-  }
-  if (length(lines)){
-    lines[[1]]$val
+  if (length(candidates_idx)) {
+    nearest <- candidates_idx[which.max(tag_lines[candidates_idx])]
+    val <- tags[[nearest]]$val
+    # A multi-line description would otherwise carry a literal newline
+    # into the kable cell and spill the trailing portion onto the wrong
+    # column (#18). Collapse any inner newlines into a single space.
+    gsub("[[:space:]]*\n[[:space:]]*", " ", val)
   } else {
     " "
   }
+}
+
+#' Find the line number of the most recent `test_that(` call at or above
+#' `line` in `fls`. Returns `1L` (start-of-file) when none is found, which
+#' lets `get_desc()` fall back to file-scope behaviour.
+#'
+#' @param fls character vector, the file's lines.
+#' @param line integer, current expectation line.
+#' @noRd
+find_test_that_start <- function(fls, line) {
+  if (line < 1L || !length(fls)) return(1L)
+  upper <- min(line, length(fls))
+  for (i in upper:1L) {
+    if (grepl("\\btest_that\\s*\\(", fls[i])) return(i)
+  }
+  1L
+}
+
+# tiny null-coalescer for older R / safer reads
+`%||%` <- function(a, b) if (is.null(a)) b else a
 
+#' Sanitize a string for inclusion in a kable cell.
+#'
+#' kable interprets a double newline as a paragraph break, which spills the
+#' tail of the cell onto the next row of the rendered table (#4). Collapse
+#' consecutive blank lines to a single newline before passing the value
+#' through.
+#'
+#' @param x character vector.
+#' @return character vector, same length, safe to drop into a kable cell.
+#' @noRd
+sanitize_kable_cell <- function(x) {
+  if (!length(x)) return(x)
+  out <- gsub("\r\n", "\n", x, fixed = TRUE)
+  # Collapse runs of blank lines into a single newline.
+  out <- gsub("(\n[[:blank:]]*){2,}", "\n", out)
+  out
 }
 
 cat_if_verbose <- function(

R/writers.R

@@ -167,6 +167,9 @@ write_parts <- function(
 
     for (i in names(table_to_insert)){
       table_to_insert[, i] <- gsub("\\$", "&#36;", table_to_insert[, i])
+      # Collapse blank lines so kable does not spill the tail of a cell
+      # onto the next table row (#4).
+      table_to_insert[, i] <- sanitize_kable_cell(table_to_insert[, i])
     }
 
     write_in()

dev/SUIVI_ISSUES.md

@@ -0,0 +1,55 @@
+# Suivi — passe `fix/multiple-issues`
+
+Méthodologie : test unitaire qui plante d'abord, puis correctif minimal,
+puis commit.
+
+## Issues traitées
+
+### #18 — `get_desc()` ne suit pas une description multilignes / placée plus loin
+Le code regardait uniquement les lignes `srcref - 1` et `srcref - 2`, donc
+une description placée 3+ lignes au-dessus (par ex. avant un `setup()`
+intermédiaire) n'était pas trouvée. De plus, une description sur 2 lignes
+(`#'` continué) injectait un `\n` brut dans la cellule kable, qui spillait
+le morceau suivant sur la ligne d'après du tableau.
+
+- **Test** : `tests/testthat/test-get_desc.R` — 4 cas (description sur 2
+  lignes, description distante, pas de description, comportement par
+  défaut).
+- **Fix** : `get_desc()` cherche maintenant le tag `@description` *le plus
+  proche au-dessus* de l'expectation, et collapse tout `\n` interne en
+  espace.
+- **Commit** : `fix(get_desc): handle multiline & distant descriptions (#18)`
+
+### #15 — `test_down()` plante si un `test_that()` est vide
+Quand un `test_that("x", {})` ne contient aucun `expect_*`, le pipe sur
+`all_tests_read` retourne un `character(0)` sans noms. La ligne
+`basename(names(all_tests_read))` plantait avec
+`a character vector argument expected`.
+
+- **Test** : `tests/testthat/test-empty_test.R` — paquet jetable avec un
+  unique `test_that` vide ; `test_down()` doit retourner sans erreur.
+- **Fix** : garde l'intermédiaire à un `setNames(character(), character())`
+  quand il est vide, et `were_skipped <- integer()` au lieu de `which()`
+  sur un `NULL`.
+- **Commit** : `fix(test_down): tolerate empty test_that bodies (#15)`
+
+### #4 — Texte qui sort des tableaux (kable + double saut de ligne)
+Un message contenant `\n\n` cassait la cellule kable parce que pandoc le
+parse comme un saut de paragraphe et termine la ligne du tableau.
+
+- **Test** : `tests/testthat/test-sanitize_kable_cell.R` — 5 cas
+  (collapse, lignes blanches multiples, CRLF Windows, vectorisation,
+  vide).
+- **Fix** : helper `sanitize_kable_cell()` (gsub des suites de
+  `\n[blank]*\n` en un seul `\n`) appliqué sur chaque colonne avant
+  `kable()`.
+- **Commit** : `fix(write_parts): collapse blank lines inside table cells (#4)`
+
+## Issues envisagées mais non traitées dans cette passe
+
+| # | Pourquoi pas |
+|---|---|
+| #16 | Détecter `expected` comme variable plutôt que comme fixture demande de re-typer la sortie d'un test ; à arbitrer avec mainteneur. |
+| #14 | Affichage de la couverture nécessite intégration avec `covr` — feature, demande design. |
+| #12 | Intégration pkgdown — infra, demande design. |
+| #10 | Préparation CRAN — meta. |

tests/testthat/test-empty_test.R

@@ -0,0 +1,34 @@
+test_that("test_down() does not error on a package whose only test_that is empty (#15)", {
+  skip_if_not_installed("withr")
+
+  pkg_root <- tempfile(pattern = "pkg-")
+  dir.create(pkg_root)
+  on.exit(unlink(pkg_root, recursive = TRUE), add = TRUE)
+  file.copy(
+    system.file("fake.package", package = "testdown"),
+    pkg_root,
+    recursive = TRUE
+  )
+  fake_pkg <- file.path(pkg_root, "fake.package")
+  testthat_dir <- file.path(fake_pkg, "tests", "testthat")
+  unlink(list.files(testthat_dir, full.names = TRUE))
+  writeLines(
+    c(
+      'test_that("my_fun works", {',
+      '})'
+    ),
+    file.path(testthat_dir, "test-empty.R")
+  )
+
+  book <- tempfile(pattern = "testdown-")
+
+  expect_error(
+    suppressMessages(suppressWarnings(
+      withr::with_dir(fake_pkg, {
+        test_down(pkg = ".", open = FALSE, book_path = book)
+      })
+    )),
+    NA  # i.e., no error
+  )
+  expect_true(file.exists(book))
+})

tests/testthat/test-get_desc.R

@@ -0,0 +1,79 @@
+# Tests for get_desc() — covers issues #18 (multiline / non-immediate
+# description) and an indirect impact on the table rendering.
+#
+# We exercise get_desc() by emulating the result list it consumes.
+# A `result` is a named list with `$srcref` (numeric line refs +
+# `srcfile` attribute pointing at a real file).
+
+make_fake_result <- function(file, line) {
+  ref <- c(line, 1L, line, 1L)
+  attr(ref, "srcfile") <- list(filename = file)
+  list(srcref = ref)
+}
+
+write_fixture <- function(lines) {
+  path <- tempfile(fileext = ".R")
+  writeLines(lines, path)
+  path
+}
+
+test_that("get_desc() collapses newlines inside a description into spaces (#18)", {
+  path <- write_fixture(c(
+    "test_that(\"two-line desc\", {",
+    "  #' @description This description spans",
+    "  #' two lines",
+    "  expect_true(TRUE)",
+    "})"
+  ))
+  on.exit(unlink(path), add = TRUE)
+  res <- make_fake_result(path, line = 4L)
+  desc <- get_desc(res)
+  expect_false(grepl("\n", desc, fixed = TRUE),
+               info = "get_desc() must not return a newline (would break the kable cell)")
+  expect_match(desc, "spans two lines", fixed = TRUE)
+})
+
+test_that("get_desc() finds a description that is more than two lines above (#18)", {
+  path <- write_fixture(c(
+    "test_that(\"distant desc\", {",
+    "  #' @description Top-level description",
+    "  some_intermediate_call()",
+    "  another_call()",
+    "  expect_true(TRUE)",
+    "})"
+  ))
+  on.exit(unlink(path), add = TRUE)
+  res <- make_fake_result(path, line = 5L)
+  desc <- get_desc(res)
+  expect_match(desc, "Top-level description", fixed = TRUE)
+})
+
+test_that("get_desc() does not bleed a description across test_that blocks (self-review of #18)", {
+  path <- write_fixture(c(
+    "test_that(\"first test with desc\", {",
+    "  #' @description Description for the FIRST test only",
+    "  expect_true(TRUE)",
+    "})",
+    "",
+    "test_that(\"second test without desc\", {",
+    "  expect_true(TRUE)",
+    "})"
+  ))
+  on.exit(unlink(path), add = TRUE)
+  res <- make_fake_result(path, line = 7L) # second test's expect line
+  desc <- get_desc(res)
+  expect_equal(desc, " ",
+    info = "second test_that has no description and must NOT inherit the first test's")
+})
+
+test_that("get_desc() returns ' ' when there is no description tag", {
+  path <- write_fixture(c(
+    "test_that(\"no desc\", {",
+    "  expect_true(TRUE)",
+    "})"
+  ))
+  on.exit(unlink(path), add = TRUE)
+  res <- make_fake_result(path, line = 2L)
+  desc <- get_desc(res)
+  expect_equal(desc, " ")
+})

tests/testthat/test-sanitize_kable_cell.R

@@ -0,0 +1,43 @@
+test_that("sanitize_kable_cell collapses blank lines (#4)", {
+  expect_equal(
+    sanitize_kable_cell("a\n\nb"),
+    "a\nb"
+  )
+  expect_equal(
+    sanitize_kable_cell("a\n\n\nb"),
+    "a\nb"
+  )
+  expect_equal(
+    sanitize_kable_cell("a\n   \n   \nb"),
+    "a\nb"
+  )
+})
+
+test_that("sanitize_kable_cell normalises Windows line endings", {
+  expect_equal(
+    sanitize_kable_cell("a\r\nb"),
+    "a\nb"
+  )
+  expect_equal(
+    sanitize_kable_cell("a\r\n\r\nb"),
+    "a\nb"
+  )
+})
+
+test_that("sanitize_kable_cell leaves a single newline alone", {
+  expect_equal(
+    sanitize_kable_cell("a\nb"),
+    "a\nb"
+  )
+})
+
+test_that("sanitize_kable_cell vectorises", {
+  expect_equal(
+    sanitize_kable_cell(c("a\n\nb", "c\nd", "e")),
+    c("a\nb", "c\nd", "e")
+  )
+})
+
+test_that("sanitize_kable_cell handles zero-length input", {
+  expect_equal(sanitize_kable_cell(character()), character())
+})