RS-21803: Sig Leader Circles test

[SurreyHughesDisplayr]

Summary

Adds unit test coverage for the sig.leader.circles branch of CreateCustomTable (R/createcustomtable.R), which had no tests anywhere in tests/testthat/.

• Pins the three base circle classes (.circle2 leader, .circle1 tie, .circle0) and all nine filled variants (circle21 circle11 circle01 circle20 circle10 circle00 circle2-1 circle1-1 circle0-1) as exact full CSS declarations, so the up/nothing/down fill mapping and the border cycle are both asserted per variant.
• Asserts circle.size drives the emitted geometry (line-height / border-radius / height / width) via one anchored declaration.
• Asserts every data cell is wrapped in a <div class="circleN"> (count pinned to prod(dim(x))), and that cell text — including escaped entities — survives the wrapping.
• Asserts no circle CSS and no circle divs are emitted when sig.leader.circles is NULL.

Pinned production bug

One test deliberately pins current buggy behaviour. The normalisation line in the sig.leader.circles branch is

sig.leader.circles[!which(sig.leader.circles == 1 | sig.leader.circles == 2)] <- 0

which() returns positive indices, so !which(...) is always all-FALSE and the assignment is a complete no-op — out-of-range codes are never coerced to 0, and <div class="circle5"> / <div class="circle-3"> are emitted instead of circle0. The test asserts the actual behaviour, not the documented intent, so it will fail loudly when the bug is fixed. No production code is changed in this PR. No defect ticket is filed for it yet.

Jira: https://numbers.atlassian.net/browse/RS-21803

Test plan

Rscript -e "devtools::load_all('.'); testthat::test_file('tests/testthat/test-createcustomtable.R')"

46 passing, 0 failures (11 test_that blocks; 8 added here, plus hardening of the helper used by the pre-existing ones).

🤖 Generated with Claude Code

[chschan]

Nice, thorough coverage of the CSS emission — the " {" suffix trick and the prefix-collision note are both well judged.

One gap I think is worth closing before this merges: nothing asserts that a cell can ever carry a filled class.

Both circle tests use circles <- matrix(0, 4, 3), and the nine .circle21….circle0-1 rules are checked as CSS text only. Those rules are only reachable when sig.leader.circles holds composite codes:

CreateCustomTable(matrix(1:4, 2, 2), sig.leader.circles = matrix(c("21", "1-1", "00", "2-1"), 2, 2))
# -> <div class="circle21">1</div>

(the -1 group is only expressible as a character matrix)

Why it matters: the natural fix for the bug pinned at createcustomtable.R:394 is

sig.leader.circles[!(sig.leader.circles %in% c(1, 2))] <- 0

but that collapses every composite code to 0:

> s <- matrix(c("21", "1-1", "00", "2-1"), 2, 2); s[!(s %in% c(1, 2))] <- 0; as.vector(s)
[1] "0" "0" "0" "0"

Filled circles disappear in production, and the suite stays green apart from the deliberately-pinned test — so the fixer reads it as "expected, my fix works" rather than seeing the regression.

Suggested addition — it pins the pairing of a cell's class with a CSS rule that can style it, which is the link the current tests leave unasserted:

test_that("Filled circle codes render a div whose class matches an emitted CSS rule",
{
    x22 <- matrix(1:4, 2, 2, dimnames = list(c("a", "b"), c("X", "Y")))
    # composite codes are the only way to reach the nine filled rules; the
    # "-1" group is only expressible as a character matrix
    circles <- matrix(c("21", "1-1", "00", "2-1"), 2, 2)
    up <- "rgb(1,2,3)"; nothing <- "rgb(4,5,6)"; down <- "rgb(7,8,9)"
    res <- CreateCustomTable(x22, sig.leader.circles = circles,
                sig.fills.up = up, sig.fills.nothing = nothing, sig.fills.down = down)
    h <- tableHtml(res)
    hn <- normWs(h)

    # a filled code reaches the cell as-is...
    expect_true(grepl('<div class="circle21">1</div>', h, fixed = TRUE))
    expect_true(grepl('<div class="circle1-1">2</div>', h, fixed = TRUE))
    expect_true(grepl('<div class="circle00">3</div>', h, fixed = TRUE))
    expect_true(grepl('<div class="circle2-1">4</div>', h, fixed = TRUE))

    # ...and each class a cell uses has a fill rule behind it
    expect_true(grepl(".circle21 { border: 2px solid rgb(120,120,120); background-color:rgb(1,2,3);",
        hn, fixed = TRUE))
    expect_true(grepl(".circle1-1 { border: 1px solid rgb(150,150,150); background-color:rgb(7,8,9);",
        hn, fixed = TRUE))
    expect_true(grepl(".circle00 { border: 0px solid rgb(0,0,0); background-color:rgb(4,5,6);",
        hn, fixed = TRUE))
    expect_true(grepl(".circle2-1 { border: 2px solid rgb(120,120,120); background-color:rgb(7,8,9);",
        hn, fixed = TRUE))
})

