From e1ebf0d5fc5fff59fd493fa35913420f2cbcf13f Mon Sep 17 00:00:00 2001 From: Surrey Date: Fri, 21 Aug 2026 09:08:38 +1000 Subject: [PATCH 1/5] test(createcustomtable): cover row.spans rendering, styling, and CSS class sharing Add test_that blocks for CreateCustomTable's row.spans argument: default no-op, per-span rowspan cells with correct heights/labels/row offsets, per-span class appending, styling arguments reaching the generated CSS, the extra header cell, and unvalidated mismatched-height behaviour. Two production behaviours diverge from the plan's assumptions and are pinned with comments rather than fixed: addCSSclass only creates a single shared "rowspandefault1" class (not one per span) when sticky positioning is inactive because the CSS string passed in is scalar, not vectorised to row.spans length; and adding row.spans increases the sticky-position count by 1 rather than reducing it, since the rm.index pruning only trims the row-span column's own top.position vector. Co-Authored-By: Claude Opus 4.8 (1M context) --- tests/testthat/test-createcustomtable.R | 149 ++++++++++++++++++++++++ 1 file changed, 149 insertions(+) diff --git a/tests/testthat/test-createcustomtable.R b/tests/testthat/test-createcustomtable.R index 2ea6b69..794596a 100644 --- a/tests/testthat/test-createcustomtable.R +++ b/tests/testthat/test-createcustomtable.R @@ -275,3 +275,152 @@ test_that("use.predefined.css = FALSE leaves the spacer header cell with no matc resDefault <- CreateCustomTable(m4, show.row.headers = FALSE, spacer.col = 2) expect_true(grepl('.spacer {', tableHtml(resDefault), fixed = TRUE)) }) + +# row.spans -------------------------------------------------------------- + +# the documented @examples matrix; heights in the tests below are chosen to sum to nrow (4) +# unless the scenario is deliberately exercising mismatched heights +rowSpanMatrix <- structure(1:24, .Dim = c(4L, 6L), + .Dimnames = list(c("a", "b", "c", "d"), c("A", "B", "C", "D", "E", "F"))) + +test_that("Default emits no rowspan cells", +{ + res <- CreateCustomTable(x2) + expect_false(grepl("rowspan=", tableHtml(res), fixed = TRUE)) +}) + +test_that("One rowspan cell per span, with the right heights and labels", +{ + spans <- list(list(height = 2, label = "AA"), list(height = 1, label = "BB"), + list(height = 1, label = "CC")) + res <- CreateCustomTable(rowSpanMatrix, row.spans = spans) + h <- tableHtml(res) + # anchored with the trailing quote so rowspan="1" cannot match rowspan="10"-style values + expect_equal(countOccurrences('', h), 1) + expect_equal(countOccurrences('', h), 2) + expect_true(grepl('AA', h, fixed = TRUE)) + expect_true(grepl('BB', h, fixed = TRUE)) + expect_true(grepl('CC', h, fixed = TRUE)) +}) + +test_that("Spans are placed at the correct row offsets", +{ + # heights of 2, 1, 1 mean AA's span covers rows 1-2 (leaving row 2 without its own span + # cell), BB opens row 3 and CC opens row 4 - pinning the j <- j + row.span.lengths[i] loop + spans <- list(list(height = 2, label = "AA"), list(height = 1, label = "BB"), + list(height = 1, label = "CC")) + res <- CreateCustomTable(rowSpanMatrix, row.spans = spans) + h <- tableHtml(res) + body <- sub(".*", "", h) + rows <- regmatches(body, gregexpr(".*?", body))[[1]] + expect_equal(length(rows), 4) + expect_true(grepl('BB', rows[3], fixed = TRUE)) + expect_true(grepl('CC', rows[4], fixed = TRUE)) +}) + +test_that("A single rowspandefault CSS class is shared across all spans (production behaviour, not one class per span)", +{ + # PRODUCTION BUG (reported, not fixed here): createcustomtable.R passes a scalar + # (non length-vectorised) CSS string into addCSSclass() for row.spans, unlike the + # cell/row-header blocks which explicitly rep() their string to the element count first. + # addCSSclass() derives the number of classes it creates from length(class.css), so it + # only ever creates ONE "rowspandefault1" class here, which every span's then reuses - + # not "rowspandefault1..N" as the plan's method summary assumed. Pinning the actual + # behaviour; a defect should be filed separately against createcustomtable.R (row.spans block). + spans <- list(list(height = 2, label = "AA"), list(height = 1, label = "BB"), + list(height = 1, label = "CC")) + res <- CreateCustomTable(rowSpanMatrix, row.spans = spans) + h <- normWs(tableHtml(res)) + # trailing "{" anchors the declaration itself, distinct from the "rowspandefault1" token + # that also appears (twice more) inside every span's class attribute + expect_equal(countOccurrences(".rowspandefault1{", h), 1) + expect_equal(countOccurrences(".rowspandefault2{", h), 0) + expect_equal(countOccurrences('class="rowspandefault1">', h), 3) +}) + +test_that("A per-span class is appended, not substituted", +{ + spans <- list(list(height = 2, label = "AA", class = "bluefill"), + list(height = 1, label = "BB"), list(height = 1, label = "CC")) + res <- CreateCustomTable(rowSpanMatrix, row.spans = spans) + h <- tableHtml(res) + expect_true(grepl('AA', h, fixed = TRUE)) +}) + +test_that("A span without a class entry carries only the generated class", +{ + spans <- list(list(height = 2, label = "AA", class = "bluefill"), + list(height = 1, label = "BB"), list(height = 1, label = "CC")) + res <- CreateCustomTable(rowSpanMatrix, row.spans = spans) + h <- tableHtml(res) + # exact match (no trailing token/space) confirms nothing was appended for BB + expect_true(grepl('BB', h, fixed = TRUE)) +}) + +test_that("Span styling arguments reach the rowspandefault CSS declaration", +{ + spans <- list(list(height = 2, label = "AA"), list(height = 1, label = "BB"), + list(height = 1, label = "CC")) + res <- CreateCustomTable(rowSpanMatrix, row.spans = spans, row.span.fill = "rgb(9,9,9)", + row.span.font.size = 21, row.span.align.horizontal = "right") + h <- normWs(tableHtml(res)) + expect_true(grepl("background: rgb(9,9,9)", h, fixed = TRUE)) + expect_true(grepl("font-size: 21px", h, fixed = TRUE)) + expect_true(grepl("text-align: right", h, fixed = TRUE)) +}) + +test_that("row.spans prepends an extra header cell (ncol + 2 th cells)", +{ + spans <- list(list(height = 2, label = "AA"), list(height = 1, label = "BB"), + list(height = 1, label = "CC")) + res <- CreateCustomTable(rowSpanMatrix, row.spans = spans) + h <- tableHtml(res) + thead <- sub(".*", "", h) + ths <- regmatches(thead, gregexpr('[^<]*', thead))[[1]] + # 6 data columns + row-header corner + row-span corner + expect_equal(length(ths), 8) + expect_equal(ths[1], '') + expect_equal(ths[2], '') +}) + +test_that("Adding row.spans increases (does not reduce) the emitted sticky-position count", +{ + # PLAN DEVIATION: the plan expected the rm.index pruning at the top of the row.spans + # block to REDUCE the sticky-position count relative to the no-spans case. In practice + # that pruning only trims the top.position vector fed into the row-span column's OWN + # addCSSclass() call; the cell/row-header sticky counts (computed earlier in the + # function) are unaffected. Because the row-span column also gets a "position: sticky" + # class of its own, adding row.spans increases the total sticky count by 1 (for + # num.header.rows = 1, the minimal combination) rather than decreasing it. Pinning + # the actual, confirmed behaviour instead of the plan's assumption. + spans <- list(list(height = 2, label = "AA"), list(height = 1, label = "BB"), + list(height = 1, label = "CC")) + noSpans <- CreateCustomTable(rowSpanMatrix, row.height = "30px", num.header.rows = 1) + withSpans <- CreateCustomTable(rowSpanMatrix, row.height = "30px", num.header.rows = 1, + row.spans = spans) + countNoSpans <- countOccurrences("position: sticky", tableHtml(noSpans)) + countWithSpans <- countOccurrences("position: sticky", tableHtml(withSpans)) + expect_equal(countWithSpans, countNoSpans + 1) +}) + +test_that("Span heights not summing to nrow are pinned to current (unvalidated) behaviour", +{ + # under-covering: heights sum to 2 against nrow = 4, so rows 3-4 simply get no span cell + spans <- list(list(height = 1, label = "AA"), list(height = 1, label = "BB")) + res <- CreateCustomTable(rowSpanMatrix, row.spans = spans) + h <- tableHtml(res) + body <- sub(".*", "", h) + rows <- regmatches(body, gregexpr(".*?", body))[[1]] + expect_equal(length(rows), 4) + expect_true(grepl('AA', rows[1], fixed = TRUE)) + expect_true(grepl('BB', rows[2], fixed = TRUE)) + expect_false(grepl("rowspan", rows[3], fixed = TRUE)) + expect_false(grepl("rowspan", rows[4], fixed = TRUE)) + + # over-covering: a single span with a height greater than nrow completes without error; + # there is no bounds check in the j <- j + row.span.lengths[i] loop + overSpans <- list(list(height = 10, label = "AA")) + expect_error(CreateCustomTable(rowSpanMatrix, row.spans = overSpans), NA) +}) From 5362472d6ee9f182e426e42ea025182c0ce2ea34 Mon Sep 17 00:00:00 2001 From: Surrey Date: Fri, 21 Aug 2026 09:35:22 +1000 Subject: [PATCH 2/5] fix(test): tighten row.spans test assertions per review - Add num.header.rows = 2 case that actually exercises the rm.index pruning branch (front-loaded vs back-loaded span heights), since the existing nhr = 1 case is a no-op for that branch. - Correct the "single shared CSS class" test: drop the false production-bug claim (it's addCSSclass() only expanding class.css into a matrix when `position` is non-NULL) and add a sticky-path counterpart asserting each span gets its own class. - Pin the single-span over-cover case's actual output (rowspan="10", 4 body rows) and add a multi-span over-cover case pinning the real cbind() misalignment defect under expect_warning. - Make the extra-header-cell corner assertions discriminating via corner = "RH", and anchor the styling-passthrough assertions to the .rowspandefault1{...} declaration body instead of the whole document. - Fix a stale comment that didn't match its assertion's count. Co-Authored-By: Claude Opus 4.8 (1M context) --- tests/testthat/test-createcustomtable.R | 111 ++++++++++++++++++++---- 1 file changed, 94 insertions(+), 17 deletions(-) diff --git a/tests/testthat/test-createcustomtable.R b/tests/testthat/test-createcustomtable.R index 794596a..cfd5bba 100644 --- a/tests/testthat/test-createcustomtable.R +++ b/tests/testthat/test-createcustomtable.R @@ -320,26 +320,41 @@ test_that("Spans are placed at the correct row offsets", expect_true(grepl('CC', rows[4], fixed = TRUE)) }) -test_that("A single rowspandefault CSS class is shared across all spans (production behaviour, not one class per span)", -{ - # PRODUCTION BUG (reported, not fixed here): createcustomtable.R passes a scalar - # (non length-vectorised) CSS string into addCSSclass() for row.spans, unlike the - # cell/row-header blocks which explicitly rep() their string to the element count first. - # addCSSclass() derives the number of classes it creates from length(class.css), so it - # only ever creates ONE "rowspandefault1" class here, which every span's then reuses - - # not "rowspandefault1..N" as the plan's method summary assumed. Pinning the actual - # behaviour; a defect should be filed separately against createcustomtable.R (row.spans block). +test_that("A single rowspandefault CSS class is shared across all spans when sticky positioning is off", +{ + # NOT a production bug: addCSSclass() only expands class.css into a per-row/per-column + # matrix when its `position` argument is non-NULL (see addCSSclass() in + # createcustomtable.R). Here row.height/num.header.rows are not set, so top.position is + # NULL and the row-span block's scalar CSS string is never expanded - addCSSclass() + # derives its class count from length(class.css), so it creates a single + # "rowspandefault1" class that every span's reuses. (The row-header block passes an + # equally unrepped scalar; it only ends up with one class per row because its call always + # supplies a non-NULL `position`.) On the sticky path (see the next test) each span DOES + # get its own "rowspandefaultN" class, matching the plan's expectation. spans <- list(list(height = 2, label = "AA"), list(height = 1, label = "BB"), list(height = 1, label = "CC")) res <- CreateCustomTable(rowSpanMatrix, row.spans = spans) h <- normWs(tableHtml(res)) # trailing "{" anchors the declaration itself, distinct from the "rowspandefault1" token - # that also appears (twice more) inside every span's class attribute + # that also appears (three times, once in each span's class attribute) expect_equal(countOccurrences(".rowspandefault1{", h), 1) expect_equal(countOccurrences(".rowspandefault2{", h), 0) expect_equal(countOccurrences('class="rowspandefault1">', h), 3) }) +test_that("Each span gets its own rowspandefault CSS class when sticky positioning is on", +{ + # With row.height/num.header.rows set, top.position is non-NULL, so addCSSclass() + # expands the row-span CSS string into one class per span (rowspandefault1/2/3) instead + # of sharing a single class - the counterpart to the sticky-off case above. + spans <- list(list(height = 2, label = "AA"), list(height = 1, label = "BB"), + list(height = 1, label = "CC")) + res <- CreateCustomTable(rowSpanMatrix, row.height = "30px", num.header.rows = 1, + row.spans = spans) + h <- normWs(tableHtml(res)) + expect_equal(countOccurrences(".rowspandefault3{", h), 1) +}) + test_that("A per-span class is appended, not substituted", { spans <- list(list(height = 2, label = "AA", class = "bluefill"), @@ -366,23 +381,28 @@ test_that("Span styling arguments reach the rowspandefault CSS declaration", res <- CreateCustomTable(rowSpanMatrix, row.spans = spans, row.span.fill = "rgb(9,9,9)", row.span.font.size = 21, row.span.align.horizontal = "right") h <- normWs(tableHtml(res)) - expect_true(grepl("background: rgb(9,9,9)", h, fixed = TRUE)) - expect_true(grepl("font-size: 21px", h, fixed = TRUE)) - expect_true(grepl("text-align: right", h, fixed = TRUE)) + # anchor to the rowspandefault1 declaration itself, not just anywhere in the document, + # so the assertions cannot be satisfied by an unrelated CSS rule + block <- regmatches(h, regexpr(".rowspandefault1[{][^}]*[}]", h)) + expect_true(grepl("background: rgb(9,9,9)", block, fixed = TRUE)) + expect_true(grepl("font-size: 21px", block, fixed = TRUE)) + expect_true(grepl("text-align: right", block, fixed = TRUE)) }) test_that("row.spans prepends an extra header cell (ncol + 2 th cells)", { spans <- list(list(height = 2, label = "AA"), list(height = 1, label = "BB"), list(height = 1, label = "CC")) - res <- CreateCustomTable(rowSpanMatrix, row.spans = spans) + # a distinct corner label lets ths[1] (row-span corner, always blank) and ths[2] + # (row-header corner, carries `corner`) be told apart even if their order were swapped + res <- CreateCustomTable(rowSpanMatrix, row.spans = spans, corner = "RH") h <- tableHtml(res) thead <- sub(".*", "", h) ths <- regmatches(thead, gregexpr('[^<]*', thead))[[1]] # 6 data columns + row-header corner + row-span corner expect_equal(length(ths), 8) expect_equal(ths[1], '') - expect_equal(ths[2], '') + expect_equal(ths[2], 'RH') }) test_that("Adding row.spans increases (does not reduce) the emitted sticky-position count", @@ -395,6 +415,9 @@ test_that("Adding row.spans increases (does not reduce) the emitted sticky-posit # class of its own, adding row.spans increases the total sticky count by 1 (for # num.header.rows = 1, the minimal combination) rather than decreasing it. Pinning # the actual, confirmed behaviour instead of the plan's assumption. + # NOTE: at num.header.rows = 1, top.position has length 1, so the rm.index pruning's + # `[-rm.index]` is a no-op regardless of span heights - this case does not exercise the + # pruning branch at all. See the num.header.rows = 2 case below for that. spans <- list(list(height = 2, label = "AA"), list(height = 1, label = "BB"), list(height = 1, label = "CC")) noSpans <- CreateCustomTable(rowSpanMatrix, row.height = "30px", num.header.rows = 1) @@ -405,6 +428,28 @@ test_that("Adding row.spans increases (does not reduce) the emitted sticky-posit expect_equal(countWithSpans, countNoSpans + 1) }) +test_that("The rm.index pruning branch is actually exercised at num.header.rows = 2", +{ + # At num.header.rows = 2, top.position has length 2, so rm.index pruning is only a + # no-op when no span's offset (height - 1) lands on index 2. A front-loaded span + # (heights 2, 1, 1) prunes index 2 out of top.position; a back-loaded span + # (heights 1, 1, 2) does not prune anything, since its offset lands past top.position's + # length. Confirmed counts: no spans -> 15, front-loaded (pruned) -> 16, back-loaded + # (not pruned) -> 17. + frontLoaded <- list(list(height = 2, label = "AA"), list(height = 1, label = "BB"), + list(height = 1, label = "CC")) + backLoaded <- list(list(height = 1, label = "AA"), list(height = 1, label = "BB"), + list(height = 2, label = "CC")) + noSpans <- CreateCustomTable(rowSpanMatrix, row.height = "30px", num.header.rows = 2) + withFront <- CreateCustomTable(rowSpanMatrix, row.height = "30px", num.header.rows = 2, + row.spans = frontLoaded) + withBack <- CreateCustomTable(rowSpanMatrix, row.height = "30px", num.header.rows = 2, + row.spans = backLoaded) + expect_equal(countOccurrences("position: sticky", tableHtml(noSpans)), 15) + expect_equal(countOccurrences("position: sticky", tableHtml(withFront)), 16) + expect_equal(countOccurrences("position: sticky", tableHtml(withBack)), 17) +}) + test_that("Span heights not summing to nrow are pinned to current (unvalidated) behaviour", { # under-covering: heights sum to 2 against nrow = 4, so rows 3-4 simply get no span cell @@ -420,7 +465,39 @@ test_that("Span heights not summing to nrow are pinned to current (unvalidated) expect_false(grepl("rowspan", rows[4], fixed = TRUE)) # over-covering: a single span with a height greater than nrow completes without error; - # there is no bounds check in the j <- j + row.span.lengths[i] loop + # there is no bounds check in the j <- j + row.span.lengths[i] loop. Because there is + # only one span, row.span.html (length nrows) is fully written in a single assignment, + # so no misalignment occurs here - see the multi-span case below for that. overSpans <- list(list(height = 10, label = "AA")) - expect_error(CreateCustomTable(rowSpanMatrix, row.spans = overSpans), NA) + res <- CreateCustomTable(rowSpanMatrix, row.spans = overSpans) + h <- tableHtml(res) + body <- sub(".*", "", h) + rows <- regmatches(body, gregexpr(".*?", body))[[1]] + expect_equal(length(rows), 4) + expect_true(grepl('AA', rows[1], fixed = TRUE)) +}) + +test_that("A multi-span over-cover misaligns the table and emits a cbind warning (genuine defect, not yet ticketed)", +{ + # Genuine production defect being pinned here, not the plan-authoring mistake above: + # when a span's height pushes `j` (in the `j <- j + row.span.lengths[i]` loop) past + # nrow, subsequent assignments to row.span.html[j] silently grow that vector beyond + # nrows. cbind(row.span.html, cell.html) then warns because row.span.html's length is + # no longer a multiple of cell.html's row count, and the emitted rows are misaligned + # (rows 3-4 below are missing their row-span entirely, even though CC's span + # should have started around there). No ticket has been filed for this yet. + overSpans <- list(list(height = 1, label = "AA"), list(height = 10, label = "BB"), + list(height = 3, label = "CC")) + expect_warning( + res <- CreateCustomTable(rowSpanMatrix, row.spans = overSpans), + "number of rows of result is not a multiple of vector length", fixed = TRUE + ) + h <- tableHtml(res) + body <- sub(".*", "", h) + rows <- regmatches(body, gregexpr(".*?", body))[[1]] + expect_equal(length(rows), 4) + expect_true(grepl('AA', rows[1], fixed = TRUE)) + expect_true(grepl('BB', rows[2], fixed = TRUE)) + expect_false(grepl("rowspan", rows[3], fixed = TRUE)) + expect_false(grepl("rowspan", rows[4], fixed = TRUE)) }) From b5a20fe1867ec80bfa3fec5597baf00bf4e4ea86 Mon Sep 17 00:00:00 2001 From: Surrey Date: Fri, 21 Aug 2026 09:58:06 +1000 Subject: [PATCH 3/5] fix(test): correct row.spans comment mechanisms per review findings Corrects several factually-wrong explanations in the row.spans test block: the shared-CSS-class test's row-header parenthetical (it does not always get a non-NULL position), the multi-span over-cover test's title/mechanism (last span is discarded, not misaligned; the warning fires because 4 is not a multiple of 12, not the reverse), and the single-span over-cover test's "single assignment" reasoning. Also strengthens assertions (per-span CSS class checks 1/2/4, no stray rowspan in later over-cover rows) and expresses the num.header.rows=2 sticky counts relative to noSpans instead of hardcoded 15/16/17. Co-Authored-By: Claude Opus 4.8 (1M context) --- tests/testthat/test-createcustomtable.R | 49 ++++++++++++++++--------- 1 file changed, 31 insertions(+), 18 deletions(-) diff --git a/tests/testthat/test-createcustomtable.R b/tests/testthat/test-createcustomtable.R index cfd5bba..04f5795 100644 --- a/tests/testthat/test-createcustomtable.R +++ b/tests/testthat/test-createcustomtable.R @@ -327,9 +327,11 @@ test_that("A single rowspandefault CSS class is shared across all spans when sti # createcustomtable.R). Here row.height/num.header.rows are not set, so top.position is # NULL and the row-span block's scalar CSS string is never expanded - addCSSclass() # derives its class count from length(class.css), so it creates a single - # "rowspandefault1" class that every span's reuses. (The row-header block passes an - # equally unrepped scalar; it only ends up with one class per row because its call always - # supplies a non-NULL `position`.) On the sticky path (see the next test) each span DOES + # "rowspandefault1" class that every span's reuses. (The row-header block passes the + # same top.position variable as its own `position` argument; on this default path + # top.position is also NULL, so that block collapses to a single shared class too - it + # only ends up with one class per row when its call *does* supply a non-NULL `position`, + # i.e. on the sticky path.) On the sticky path (see the next test) each span DOES # get its own "rowspandefaultN" class, matching the plan's expectation. spans <- list(list(height = 2, label = "AA"), list(height = 1, label = "BB"), list(height = 1, label = "CC")) @@ -352,7 +354,10 @@ test_that("Each span gets its own rowspandefault CSS class when sticky positioni res <- CreateCustomTable(rowSpanMatrix, row.height = "30px", num.header.rows = 1, row.spans = spans) h <- normWs(tableHtml(res)) + expect_equal(countOccurrences(".rowspandefault1{", h), 1) + expect_equal(countOccurrences(".rowspandefault2{", h), 1) expect_equal(countOccurrences(".rowspandefault3{", h), 1) + expect_equal(countOccurrences(".rowspandefault4{", h), 0) }) test_that("A per-span class is appended, not substituted", @@ -434,20 +439,21 @@ test_that("The rm.index pruning branch is actually exercised at num.header.rows # no-op when no span's offset (height - 1) lands on index 2. A front-loaded span # (heights 2, 1, 1) prunes index 2 out of top.position; a back-loaded span # (heights 1, 1, 2) does not prune anything, since its offset lands past top.position's - # length. Confirmed counts: no spans -> 15, front-loaded (pruned) -> 16, back-loaded - # (not pruned) -> 17. + # length. Confirmed counts: no spans -> noSpans, front-loaded (pruned) -> noSpans + 1, + # back-loaded (not pruned) -> noSpans + 2. Expressed relative to noSpans (rather than + # hardcoded absolutes) so an unrelated CSS addition elsewhere doesn't make this brittle. frontLoaded <- list(list(height = 2, label = "AA"), list(height = 1, label = "BB"), list(height = 1, label = "CC")) backLoaded <- list(list(height = 1, label = "AA"), list(height = 1, label = "BB"), list(height = 2, label = "CC")) - noSpans <- CreateCustomTable(rowSpanMatrix, row.height = "30px", num.header.rows = 2) + resNoSpans <- CreateCustomTable(rowSpanMatrix, row.height = "30px", num.header.rows = 2) withFront <- CreateCustomTable(rowSpanMatrix, row.height = "30px", num.header.rows = 2, row.spans = frontLoaded) withBack <- CreateCustomTable(rowSpanMatrix, row.height = "30px", num.header.rows = 2, row.spans = backLoaded) - expect_equal(countOccurrences("position: sticky", tableHtml(noSpans)), 15) - expect_equal(countOccurrences("position: sticky", tableHtml(withFront)), 16) - expect_equal(countOccurrences("position: sticky", tableHtml(withBack)), 17) + noSpans <- countOccurrences("position: sticky", tableHtml(resNoSpans)) + expect_equal(countOccurrences("position: sticky", tableHtml(withFront)), noSpans + 1) + expect_equal(countOccurrences("position: sticky", tableHtml(withBack)), noSpans + 2) }) test_that("Span heights not summing to nrow are pinned to current (unvalidated) behaviour", @@ -465,9 +471,11 @@ test_that("Span heights not summing to nrow are pinned to current (unvalidated) expect_false(grepl("rowspan", rows[4], fixed = TRUE)) # over-covering: a single span with a height greater than nrow completes without error; - # there is no bounds check in the j <- j + row.span.lengths[i] loop. Because there is - # only one span, row.span.html (length nrows) is fully written in a single assignment, - # so no misalignment occurs here - see the multi-span case below for that. + # there is no bounds check in the j <- j + row.span.lengths[i] loop, but with only one + # span the loop makes just one assignment (row.span.html[1] <- ...) before it ends, so + # `j` only overruns nrow AFTER that final (and only) span - row.span.html never grows + # beyond its original length and no misalignment occurs here. See the multi-span case + # below for what happens when a later span's assignment lands past the overrun. overSpans <- list(list(height = 10, label = "AA")) res <- CreateCustomTable(rowSpanMatrix, row.spans = overSpans) h <- tableHtml(res) @@ -475,17 +483,22 @@ test_that("Span heights not summing to nrow are pinned to current (unvalidated) rows <- regmatches(body, gregexpr(".*?", body))[[1]] expect_equal(length(rows), 4) expect_true(grepl('AA', rows[1], fixed = TRUE)) + expect_false(grepl("rowspan", rows[2], fixed = TRUE)) + expect_false(grepl("rowspan", rows[3], fixed = TRUE)) + expect_false(grepl("rowspan", rows[4], fixed = TRUE)) }) -test_that("A multi-span over-cover misaligns the table and emits a cbind warning (genuine defect, not yet ticketed)", +test_that("A multi-span over-cover silently drops the last span and leaks a cbind warning (genuine defect, not yet ticketed)", { # Genuine production defect being pinned here, not the plan-authoring mistake above: # when a span's height pushes `j` (in the `j <- j + row.span.lengths[i]` loop) past - # nrow, subsequent assignments to row.span.html[j] silently grow that vector beyond - # nrows. cbind(row.span.html, cell.html) then warns because row.span.html's length is - # no longer a multiple of cell.html's row count, and the emitted rows are misaligned - # (rows 3-4 below are missing their row-span entirely, even though CC's span - # should have started around there). No ticket has been filed for this yet. + # nrow, the next assignment to row.span.html[j] silently grows that vector beyond + # nrows (here to length 12, for the height-1/10/3 spans below) - so CC's span is written + # past the end of the table and effectively discarded, rather than misaligning rows 3-4 + # (rowspan is clamped to the remaining rows elsewhere, so the table shape itself stays + # correct). cbind(row.span.html, cell.html) then warns because the result's row count + # (4, taken from cell.html) is not a multiple of row.span.html's length (12). No ticket + # has been filed for this yet. overSpans <- list(list(height = 1, label = "AA"), list(height = 10, label = "BB"), list(height = 3, label = "CC")) expect_warning( From 9eb4047c4d53dda39ed3f047cff3f84396ce5565 Mon Sep 17 00:00:00 2001 From: Surrey Date: Fri, 21 Aug 2026 10:10:30 +1000 Subject: [PATCH 4/5] docs(test): correct row.spans comment wording per review Co-Authored-By: Claude Opus 4.8 (1M context) --- tests/testthat/test-createcustomtable.R | 31 ++++++++++++++++--------- 1 file changed, 20 insertions(+), 11 deletions(-) diff --git a/tests/testthat/test-createcustomtable.R b/tests/testthat/test-createcustomtable.R index 04f5795..f05ddd9 100644 --- a/tests/testthat/test-createcustomtable.R +++ b/tests/testthat/test-createcustomtable.R @@ -414,15 +414,22 @@ test_that("Adding row.spans increases (does not reduce) the emitted sticky-posit { # PLAN DEVIATION: the plan expected the rm.index pruning at the top of the row.spans # block to REDUCE the sticky-position count relative to the no-spans case. In practice - # that pruning only trims the top.position vector fed into the row-span column's OWN - # addCSSclass() call; the cell/row-header sticky counts (computed earlier in the - # function) are unaffected. Because the row-span column also gets a "position: sticky" - # class of its own, adding row.spans increases the total sticky count by 1 (for - # num.header.rows = 1, the minimal combination) rather than decreasing it. Pinning - # the actual, confirmed behaviour instead of the plan's assumption. - # NOTE: at num.header.rows = 1, top.position has length 1, so the rm.index pruning's - # `[-rm.index]` is a no-op regardless of span heights - this case does not exercise the - # pruning branch at all. See the num.header.rows = 2 case below for that. + # that pruning trims the top.position vector, which is reassigned and then also fed + # into the row-span column's OWN addCSSclass() call; the cell/row-header sticky counts + # (computed earlier in the function) are unaffected. (A table combining row.spans with + # col.spans would also see the col-span classes affected, since the later column-span + # block passes the same pruned top.position as its position argument.) Because the + # row-span column also gets a "position: sticky" class of its own, adding row.spans + # increases the total sticky count by 1 (for num.header.rows = 1, the minimal + # combination) rather than decreasing it. Pinning the actual, confirmed behaviour + # instead of the plan's assumption. + # NOTE: at num.header.rows = 1, top.position has length 1, so the emitted output is the + # same either way: for the heights used here (2, 1, 1) rm.index holds only out-of-range + # indices (>= 2), so `top.position[-rm.index]` is a no-op. If every span height were 1, + # rm.index would stay NULL and `top.position[-rm.index]` (i.e. `top.position[-NULL]`) + # would error rather than silently no-op - but that all-heights-1 combination is never + # exercised at num.header.rows = 1 by this test. See the num.header.rows = 2 case below + # for the pruning branch actually removing an index. spans <- list(list(height = 2, label = "AA"), list(height = 1, label = "BB"), list(height = 1, label = "CC")) noSpans <- CreateCustomTable(rowSpanMatrix, row.height = "30px", num.header.rows = 1) @@ -495,8 +502,10 @@ test_that("A multi-span over-cover silently drops the last span and leaks a cbin # nrow, the next assignment to row.span.html[j] silently grows that vector beyond # nrows (here to length 12, for the height-1/10/3 spans below) - so CC's span is written # past the end of the table and effectively discarded, rather than misaligning rows 3-4 - # (rowspan is clamped to the remaining rows elsewhere, so the table shape itself stays - # correct). cbind(row.span.html, cell.html) then warns because the result's row count + # (the emitted rowspan attribute keeps its literal, oversized value - e.g. rowspan="10" - + # and it is the browser's HTML renderer, not this code, that clamps it to the remaining + # rows, so the table shape itself stays correct). cbind(row.span.html, cell.html) then + # warns because the result's row count # (4, taken from cell.html) is not a multiple of row.span.html's length (12). No ticket # has been filed for this yet. overSpans <- list(list(height = 1, label = "AA"), list(height = 10, label = "BB"), From dd84fa1b1145c68af0345b77aa501d4f2a83918c Mon Sep 17 00:00:00 2001 From: Surrey Date: Fri, 21 Aug 2026 10:13:47 +1000 Subject: [PATCH 5/5] test: pin row.spans all-height-1 sticky crash CreateCustomTable throws "invalid argument to unary operator" when row.spans is supplied with every span height equal to 1, together with sticky positioning (row.height set AND num.header.rows set). rm.index is only populated for spans taller than one row, so it stays NULL, and the pruning expression top.position[-rm.index] becomes top.position[-NULL], which is an invalid unary operator argument in R. This is a genuine, unticketed production defect. The new test pins the crash and also asserts that the same all-height-1 spans without sticky args, and mixed heights (2,1,1) with sticky args, both succeed - so the test proves the crash is specific to the all-heights-1 + sticky combination, not row.spans in general. No production code is changed; the defect remains unfixed and merely documented. Co-Authored-By: Claude Opus 4.8 (1M context) --- tests/testthat/test-createcustomtable.R | 37 +++++++++++++++++++++++++ 1 file changed, 37 insertions(+) diff --git a/tests/testthat/test-createcustomtable.R b/tests/testthat/test-createcustomtable.R index f05ddd9..4b775f9 100644 --- a/tests/testthat/test-createcustomtable.R +++ b/tests/testthat/test-createcustomtable.R @@ -523,3 +523,40 @@ test_that("A multi-span over-cover silently drops the last span and leaks a cbin expect_false(grepl("rowspan", rows[3], fixed = TRUE)) expect_false(grepl("rowspan", rows[4], fixed = TRUE)) }) + +test_that("All-height-1 row.spans with sticky positioning errors on invalid unary -NULL (genuine unticketed defect)", +{ + # Genuine production crash being pinned here (not yet ticketed): rm.index is only + # populated for spans taller than one row, so when EVERY span height is 1, rm.index + # stays NULL, and the pruning expression `top.position[-rm.index]` becomes + # `top.position[-NULL]`. In base R, unary minus on NULL is invalid ("invalid argument + # to unary operator"), so the function throws rather than returning the original + # top.position unchanged. This only happens when sticky positioning is also active + # (row.height set AND num.header.rows set), since top.position is only computed - and + # only fed into the row.spans pruning branch - in that case. If this defect is ever + # fixed, this expect_error should be changed to assert successful output instead. + allOnes <- list(list(height = 1, label = "AA"), list(height = 1, label = "BB"), + list(height = 1, label = "CC"), list(height = 1, label = "DD")) + expect_error( + CreateCustomTable(rowSpanMatrix, row.spans = allOnes, row.height = "30px", + num.header.rows = 1), + "invalid argument to unary operator", fixed = TRUE + ) + + # Same all-height-1 spans without sticky positioning: top.position/rm.index pruning is + # never reached, so this succeeds - the crash is specific to the sticky combination, + # not to row.spans (or all-height-1 spans) in general. + expect_error(res <- CreateCustomTable(rowSpanMatrix, row.spans = allOnes), NA) + expect_true(grepl('AA', tableHtml(res), + fixed = TRUE)) + + # Mixed heights (2, 1, 1) with the same sticky args: rm.index is populated (the height-2 + # span), so the pruning expression is a normal subscript, not `-NULL`, and this succeeds. + mixedHeights <- list(list(height = 2, label = "AA"), list(height = 1, label = "BB"), + list(height = 1, label = "CC")) + expect_error( + CreateCustomTable(rowSpanMatrix, row.spans = mixedHeights, row.height = "30px", + num.header.rows = 1), + NA + ) +})