From b29c03b148a721f8e70c57addc44a99b96cd8ace Mon Sep 17 00:00:00 2001
From: Surrey <surrey.hughes@displayr.com>
Date: Thu, 20 Aug 2026 17:53:17 +1000
Subject: [PATCH 1/2] test(createcustomtable): cover spacer.col header-cell
 overwrite and col.header.fill CSS

Adds coverage for CreateCustomTable's spacer.col/col.header.fill column-header
behaviour, including the show.row.headers index shift, the show.col.headers
suppression path, and the confirmed out-of-range spacer.col defect where
sprintf emits a literal class="NA" header cell.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
---
 tests/testthat/test-createcustomtable.R | 113 ++++++++++++++++++++++++
 1 file changed, 113 insertions(+)

diff --git a/tests/testthat/test-createcustomtable.R b/tests/testthat/test-createcustomtable.R
index 9151e1c..c5acdcf 100644
--- a/tests/testthat/test-createcustomtable.R
+++ b/tests/testthat/test-createcustomtable.R
@@ -157,3 +157,116 @@ test_that("circle.size drives the emitted circle geometry",
     expect_false(grepl("line-height:35px", h, fixed = TRUE))
     expect_false(grepl("border-radius:35px", h, fixed = TRUE))
 })
+
+# spacer.col --------------------------------------------------------------
+
+test_that("Default emits no spacer class",
+{
+    res <- CreateCustomTable(x2)
+    expect_false(grepl('class="spacer"', tableHtml(res), fixed = TRUE))
+})
+
+test_that("A single spacer.col index produces exactly one spacer header cell",
+{
+    m4 <- matrix(1:12, 3, 4, dimnames = list(c("a", "b", "c"), c("W", "X", "Y", "Z")))
+    res <- CreateCustomTable(m4, show.row.headers = FALSE, spacer.col = 2)
+    h <- tableHtml(res)
+    expect_equal(countOccurrences('<th class="spacer">', h), 1)
+    # the trailing space before the closing quote is load-bearing: col.header.styles is
+    # pasted with the (default empty-string) col.header.classes argument, so the three
+    # non-spacer headers carry "colheaderdefault1 " rather than "colheaderdefault1"
+    expect_equal(countOccurrences('class="colheaderdefault1 "', h), 3)
+})
+
+test_that("The spacer cell replaces, not augments, the default class",
+{
+    m4 <- matrix(1:12, 3, 4, dimnames = list(c("a", "b", "c"), c("W", "X", "Y", "Z")))
+    res <- CreateCustomTable(m4, show.row.headers = FALSE, spacer.col = 2)
+    h <- tableHtml(res)
+    th <- regmatches(h, regexpr('<th class="[^"]*">X</th>', h))
+    expect_equal(th, '<th class="spacer">X</th>')
+})
+
+test_that("Multiple spacer.col indices produce spacer cells at those emission positions",
+{
+    m4 <- matrix(1:12, 3, 4, dimnames = list(c("a", "b", "c"), c("W", "X", "Y", "Z")))
+    res <- CreateCustomTable(m4, show.row.headers = FALSE, spacer.col = c(2, 4))
+    h <- tableHtml(res)
+    ths <- regmatches(h, gregexpr('<th class="[^"]*">[^<]*</th>', h))[[1]]
+    expect_equal(length(ths), 4)
+    expect_equal(ths[2], '<th class="spacer">X</th>')
+    expect_equal(ths[4], '<th class="spacer">Z</th>')
+    expect_true(grepl('colheaderdefault', ths[1], fixed = TRUE))
+    expect_true(grepl('colheaderdefault', ths[3], fixed = TRUE))
+})
+
+test_that("The spacer cell keeps its column label",
+{
+    m4 <- matrix(1:12, 3, 4, dimnames = list(c("a", "b", "c"), c("W", "X", "Y", "Z")))
+    res <- CreateCustomTable(m4, show.row.headers = FALSE, spacer.col = 3)
+    h <- tableHtml(res)
+    expect_true(grepl('<th class="spacer">Y</th>', h, fixed = TRUE))
+})
+
+test_that("The corner cell shifts the spacer.col index when show.row.headers is TRUE",
+{
+    m4 <- matrix(1:12, 3, 4, dimnames = list(c("a", "b", "c"), c("W", "X", "Y", "Z")))
+    res <- CreateCustomTable(m4, show.row.headers = TRUE, spacer.col = 2)
+    h <- tableHtml(res)
+    ths <- regmatches(h, gregexpr('<th class="[^"]*">[^<]*</th>', h))[[1]]
+    expect_equal(length(ths), 5)
+    # the corner cell occupies emission position 1, so index 2 lands on the first
+    # data column ("W") rather than on the corner - pinning the index-shift contract
+    expect_equal(ths[1], '<th class="cornerdefault1"></th>')
+    expect_equal(ths[2], '<th class="spacer">W</th>')
+})
+
+test_that("col.header.fill reaches the colheaderdefault CSS rule",
+{
+    res <- CreateCustomTable(x2, col.header.fill = "rgb(1,2,3)")
+    h <- normWs(tableHtml(res))
+    expect_true(grepl('.colheaderdefault1{ background: rgb(1,2,3);', h, fixed = TRUE))
+})
+
+test_that("col.header.fill defaults to transparent",
+{
+    res <- CreateCustomTable(x2)
+    h <- normWs(tableHtml(res))
+    expect_true(grepl('.colheaderdefault1{ background: transparent;', h, fixed = TRUE))
+})
+
+test_that("show.col.headers = FALSE suppresses the whole header row and its CSS",
+{
+    res <- CreateCustomTable(x2, show.col.headers = FALSE)
+    h <- tableHtml(res)
+    expect_false(grepl('<th class="', h, fixed = TRUE))
+    expect_false(grepl('colheaderdefault', h, fixed = TRUE))
+})
+
+test_that("Out-of-range spacer.col is pinned to its current (defective) behaviour",
+{
+    # col.header.styles[spacer.col] <- "spacer" silently extends the header-style vector
+    # with NA for the skipped positions when spacer.col exceeds its length, and the
+    # subsequent sprintf() emits a literal class="NA" <th> rather than erroring or being
+    # a no-op. spacer.col = 6 is chosen (a multiple of the 3-column header vector) so the
+    # sprintf recycling itself does not error - this pins the actual defect, not a crash.
+    x2local <- matrix(1:12, 4, 3, dimnames = list(letters[1:4], c("X", "Y", "Z")))
+    res <- CreateCustomTable(x2local, show.row.headers = FALSE, spacer.col = 6)
+    h <- tableHtml(res)
+    expect_equal(countOccurrences('class="NA"', h), 2)
+    expect_true(grepl('<th class="spacer">Z</th>', h, fixed = TRUE))
+})
+
+test_that("use.predefined.css = FALSE leaves the spacer header cell with no matching CSS rule",
+{
+    m4 <- matrix(1:12, 3, 4, dimnames = list(c("a", "b", "c"), c("W", "X", "Y", "Z")))
+    res <- CreateCustomTable(m4, show.row.headers = FALSE, spacer.col = 2, use.predefined.css = FALSE)
+    h <- tableHtml(res)
+    expect_true(grepl('<th class="spacer">', h, fixed = TRUE))
+    expect_false(grepl('.spacer {', h, fixed = TRUE))
+
+    # confirm the negative assertion actually flips: with the default use.predefined.css = TRUE
+    # the same call does emit the ".spacer {" rule
+    resDefault <- CreateCustomTable(m4, show.row.headers = FALSE, spacer.col = 2)
+    expect_true(grepl('.spacer {', tableHtml(resDefault), fixed = TRUE))
+})