I ran this against master's createcustomtable.R (R 4.5.1): 8 pass, 0 fail. normWs is needed on the CSS half only, since filled.circle.styles at line 392 carries a literal newline inside each rule. Under the naive fix above, all four <div> assertions fail — which is the signal the current suite can't produce.

[chschan]

Six follow-ups to my earlier comment about the missing filled-circle assertion. All are smaller than that one — the first two are the ones I would actually want before merge; the rest are judgement calls, take or leave them.

[chschan]

NA leaks through this branch the same way out-of-range numerics do, and it isn't covered here. Verified:

CreateCustomTable(matrix(1:4, 2, 2), sig.leader.circles = matrix(c(2, NA, 0, 1), 2, 2))
# -> <div class="circleNA">

circleNA matches no CSS rule, so that circle silently vanishes rather than rendering unstyled.

Worth adding to this matrix — as written, a partial fix that normalises out-of-range numerics but forgets NA still passes:

circles <- matrix(c(5, 1, -3, NA), 2, 2)
...
expect_true(grepl('<div class="circleNA">4</div>', h, fixed = TRUE))

[chschan]

Could you file the defect and reference it here? Pinning known-buggy behaviour is the right call, but without a ticket link whoever fixes createcustomtable.R:394 hits a red test with no trail back to why it was pinned — which is the exact failure mode this test is trying to prevent. A # See RS-XXXXX line is enough.

[chschan]

gregexpr(pattern, s, fixed = TRUE)[[1]] takes only the first element, so if res$x$text is ever length > 1 the counts at lines 67/70/73/103/116 silently under-report and the assertions pass (or fail) for the wrong reason. And if it comes back character(0) or NULL, [[1]] throws subscript out of bounds instead of a readable expectation failure.

The guard is the important half — it turns a silent under-count into a visible failure:

countOccurrences <- function(pattern, s)
{
    stopifnot(length(s) == 1L)
    m <- gregexpr(pattern, s, fixed = TRUE)[[1]]
    if (m[1] == -1L) 0L else length(m)
}

[chschan]

This is the right place for the missing dimension-mismatch case — index alignment is the whole job of the branch under test, and nothing here pins what happens when sig.leader.circles and x disagree.

Verified, on a 2x2 x:

CreateCustomTable(matrix(1:4, 2, 2), sig.leader.circles = matrix(c(2, 1), 2, 1))

sprintf silently recycles: circle2 lands on cells 1 and 3, circle1 on cells 2 and 4 — misaligned circles, no warning. A non-recyclable size instead dies with the opaque sprintf message "arguments cannot be recycled to the same length", which doesn't point at sig.leader.circles at all.

Pinning at least the recycling case makes any future validation an explicit decision rather than a silent behaviour change.

[chschan]

The name says "text is preserved" and the PR description says this covers "escaped entities", but "X & Y" is a raw ampersand, not an entity. What the assertion actually pins is that cell content is interpolated into the HTML unescaped.

That's a reasonable contract to pin, but it should say so — if HTML-escaping or sanitisation of cell content is ever added, this test breaks and reads like a regression rather than an intentional contract change.

Either use real entity input, as the pre-existing test at line 28 does:

txt <- "50%&nbsp;&#8593;"

or rename to state the contract, e.g. "Cell content passes through the circle div wrapping unescaped".

[chschan]

Minor, but 4, 3 here (and at lines 81 and 152) is a second, independent statement of x2's shape rather than being derived from it — and the API contract is that sig.leader.circles has the same dim as x (createcustomtable.R:9).

Because the circle CSS is value- and dimension-independent, a future reshape of x2 can't make these three tests fail. I checked what happens:

• x2 <- matrix(1:12, 3, 4) — 12 codes, 12 cells, so sprintf recycles cleanly and the reshape walks the codes down the wrong grid in column-major order. Every assertion still passes, no warning at all.
• x2 <- matrix(1:6, 2, 3) — surfaces "data length differs from size of matrix: [12 != 2 x 3]", but as a production warning, not an assertion, so it lands as a WARN line in the summary rather than a failure.

Deriving the shape makes the mismatch unrepresentable and documents that the codes matrix is meant to mirror the data grid:

circles <- matrix(0, nrow(x2), ncol(x2))