refactor: make perf test tolerances configurable via profile

Author: timcadman

tests/testthat/perf_tests/README.md

@@ -0,0 +1,48 @@
+# Performance Tests
+
+Performance tests measure the throughput (operations per second) of server-side functions and compare against baseline rates stored in profile CSV files.
+
+## How it works
+
+Each performance test:
+
+1. Runs a function in a loop for 30 seconds and calculates the current rate (ops/sec).
+2. Looks up the baseline rate for that test in the active profile CSV.
+3. If no entry exists, a new one is saved to the profile using the current rate and the profile-level default tolerances.
+4. Asserts that the current rate falls within `[baseline * lower_tolerance, baseline * upper_tolerance]`.
+
+## Profiles
+
+Profile CSVs live in `perf_files/` and contain columns:
+
+| Column | Description |
+|--------|-------------|
+| `refer_name` | Unique test identifier (e.g. `meanDS::perf::numeric::0`) |
+| `rate` | Baseline ops/sec |
+| `lower_tolerance` | Multiplier for the lower bound (e.g. `0.5` = 50% of baseline) |
+| `upper_tolerance` | Multiplier for the upper bound (e.g. `2.0` = 200% of baseline) |
+
+Available profiles:
+
+- `default_perf_profile.csv` -- default baseline
+- `performance_refactor_profile.csv` -- for local development; no effective upper limit
+- `azure-pipeline.csv`, `circleci.csv` -- CI-specific baselines
+
+## Switching profiles
+
+Set `.perf.reference.filename` in `setup.R` before sourcing `perf_rate.R`:
+
+```r
+.perf.reference.filename <- "perf_files/performance_refactor_profile.csv"
+source("perf_tests/perf_rate.R")
+```
+
+If not set, `perf_rate.R` defaults to `perf_files/default_perf_profile.csv`.
+
+## Self-populating entries
+
+When a test has no entry in the active profile, `perf.reference.save()` creates one using the current measured rate and the profile-level tolerances (`perf.profile.tolerance.lower/upper()`), which are read from the first row of the profile CSV. This means new tests automatically inherit the tolerance policy of whichever profile is active.
+
+## Skipping
+
+Performance tests are skipped on CRAN (`skip_on_cran()`) and CI (`skip_on_ci()`) by default, since results are hardware-dependent.

tests/testthat/perf_tests/perf_rate.R

@@ -8,14 +8,28 @@
 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
 #-------------------------------------------------------------------------------
 
-.perf.reference.filename <- 'perf_files/default_perf_profile.csv'
+.perf.reference.filename <- getOption("perf.profile", "perf_files/default_perf_profile.csv")
 
 .perf.reference <- NULL
 
 .load.pref <- function() {
     .perf.reference <<- read.csv(.perf.reference.filename, header = TRUE, sep = ",")
 }
 
