diff --git a/R/tomarkdown.R b/R/tomarkdown.R index aba236f..6ee5170 100644 --- a/R/tomarkdown.R +++ b/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] diff --git a/R/utils.R b/R/utils.R index de08711..c537bed 100644 --- a/R/utils.R +++ b/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( diff --git a/R/writers.R b/R/writers.R index 73496f0..7f6e04b 100644 --- a/R/writers.R +++ b/R/writers.R @@ -167,6 +167,9 @@ write_parts <- function( for (i in names(table_to_insert)){ table_to_insert[, i] <- gsub("\\$", "$", 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() diff --git a/dev/SUIVI_ISSUES.md b/dev/SUIVI_ISSUES.md new file mode 100644 index 0000000..c48d86d --- /dev/null +++ b/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. | diff --git a/tests/testthat/test-empty_test.R b/tests/testthat/test-empty_test.R new file mode 100644 index 0000000..6aab2cb --- /dev/null +++ b/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)) +}) diff --git a/tests/testthat/test-get_desc.R b/tests/testthat/test-get_desc.R new file mode 100644 index 0000000..aae0711 --- /dev/null +++ b/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, " ") +}) diff --git a/tests/testthat/test-sanitize_kable_cell.R b/tests/testthat/test-sanitize_kable_cell.R new file mode 100644 index 0000000..8d1cbc0 --- /dev/null +++ b/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()) +})