From 2f53f6c387435b3b2f17718bf77f97fbc0459760 Mon Sep 17 00:00:00 2001 From: Surrey Date: Thu, 20 Aug 2026 17:19:44 +1000 Subject: [PATCH 1/4] test: add unit tests for sig.leader.circles in CreateCustomTable Cover the sig.leader.circles branch of CreateCustomTable: no-op default, base and filled circle CSS classes, per-cell circle div wrapping, content preservation, circle.size-driven geometry, and the current (buggy) out-of-range normalisation behaviour. Co-Authored-By: Claude Opus 4.8 (1M context) --- tests/testthat/test-createcustomtable.R | 92 +++++++++++++++++++++++++ 1 file changed, 92 insertions(+) diff --git a/tests/testthat/test-createcustomtable.R b/tests/testthat/test-createcustomtable.R index 2802607..1a2b85c 100644 --- a/tests/testthat/test-createcustomtable.R +++ b/tests/testthat/test-createcustomtable.R @@ -33,3 +33,95 @@ test_that("Text data is exported correctly", "He asked me about the votes…Told him I didn’t know anything about it"), dim = c(4L, 1L))) }) + +# sig.leader.circles ----------------------------------------------------- + +html <- function(res) res$x$text +norm_ws <- function(s) trimws(gsub("\\s+", " ", s)) +count_occurrences <- function(pattern, s) +{ + m <- gregexpr(pattern, s, fixed = TRUE)[[1]] + if (identical(m, -1L)) 0 else length(m) +} + +test_that("No sig.leader.circles emits no circle CSS or divs", +{ + res <- CreateCustomTable(x2) + expect_false(grepl(".circle", html(res), fixed = TRUE)) +}) + +test_that("Base circle classes are emitted when sig.leader.circles is supplied", +{ + circles <- matrix(c(2, 1, 0, 2, 1, 0, 2, 1, 0, 2, 1, 0), 4, 3) + res <- CreateCustomTable(x2, sig.leader.circles = circles) + h <- norm_ws(html(res)) + expect_true(grepl(".circle2 { border: 2px solid rgb(120,120,120);", h, fixed = TRUE)) + expect_true(grepl(".circle1 { border: 1px solid rgb(150,150,150);", h, fixed = TRUE)) + expect_true(grepl(".circle0 { border: 0px solid rgb(0,0,0);", h, fixed = TRUE)) +}) + +test_that("All nine filled circle variants are emitted with the correct fill colors", +{ + circles <- matrix(c(2, 1, 0, 2, 1, 0, 2, 1, 0, 2, 1, 0), 4, 3) + res <- CreateCustomTable(x2, sig.leader.circles = circles, + sig.fills.up = "rgb(1,2,3)", sig.fills.nothing = "rgb(4,5,6)", + sig.fills.down = "rgb(7,8,9)") + h <- norm_ws(html(res)) + variants <- c("circle21", "circle11", "circle01", "circle20", "circle10", + "circle00", "circle2-1", "circle1-1", "circle0-1") + for (v in variants) + expect_equal(count_occurrences(paste0(".", v, " {"), h), 1) + + expect_true(grepl(".circle21 { border: 2px solid rgb(120,120,120); background-color:rgb(1,2,3);", + h, fixed = TRUE)) + expect_true(grepl(".circle10 { border: 1px solid rgb(150,150,150); background-color:rgb(4,5,6);", + h, fixed = TRUE)) + expect_true(grepl(".circle0-1 { border: 0px solid rgb(0,0,0); background-color:rgb(7,8,9);", + h, fixed = TRUE)) +}) + +test_that("Every data cell is wrapped in a circle div carrying its own code", +{ + x22 <- matrix(1:4, 2, 2, dimnames = list(c("a", "b"), c("X", "Y"))) + circles <- matrix(c(2, 1, 0, 2), 2, 2) + res <- CreateCustomTable(x22, sig.leader.circles = circles) + h <- html(res) + expect_equal(count_occurrences('
1
', h, fixed = TRUE)) + expect_true(grepl('
2
', h, fixed = TRUE)) +}) + +test_that("The rendered cell text survives the circle div wrapping", +{ + x22 <- matrix(1:4, 2, 2, dimnames = list(c("a", "b"), c("X", "Y"))) + circles <- matrix(c(2, 1, 0, 2), 2, 2) + res <- CreateCustomTable(x22, sig.leader.circles = circles) + h <- html(res) + expect_true(grepl('
3
', h, fixed = TRUE)) + expect_true(grepl('
4
', h, fixed = TRUE)) +}) + +test_that("Out-of-range codes pin the current (buggy) normalisation behaviour", +{ + # sig.leader.circles[!which(...)] <- 0 negates integer indices rather than + # inverting a logical mask, so out-of-range codes are not reset to 0 as documented. + x22 <- matrix(1:4, 2, 2, dimnames = list(c("a", "b"), c("X", "Y"))) + circles <- matrix(c(5, 1, -3, 2), 2, 2) + res <- CreateCustomTable(x22, sig.leader.circles = circles) + h <- html(res) + expect_true(grepl('
1
', h, fixed = TRUE)) + expect_true(grepl('
3
', h, fixed = TRUE)) +}) + +test_that("circle.size drives the emitted circle geometry", +{ + circles <- matrix(c(2, 1, 0, 2, 1, 0, 2, 1, 0, 2, 1, 0), 4, 3) + res <- CreateCustomTable(x2, sig.leader.circles = circles, circle.size = 50) + h <- norm_ws(html(res)) + expect_true(grepl("line-height:50px", h, fixed = TRUE)) + expect_true(grepl("border-radius:50px", h, fixed = TRUE)) + expect_true(grepl("height: 50px", h, fixed = TRUE)) + expect_true(grepl("width:50px", h, fixed = TRUE)) + expect_false(grepl("line-height:35px", h, fixed = TRUE)) + expect_false(grepl("border-radius:35px", h, fixed = TRUE)) +}) From 9575626feb26d79173f579a95fa871ad0b6be02a Mon Sep 17 00:00:00 2001 From: Surrey Date: Thu, 20 Aug 2026 17:29:18 +1000 Subject: [PATCH 2/4] fix(test): pin all nine circle fill colors and tighten circle CSS assertions Address review findings on the sig.leader.circles tests: assert the full 9-way circle.colors/circle.border mapping instead of a spot-check, anchor the circle.size geometry assertion to the exact circle CSS declaration (fixed = TRUE) instead of loose token matches, make the "text survives wrapping" test genuinely exercise text preservation with entity content, switch CSS-only fixtures to a value-independent matrix with an explanatory comment, add info= to loop assertions, rename helpers to camelCase to match package style, and reference RS-21803 on the pinned-buggy-behaviour test. Co-Authored-By: Claude Opus 4.8 (1M context) --- tests/testthat/test-createcustomtable.R | 87 +++++++++++++++---------- 1 file changed, 53 insertions(+), 34 deletions(-) diff --git a/tests/testthat/test-createcustomtable.R b/tests/testthat/test-createcustomtable.R index 1a2b85c..c9ce3fc 100644 --- a/tests/testthat/test-createcustomtable.R +++ b/tests/testthat/test-createcustomtable.R @@ -36,9 +36,9 @@ test_that("Text data is exported correctly", # sig.leader.circles ----------------------------------------------------- -html <- function(res) res$x$text -norm_ws <- function(s) trimws(gsub("\\s+", " ", s)) -count_occurrences <- function(pattern, s) +tableHtml <- function(res) res$x$text # rhtmlMetro::Box stores the emitted HTML in the widget payload's text field +normWs <- function(s) trimws(gsub("\\s+", " ", s)) +countOccurrences <- function(pattern, s) { m <- gregexpr(pattern, s, fixed = TRUE)[[1]] if (identical(m, -1L)) 0 else length(m) @@ -47,14 +47,17 @@ count_occurrences <- function(pattern, s) test_that("No sig.leader.circles emits no circle CSS or divs", { res <- CreateCustomTable(x2) - expect_false(grepl(".circle", html(res), fixed = TRUE)) + expect_false(grepl(".circle", tableHtml(res), fixed = TRUE)) }) test_that("Base circle classes are emitted when sig.leader.circles is supplied", { - circles <- matrix(c(2, 1, 0, 2, 1, 0, 2, 1, 0, 2, 1, 0), 4, 3) + # circle CSS is value-independent (driven only by non-NULL-ness of sig.leader.circles, + # circle.size and sig.fills.*); a plain fixture is used so the codes don't misleadingly + # appear to drive the CSS + circles <- matrix(0, 4, 3) res <- CreateCustomTable(x2, sig.leader.circles = circles) - h <- norm_ws(html(res)) + h <- normWs(tableHtml(res)) expect_true(grepl(".circle2 { border: 2px solid rgb(120,120,120);", h, fixed = TRUE)) expect_true(grepl(".circle1 { border: 1px solid rgb(150,150,150);", h, fixed = TRUE)) expect_true(grepl(".circle0 { border: 0px solid rgb(0,0,0);", h, fixed = TRUE)) @@ -62,22 +65,35 @@ test_that("Base circle classes are emitted when sig.leader.circles is supplied", test_that("All nine filled circle variants are emitted with the correct fill colors", { - circles <- matrix(c(2, 1, 0, 2, 1, 0, 2, 1, 0, 2, 1, 0), 4, 3) + # circle CSS is value-independent (see "Base circle classes..." above); a plain fixture + # is used so the codes don't misleadingly appear to drive the CSS + circles <- matrix(0, 4, 3) + up <- "rgb(1,2,3)" + nothing <- "rgb(4,5,6)" + down <- "rgb(7,8,9)" res <- CreateCustomTable(x2, sig.leader.circles = circles, - sig.fills.up = "rgb(1,2,3)", sig.fills.nothing = "rgb(4,5,6)", - sig.fills.down = "rgb(7,8,9)") - h <- norm_ws(html(res)) + sig.fills.up = up, sig.fills.nothing = nothing, sig.fills.down = down) + h <- normWs(tableHtml(res)) variants <- c("circle21", "circle11", "circle01", "circle20", "circle10", "circle00", "circle2-1", "circle1-1", "circle0-1") - for (v in variants) - expect_equal(count_occurrences(paste0(".", v, " {"), h), 1) - - expect_true(grepl(".circle21 { border: 2px solid rgb(120,120,120); background-color:rgb(1,2,3);", - h, fixed = TRUE)) - expect_true(grepl(".circle10 { border: 1px solid rgb(150,150,150); background-color:rgb(4,5,6);", - h, fixed = TRUE)) - expect_true(grepl(".circle0-1 { border: 0px solid rgb(0,0,0); background-color:rgb(7,8,9);", - h, fixed = TRUE)) + + leader2px <- "2px solid rgb(120,120,120)" + tie1px <- "1px solid rgb(150,150,150)" + zero0px <- "0px solid rgb(0,0,0)" + fmt <- "display: inline-block; line-height:35px; border-radius:35px; height: 35px; width:35px;" + colors <- rep(c(up, nothing, down), each = 3) + borders <- rep(c(leader2px, tie1px, zero0px), 3) + + for (i in seq_along(variants)) + { + v <- variants[i] + # the trailing " {" is load-bearing: a bare ".circle2" also matches ".circle21", + # ".circle20" and ".circle2-1", so without it the occurrence count would be wrong + expect_equal(countOccurrences(paste0(".", v, " {"), h), 1, info = v) + expected <- paste0(".", v, " { border: ", borders[i], "; background-color:", + colors[i], ";", fmt, "}") + expect_true(grepl(expected, h, fixed = TRUE), info = v) + } }) test_that("Every data cell is wrapped in a circle div carrying its own code", @@ -85,43 +101,46 @@ test_that("Every data cell is wrapped in a circle div carrying its own code", x22 <- matrix(1:4, 2, 2, dimnames = list(c("a", "b"), c("X", "Y"))) circles <- matrix(c(2, 1, 0, 2), 2, 2) res <- CreateCustomTable(x22, sig.leader.circles = circles) - h <- html(res) - expect_equal(count_occurrences('
1
', h, fixed = TRUE)) expect_true(grepl('
2
', h, fixed = TRUE)) + expect_true(grepl('
3
', h, fixed = TRUE)) + expect_true(grepl('
4
', h, fixed = TRUE)) }) -test_that("The rendered cell text survives the circle div wrapping", +test_that("Rendered cell text is preserved inside the circle div wrapping", { - x22 <- matrix(1:4, 2, 2, dimnames = list(c("a", "b"), c("X", "Y"))) + txt <- "X & Y" + x22 <- matrix(c(txt, "b", "c", "d"), 2, 2, dimnames = list(c("a", "b"), c("X", "Y"))) circles <- matrix(c(2, 1, 0, 2), 2, 2) res <- CreateCustomTable(x22, sig.leader.circles = circles) - h <- html(res) - expect_true(grepl('
3
', h, fixed = TRUE)) - expect_true(grepl('
4
', h, fixed = TRUE)) + h <- tableHtml(res) + expect_true(grepl(paste0('
', txt, '
'), h, fixed = TRUE)) }) test_that("Out-of-range codes pin the current (buggy) normalisation behaviour", { - # sig.leader.circles[!which(...)] <- 0 negates integer indices rather than + # RS-21803: sig.leader.circles[!which(...)] <- 0 negates integer indices rather than # inverting a logical mask, so out-of-range codes are not reset to 0 as documented. + # This test pins that behaviour deliberately, pending a fix. x22 <- matrix(1:4, 2, 2, dimnames = list(c("a", "b"), c("X", "Y"))) circles <- matrix(c(5, 1, -3, 2), 2, 2) res <- CreateCustomTable(x22, sig.leader.circles = circles) - h <- html(res) + h <- tableHtml(res) expect_true(grepl('
1
', h, fixed = TRUE)) expect_true(grepl('
3
', h, fixed = TRUE)) }) test_that("circle.size drives the emitted circle geometry", { - circles <- matrix(c(2, 1, 0, 2, 1, 0, 2, 1, 0, 2, 1, 0), 4, 3) + # circle CSS is value-independent (see "Base circle classes..." above); a plain fixture + # is used so the codes don't misleadingly appear to drive the CSS + circles <- matrix(0, 4, 3) res <- CreateCustomTable(x2, sig.leader.circles = circles, circle.size = 50) - h <- norm_ws(html(res)) - expect_true(grepl("line-height:50px", h, fixed = TRUE)) - expect_true(grepl("border-radius:50px", h, fixed = TRUE)) - expect_true(grepl("height: 50px", h, fixed = TRUE)) - expect_true(grepl("width:50px", h, fixed = TRUE)) + h <- normWs(tableHtml(res)) + expect_true(grepl(paste0(".circle2 { border: 2px solid rgb(120,120,120);display: inline-block; ", + "line-height:50px; border-radius:50px; height: 50px; width:50px;}"), h, fixed = TRUE)) expect_false(grepl("line-height:35px", h, fixed = TRUE)) expect_false(grepl("border-radius:35px", h, fixed = TRUE)) }) From 1b5a003484dea48237dcf9cef66e709406f39e85 Mon Sep 17 00:00:00 2001 From: Surrey Date: Thu, 20 Aug 2026 17:36:07 +1000 Subject: [PATCH 3/4] fix(test): address review findings on sig.leader.circles tests Assert the divs half of the "no circle CSS or divs" title, pin full base circle-class declarations with occurrence counts, express the cell-count invariant via prod(dim(x22)), assert an in-range code still works in the out-of-range test, correct the ticket attribution for the unfiled negation-bug comment, and relocate helper definitions to the top of the file per repo convention. Co-Authored-By: Claude Opus 4.8 (1M context) --- tests/testthat/test-createcustomtable.R | 41 ++++++++++++++++--------- 1 file changed, 27 insertions(+), 14 deletions(-) diff --git a/tests/testthat/test-createcustomtable.R b/tests/testthat/test-createcustomtable.R index c9ce3fc..4e702d5 100644 --- a/tests/testthat/test-createcustomtable.R +++ b/tests/testthat/test-createcustomtable.R @@ -1,5 +1,13 @@ context("CreateCustomTable") +tableHtml <- function(res) res$x$text # rhtmlMetro::Box stores the emitted HTML in the widget payload's text field +normWs <- function(s) trimws(gsub("\\s+", " ", s)) +countOccurrences <- function(pattern, s) +{ + m <- gregexpr(pattern, s, fixed = TRUE)[[1]] + if (identical(m, -1L)) 0 else length(m) +} + xx <- structure(1:5, .Names = c("a", "b", "c", "d", "e"), statistic = "%") x2 <- matrix(1:12, 4, 3, dimnames = list(letters[1:4], c("X", "Y", "Z"))) test_that("Percentage data", @@ -36,18 +44,11 @@ test_that("Text data is exported correctly", # sig.leader.circles ----------------------------------------------------- -tableHtml <- function(res) res$x$text # rhtmlMetro::Box stores the emitted HTML in the widget payload's text field -normWs <- function(s) trimws(gsub("\\s+", " ", s)) -countOccurrences <- function(pattern, s) -{ - m <- gregexpr(pattern, s, fixed = TRUE)[[1]] - if (identical(m, -1L)) 0 else length(m) -} - test_that("No sig.leader.circles emits no circle CSS or divs", { res <- CreateCustomTable(x2) expect_false(grepl(".circle", tableHtml(res), fixed = TRUE)) + expect_false(grepl('class="circle', tableHtml(res), fixed = TRUE)) }) test_that("Base circle classes are emitted when sig.leader.circles is supplied", @@ -58,9 +59,19 @@ test_that("Base circle classes are emitted when sig.leader.circles is supplied", circles <- matrix(0, 4, 3) res <- CreateCustomTable(x2, sig.leader.circles = circles) h <- normWs(tableHtml(res)) - expect_true(grepl(".circle2 { border: 2px solid rgb(120,120,120);", h, fixed = TRUE)) - expect_true(grepl(".circle1 { border: 1px solid rgb(150,150,150);", h, fixed = TRUE)) - expect_true(grepl(".circle0 { border: 0px solid rgb(0,0,0);", h, fixed = TRUE)) + fmt <- "display: inline-block; line-height:35px; border-radius:35px; height: 35px; width:35px;" + + # the trailing " {" is load-bearing: a bare ".circle2" also matches the filled + # variants ".circle21", ".circle20" and ".circle2-1", so without it the + # occurrence count would be wrong + expect_equal(countOccurrences(".circle2 {", h), 1) + expect_true(grepl(paste0(".circle2 { border: 2px solid rgb(120,120,120);", fmt, "}"), h, fixed = TRUE)) + + expect_equal(countOccurrences(".circle1 {", h), 1) + expect_true(grepl(paste0(".circle1 { border: 1px solid rgb(150,150,150);", fmt, "}"), h, fixed = TRUE)) + + expect_equal(countOccurrences(".circle0 {", h), 1) + expect_true(grepl(paste0(".circle0 { border: 0px solid rgb(0,0,0);", fmt, "}"), h, fixed = TRUE)) }) test_that("All nine filled circle variants are emitted with the correct fill colors", @@ -102,7 +113,7 @@ test_that("Every data cell is wrapped in a circle div carrying its own code", circles <- matrix(c(2, 1, 0, 2), 2, 2) res <- CreateCustomTable(x22, sig.leader.circles = circles) h <- tableHtml(res) - expect_equal(countOccurrences('
1
', h, fixed = TRUE)) expect_true(grepl('
2
', h, fixed = TRUE)) expect_true(grepl('
3
', h, fixed = TRUE)) @@ -121,15 +132,17 @@ test_that("Rendered cell text is preserved inside the circle div wrapping", test_that("Out-of-range codes pin the current (buggy) normalisation behaviour", { - # RS-21803: sig.leader.circles[!which(...)] <- 0 negates integer indices rather than + # sig.leader.circles[!which(...)] <- 0 negates integer indices rather than # inverting a logical mask, so out-of-range codes are not reset to 0 as documented. - # This test pins that behaviour deliberately, pending a fix. + # No defect ticket has been filed for this yet; this test pins that behaviour + # deliberately, pending a fix. x22 <- matrix(1:4, 2, 2, dimnames = list(c("a", "b"), c("X", "Y"))) circles <- matrix(c(5, 1, -3, 2), 2, 2) res <- CreateCustomTable(x22, sig.leader.circles = circles) h <- tableHtml(res) expect_true(grepl('
1
', h, fixed = TRUE)) expect_true(grepl('
3
', h, fixed = TRUE)) + expect_true(grepl('
2
', h, fixed = TRUE)) }) test_that("circle.size drives the emitted circle geometry", From ee13c0a6a4a911b6b549941c0387ef81e5b7216a Mon Sep 17 00:00:00 2001 From: Surrey Date: Thu, 20 Aug 2026 17:42:38 +1000 Subject: [PATCH 4/4] fix(test): make countOccurrences no-match branch actually reachable gregexpr returns -1L with attributes on no-match, so identical(m, -1L) was always FALSE and the helper returned 1 for absent patterns, making every "exactly once" assertion in this file vacuous. Compare m[1] instead. Also corrected a copy-pasted comment on the nine-variant loop that incorrectly claimed the trailing " {" is load-bearing there. Co-Authored-By: Claude Opus 4.8 (1M context) --- tests/testthat/test-createcustomtable.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/tests/testthat/test-createcustomtable.R b/tests/testthat/test-createcustomtable.R index 4e702d5..9151e1c 100644 --- a/tests/testthat/test-createcustomtable.R +++ b/tests/testthat/test-createcustomtable.R @@ -5,7 +5,7 @@ normWs <- function(s) trimws(gsub("\\s+", " ", s)) countOccurrences <- function(pattern, s) { m <- gregexpr(pattern, s, fixed = TRUE)[[1]] - if (identical(m, -1L)) 0 else length(m) + if (m[1] == -1L) 0L else length(m) } xx <- structure(1:5, .Names = c("a", "b", "c", "d", "e"), statistic = "%") @@ -98,8 +98,8 @@ test_that("All nine filled circle variants are emitted with the correct fill col for (i in seq_along(variants)) { v <- variants[i] - # the trailing " {" is load-bearing: a bare ".circle2" also matches ".circle21", - # ".circle20" and ".circle2-1", so without it the occurrence count would be wrong + # kept consistent with the base-class assertions; the nine variant names do not + # collide with each other. expect_equal(countOccurrences(paste0(".", v, " {"), h), 1, info = v) expected <- paste0(".", v, " { border: ", borders[i], "; background-color:", colors[i], ";", fmt, "}")