+perf.profile.tolerance.lower <- function() {
+    if (is.null(.perf.reference))
+        .load.pref()
+
+    return(as.numeric(.perf.reference$lower_tolerance[1]))
+}
+
+perf.profile.tolerance.upper <- function() {
+    if (is.null(.perf.reference))
+        .load.pref()
+
+    return(as.numeric(.perf.reference$upper_tolerance[1]))
+}
+
 perf.reference.save <- function(perf.ref.name, rate, tolerance.lower, tolerance.upper) {
     if (is.null(.perf.reference))
         load.pref()

tests/testthat/setup.R

@@ -21,6 +21,7 @@ library(lme4)
 source("disclosure/set_disclosure_settings.R")
 source("random/set_random_seed_settings.R")
 
+options(perf.profile = "perf_files/performance_refactor_profile.csv")
 source("perf_tests/perf_rate.R")
 
 # context("setup - done")

tests/testthat/test-perf-meanDS.R

@@ -45,8 +45,8 @@ test_that("numeric meanDS - performance", {
     .current.rate   <- .count / (difftime(.current.time, .start.time, units = "secs")[[1]])
     .reference.rate <- perf.reference.rate("meanDS::perf::numeric::0")
     if (any(length(.reference.rate) == 0) || any(is.null(.reference.rate))) {
-        print(paste("meanDS::perf::numeric::0 ", .current.rate, 0.5, 2.0))
-        perf.reference.save("meanDS::perf::numeric::0", .current.rate, 0.5, 2.0)
+        print(paste("meanDS::perf::numeric::0 ", .current.rate, perf.profile.tolerance.lower(), perf.profile.tolerance.upper()))
+        perf.reference.save("meanDS::perf::numeric::0", .current.rate, perf.profile.tolerance.lower(), perf.profile.tolerance.upper())
     } else {
         print(paste("meanDS::perf::numeric::0 ", format(.current.rate, digits = 8), ", ", format(100.0 * .current.rate / .reference.rate, digits = 4), "%", sep = ''))
     }
@@ -80,8 +80,8 @@ test_that("numeric meanDS, with NA - performance", {
     .current.rate   <- .count / (difftime(.current.time, .start.time, units = "secs")[[1]])
     .reference.rate <- perf.reference.rate("meanDS::perf::numberAndNA::0")
     if (any(length(.reference.rate) == 0) || any(is.null(.reference.rate))) {
-        print(paste("meanDS::perf::numberAndNA::0 ", .current.rate, 0.5, 2.0))
-        perf.reference.save("meanDS::perf::numberAndNA::0", .current.rate, 0.5, 2.0)
+        print(paste("meanDS::perf::numberAndNA::0 ", .current.rate, perf.profile.tolerance.lower(), perf.profile.tolerance.upper()))
+        perf.reference.save("meanDS::perf::numberAndNA::0", .current.rate, perf.profile.tolerance.lower(), perf.profile.tolerance.upper())
     } else {
         print(paste("meanDS::perf::numberAndNA::0 ", format(.current.rate, digits = 8), ", ", format(100.0 * .current.rate / .reference.rate, digits = 4), "%", sep = ''))
     }

tests/testthat/test-perf-varDS.R

@@ -45,8 +45,8 @@ test_that("numeric varDS - performance", {
     .current.rate   <- .count / (difftime(.current.time, .start.time, units = "secs")[[1]])
     .reference.rate <- perf.reference.rate("varDS::perf::numeric::0")
     if (any(length(.reference.rate) == 0) || any(is.null(.reference.rate))) {
-        print(paste("varDS::perf::numeric::0 ", .current.rate, 0.5, 2.0))
-        perf.reference.save("varDS::perf::numeric::0", .current.rate, 0.5, 2.0)
+        print(paste("varDS::perf::numeric::0 ", .current.rate, perf.profile.tolerance.lower(), perf.profile.tolerance.upper()))
+        perf.reference.save("varDS::perf::numeric::0", .current.rate, perf.profile.tolerance.lower(), perf.profile.tolerance.upper())
     } else {
         print(paste("varDS::perf::numeric::0 ", format(.current.rate, digits = 8), ", ", format(100.0 * .current.rate / .reference.rate, digits = 4), "%", sep = ''))
     }
@@ -80,8 +80,8 @@ test_that("numeric varDS, with NA - performance", {
     .current.rate   <- .count / (difftime(.current.time, .start.time, units = "secs")[[1]])
     .reference.rate <- perf.reference.rate("varDS::perf::numberAndNA::0")
     if (any(length(.reference.rate) == 0) || any(is.null(.reference.rate))) {
-        print(paste("varDS::perf::numberAndNA::0 ", .current.rate, 0.5, 2.0))
-        perf.reference.save("varDS::perf::numberAndNA::0", .current.rate, 0.5, 2.0)
+        print(paste("varDS::perf::numberAndNA::0 ", .current.rate, perf.profile.tolerance.lower(), perf.profile.tolerance.upper()))
+        perf.reference.save("varDS::perf::numberAndNA::0", .current.rate, perf.profile.tolerance.lower(), perf.profile.tolerance.upper())
     } else {
         print(paste("varDS::perf::numberAndNA::0 ", format(.current.rate, digits = 8), ", ", format(100.0 * .current.rate / .reference.rate, digits = 4), "%", sep = ''))
     }