From 734ea906b2459e0c89c5a6dc9e35969bee03b1c3 Mon Sep 17 00:00:00 2001
From: Surrey <surrey.hughes@displayr.com>
Date: Thu, 20 Aug 2026 18:19:39 +1000
Subject: [PATCH 2/2] fix(test): tighten spacer.col test assertions per review

- comment the load-bearing narrowing from bare <th to <th class="
- pin exact colheaderdefault th strings instead of loose substring probes
- assert the 6-th-cell recycling consequence of the out-of-range spacer.col
- document why spacer.col = 3 (not 2) is required for the label-survival test

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
---
 tests/testthat/test-createcustomtable.R | 9 +++++++--
 1 file changed, 7 insertions(+), 2 deletions(-)

diff --git a/tests/testthat/test-createcustomtable.R b/tests/testthat/test-createcustomtable.R
index c5acdcf..2ea6b69 100644
--- a/tests/testthat/test-createcustomtable.R
+++ b/tests/testthat/test-createcustomtable.R
@@ -196,13 +196,16 @@ test_that("Multiple spacer.col indices produce spacer cells at those emission po
     expect_equal(length(ths), 4)
     expect_equal(ths[2], '<th class="spacer">X</th>')
     expect_equal(ths[4], '<th class="spacer">Z</th>')
-    expect_true(grepl('colheaderdefault', ths[1], fixed = TRUE))
-    expect_true(grepl('colheaderdefault', ths[3], fixed = TRUE))
+    expect_equal(ths[1], '<th class="colheaderdefault1 ">W</th>')
+    expect_equal(ths[3], '<th class="colheaderdefault1 ">Y</th>')
 })
 
 test_that("The spacer cell keeps its column label",
 {
     m4 <- matrix(1:12, 3, 4, dimnames = list(c("a", "b", "c"), c("W", "X", "Y", "Z")))
+    # spacer.col = 3 (not the sibling blocks' 2) is required here: with columns
+    # W, X, Y, Z, index 3 is the one that lands on "Y", which is the label this
+    # test needs to demonstrate survives being turned into a spacer cell
     res <- CreateCustomTable(m4, show.row.headers = FALSE, spacer.col = 3)
     h <- tableHtml(res)
     expect_true(grepl('<th class="spacer">Y</th>', h, fixed = TRUE))
@@ -239,6 +242,7 @@ test_that("show.col.headers = FALSE suppresses the whole header row and its CSS"
 {
     res <- CreateCustomTable(x2, show.col.headers = FALSE)
     h <- tableHtml(res)
+    # '<th class="' not a bare '<th': <thead> is always emitted, so a bare probe could never fail
     expect_false(grepl('<th class="', h, fixed = TRUE))
     expect_false(grepl('colheaderdefault', h, fixed = TRUE))
 })
@@ -255,6 +259,7 @@ test_that("Out-of-range spacer.col is pinned to its current (defective) behaviou
     h <- tableHtml(res)
     expect_equal(countOccurrences('class="NA"', h), 2)
     expect_true(grepl('<th class="spacer">Z</th>', h, fixed = TRUE))
+    expect_equal(countOccurrences("<th ", h), 6)
 })
 
 test_that("use.predefined.css = FALSE leaves the spacer header cell with no matching CSS rule",