Fix DSLite tests and add to github actions CI

.github/workflows/dsBaseClient_test_suite.yaml

@@ -837,3 +837,71 @@ jobs:
               'log:coverage': `<a href="${codecovUrl}" target="_blank" rel="noopener noreferrer">Codecov</a>`
             }});
 
+
+  ################################################################################
+  # DSLite - the servers run inside the R session, so dsBase is installed into
+  # the runner's R library. Perf tests are excluded as timings are not comparable.
+  ################################################################################
+  dslite-dsbase:
+    name: DSLite tests
+    runs-on: ubuntu-latest
+    timeout-minutes: 60
+    env:
+      DS_DRIVER: DSLiteDriver
+      DSDANGER_REF: '6.3.4'
+      TEST_FILTER: 'smk-ds.[a-lA-L]|smk-(checkClass|isDefined)|smk-ds.[m-vM-V]|arg-|datachk-|disc-|expt-|smk_expt-|math-|_-|__dgr-|datachk_dgr-|smk_dgr-|arg_dgr-|disc_dgr-|smk_expt_dgr-|expt_dgr-|math_dgr-'
+    steps:
+      - name: Checkout dsBaseClient
+        uses: actions/checkout@v5
+        with:
+          path: dsBaseClient
+
+      - uses: ./dsBaseClient/.github/actions/setup-r-with-dsbase-deps
+
+      - name: Check out dsBase
+        uses: actions/checkout@v5
+        with:
+          repository: datashield/dsBase
+          ref: ${{ env.DSBASE_REF }}
+          path: dsBase
+
+      - name: Install dsBase
+        run: R -q -e 'pak::pkg_install("local::./dsBase")'
+
+      - name: Install dsDanger
+        run: R -q -e 'pak::pkg_install("github::datashield/dsDanger@${{ env.DSDANGER_REF }}")'
+
+      - name: Run tests with JUnit report
+        run: |
+          R -q -e '
+            devtools::load_all(quiet = TRUE);
+            library(testthat);
+            output_file <- file("test_console_output.txt");
+            sink(output_file, split = TRUE);
+            junit_rep <- JunitReporter$new(file = file.path(getwd(), "test_results.xml"));
+            progress_rep <- ProgressReporter$new(max_failures = 999999);
+            multi_rep <- MultiReporter$new(reporters = list(progress_rep, junit_rep));
+            options("datashield.return_errors" = FALSE, "default_driver" = "${{ env.DS_DRIVER }}");
+            test_dir("tests/testthat", filter = "${{ env.TEST_FILTER }}", reporter = multi_rep, stop_on_failure = FALSE)' || R_EXIT=$?
+          cat test_console_output.txt
+          n_tests=$(grep -c '<testcase' test_results.xml || true)
+          if [ "${R_EXIT:-0}" -eq 0 ] && [ "${n_tests:-0}" -eq 0 ]; then
+            echo "0 tests actually ran (no <testcase> entries in test_results.xml) - treating as a failure rather than a silent pass."
+            R_EXIT=1
+          fi
+          n_failed=$(grep -oE '<(failure|error)[ >]' test_results.xml | wc -l | tr -d ' ')
+          if [ "${R_EXIT:-0}" -eq 0 ] && [ "${n_failed:-0}" -gt 0 ]; then
+            echo "$n_failed test failure(s)/error(s) in test_results.xml - failing this shard."
+            R_EXIT=1
+          fi
+          exit "${R_EXIT:-0}"
+        working-directory: dsBaseClient
+
+      - name: Upload shard results
+        if: always()
+        uses: actions/upload-artifact@v6
+        with:
+          name: dslite
+          path: |
+            dsBaseClient/test_results.xml
+            dsBaseClient/test_console_output.txt

tests/testthat/connection_to_datasets/init_studies_datasets.R

@@ -109,8 +109,7 @@ init.studies.dataset.cluster.int <- function(variables)
     }
     else 
     {
-      #to do
-      #ds.test_env$login.data <- DSLite::setupCLUSTERTest("dsBase", env = ds.test_env)
+      ds.test_env$login.data <- dslite.login.data(c("cluster.int1", "cluster.int2", "cluster.int3"), c("CLUSTER_INT1", "CLUSTER_INT2", "CLUSTER_INT3")) # nolint: object_usage_linter.
     }
     ds.test_env$stats.var <- variables
   }
@@ -143,8 +142,7 @@ init.studies.dataset.cluster.slo <- function(variables)
     }
     else 
     {
-      #to do
-      #ds.test_env$login.data <- DSLite::setupCLUSTERTest("dsBase", env = ds.test_env)
+      ds.test_env$login.data <- dslite.login.data(c("cluster.slo1", "cluster.slo2", "cluster.slo3"), c("CLUSTER_SLO1", "CLUSTER_SLO2", "CLUSTER_SLO3")) # nolint: object_usage_linter.
     }
     ds.test_env$stats.var <- variables
 
@@ -178,8 +176,7 @@ init.studies.dataset.anthro <- function(variables)
     }
     else 
     {
-      #to do
-      #ds.test_env$login.data <- DSLite::setupCLUSTERTest("dsBase", env = ds.test_env)
+      ds.test_env$login.data <- dslite.login.data(c("study1", "study2", "study3"), c("anthro1", "anthro2", "anthro3")) # nolint: object_usage_linter.
     }
     ds.test_env$stats.var <- variables
 
@@ -213,8 +210,7 @@ init.studies.dataset.gamlss <- function(variables)
     }
     else 
     {
-      #to do
-      #ds.test_env$login.data <- DSLite::setupCLUSTERTest("dsBase", env = ds.test_env)
+      ds.test_env$login.data <- dslite.login.data(c("study1", "study2", "study3"), c("gamlss1", "gamlss2", "gamlss3")) # nolint: object_usage_linter.
     }
     ds.test_env$stats.var <- variables
 

tests/testthat/connection_to_datasets/init_testing_datasets.R

@@ -174,8 +174,7 @@ init.testing.dataset.factor_levels <- function()
     }
     else
     {
-      login.data <- DSLite::setupDATASETTest("dsBase", env = ds.test_env)
-      ds.test_env$login.data <- subset(login.data, server=="study1")
+      ds.test_env$login.data <- dslite.login.data(c("GROUP1", "GROUP2", "GROUP3"), c("FACTOR_LEVELS1", "FACTOR_LEVELS2", "FACTOR_LEVELS3"))
     }  
     ds.test_env$stats.var <- list('ID', 'COLOURS', 'COLOURS.NUMBERS', 'POSITIVE.NUMBERS', 'NEGATIVE.NUMBERS', 'NUMBERS',
                                   'POSITIVE.DECIMAL', 'NEGATIVE.DECIMAL', 'DECIMAL', 'PLANETS.CHARACTERS')
@@ -203,18 +202,57 @@ init.testing.dataset.factor_levels.1 <- function()
     }
     else
     {
-      login.data <- DSLite::setupDATASETTest("dsBase", env = ds.test_env)
-      ds.test_env$login.data <- subset(login.data, server=="study1")
+      ds.test_env$login.data <- dslite.login.data(c("GROUP1"), c("FACTOR_LEVELS1"))
     }  
     ds.test_env$stats.var <- list('ID', 'COLOURS', 'COLOURS.NUMBERS', 'POSITIVE.NUMBERS', 'NEGATIVE.NUMBERS', 'NUMBERS',
                                   'POSITIVE.DECIMAL', 'NEGATIVE.DECIMAL', 'DECIMAL', 'PLANETS.CHARACTERS')
   }
 }
 
+# A real server keeps its R warnings to itself; DSLite raises them in the client session, where testthat records each one
+DSLiteTestServer <- R6::R6Class("DSLiteTestServer", inherit = DSLite::DSLiteServer, # nolint: namespace_linter.
+  public = list(
+    aggregate = function(sid, expr) suppressWarnings(super$aggregate(sid, expr)),
+    assignExpr = function(sid, symbol, expr) suppressWarnings(super$assignExpr(sid, symbol, expr))
+  )
+)
+methods::setOldClass(c("DSLiteTestServer", "DSLiteServer"))
+
+# Serve the data_files tables that CI uploads to Opal/Armadillo, not DSLite's bundled copies, which hold different data
+ci.tables <- function(table.names)
+{
+  files <- list.files("data_files", pattern = "[.]rda$", recursive = TRUE, full.names = TRUE)
+  tables <- lapply(table.names, function(table.name) {
+    tableFile <- files[sub("[.]rda$", "", basename(files)) == sub("^.*[.]", "", table.name)]
+    if (length(tableFile) != 1)
+      stop("No unique data_files table for DSLite table '", table.name, "'", call. = FALSE)
+    get(load(tableFile, envir = environment()))
+  })
+  setNames(tables, table.names)
+}
+
+# Matches the CI servers: same tables, permissive privacy control, dsDanger methods available
+new.dslite.server <- function(table.names)
+{
+  server <- DSLiteTestServer$new(
+    tables = ci.tables(table.names),
+    config = DSLite::defaultDSConfiguration(include = c("dsBase", "dsDanger")) # nolint: namespace_linter.
+  )
+  server$option("default.datashield.privacyControlLevel", deparse("permissive"))
+  server
+}
+
 log.in.data.server <- function()
 {
+  variables <- ds.test_env$stats.var
+  if (ds.test_env$driver == "DSLiteDriver")
+  {
+    ds.test_env$dslite.server <- new.dslite.server(unique(ds.test_env$login.data$table))
+    # Opal/Armadillo treat the variables filter as a set; DSLite would duplicate repeated columns as 'X.1'
+    variables <- unique(variables)
+  }
   # ds.test_env$connections <- datashield.login(logins=ds.test_env$login.data, assign=TRUE,variables=ds.test_env$stats.var, opts = getOption("datashield.opts", list(ssl_verifyhost=0, ssl_verifypeer=0)))
-  ds.test_env$connections <- datashield.login(logins=ds.test_env$login.data, assign=TRUE,variables=ds.test_env$stats.var, opts = getOption("datashield.opts"))
+  ds.test_env$connections <- DSI::datashield.login(logins=ds.test_env$login.data, assign=TRUE,variables=variables, opts = getOption("datashield.opts"))
 }
 
 
@@ -305,3 +343,11 @@ disconnect.testing.dataset.factor_levels.1 <- function()
 {
   log.out.data.server()
 }
+
+dslite.login.data <- function(servers, tables)
+{
+  builder <- DSI::newDSLoginBuilder(.silent = TRUE)
+  for (i in seq_along(servers))
+    builder$append(server = servers[[i]], url = "dslite.server", table = tables[[i]], driver = "DSLiteDriver")
+  builder$build()
+}

tests/testthat/dstest_functions/ds_expect_variables.R

@@ -12,10 +12,10 @@
 # Tests
 #
 
-ds_expect_variables <- function(expected.variables) {
+ds_expect_variables <- function(expected.variables, optional.variables = NULL) {
     studies.current.variables <- ds.ls()
 
     for (study.current.variables in studies.current.variables) {
-        expect_setequal(study.current.variables$objects.found, expected.variables)
+        expect_setequal(setdiff(study.current.variables$objects.found, optional.variables), expected.variables) # nolint: object_usage_linter.
     }
 }

tests/testthat/setup.R

@@ -26,6 +26,9 @@ library(DSOpal)
 library(DSMolgenisArmadillo)
 library(DSLite)
 
+# 'dgr-' files rely on an earlier file in the same session having attached dsDangerClient; attach it here so each file also runs on its own
+if (requireNamespace("dsDangerClient", quietly = TRUE)) library(dsDangerClient) # nolint: missing_package_linter, undesirable_function_linter, unused_import_linter.
+
 source("dstest_functions/ds_expect_variables.R")
 source("perf_tests/perf_rate.R")
 source("connection_to_datasets/login_details.R")

tests/testthat/test-_-vm-test.R

@@ -26,6 +26,7 @@ init.testing.datasets()
 
 test_that("The virtual machine is loaded. ",
 {
+    skip_if(ds.test_env$driver == "DSLiteDriver", "there is no Opal virtual machine under DSLite")
     response <- httr::HEAD(url=ds.test_env$ping_address, config=ds.test_env$ping_config)
     expect_true(http_status(response)$reason %in% c("OK", "Unauthorized"))
 })

tests/testthat/test-arg-ds.dataFrameSort.R

@@ -26,9 +26,9 @@ test_that("dataFrameSort_noargs", {
     res.errors <- DSI::datashield.errors()
 
     expect_length(res.errors, 3)
-    expect_match(res.errors$sim1, "* Error in strsplit\\(df.name, split = \"\"\\) : non-character argument*")
-    expect_match(res.errors$sim2, "* Error in strsplit\\(df.name, split = \"\"\\) : non-character argument*")
-    expect_match(res.errors$sim3, "* Error in strsplit\\(df.name, split = \"\"\\) : non-character argument*")
+    expect_match(res.errors$sim1, "non-character argument*")
+    expect_match(res.errors$sim2, "non-character argument*")
+    expect_match(res.errors$sim3, "non-character argument*")
 })
 
 # context("ds.dataFrameSort::arg::sorted dataframe, of factors")
@@ -41,9 +41,9 @@ test_that("dataFrameSort_factors", {
     res.errors <- DSI::datashield.errors()
 
     expect_length(res.errors, 3)
-    expect_match(res.errors$sim1, "* Error : specified sort.key variable is of type 'factor'*")
-    expect_match(res.errors$sim2, "* Error : specified sort.key variable is of type 'factor'*")
-    expect_match(res.errors$sim3, "* Error : specified sort.key variable is of type 'factor'*")
+    expect_match(res.errors$sim1, "specified sort.key variable is of type 'factor'*")
+    expect_match(res.errors$sim2, "specified sort.key variable is of type 'factor'*")
+    expect_match(res.errors$sim3, "specified sort.key variable is of type 'factor'*")
 })
 
 #

tests/testthat/test-arg-ds.dataFrameSubset.R

@@ -89,9 +89,9 @@ test_that("dataFrameSubset_erros", {
     res.errors <- DSI::datashield.errors()
 
     expect_length(res.errors, 3)
-    expect_match(res.errors$sim1, "* Error : FAILED: Boolean.operator must be: '==', '!=', '<', '<=', '>' or '>='*")
-    expect_match(res.errors$sim2, "* Error : FAILED: Boolean.operator must be: '==', '!=', '<', '<=', '>' or '>='*")
-    expect_match(res.errors$sim3, "* Error : FAILED: Boolean.operator must be: '==', '!=', '<', '<=', '>' or '>='*")
+    expect_match(res.errors$sim1, "FAILED: Boolean.operator must be: '==', '!=', '<', '<=', '>' or '>='*")
+    expect_match(res.errors$sim2, "FAILED: Boolean.operator must be: '==', '!=', '<', '<=', '>' or '>='*")
+    expect_match(res.errors$sim3, "FAILED: Boolean.operator must be: '==', '!=', '<', '<=', '>' or '>='*")
 })
 
 #

tests/testthat/test-arg-ds.foobar.R

@@ -32,6 +32,8 @@ test_that("NULL connections", {
         expect_error(datashield.aggregate(conns=NULL, expr=calltext), "unable to find an inherited method for function 'dsIsAsync' for signature 'conn = \"NULL\"'", fixed=TRUE)
     } else if (ds.test_env$driver == "OpalDriver") {
         expect_error(datashield.aggregate(conns=NULL, expr=calltext), "unable to find an inherited method for function 'dsIsAsync' for signature 'conn = \"NULL\"'", fixed=TRUE)
+    } else if (ds.test_env$driver == "DSLiteDriver") {
+        expect_error(datashield.aggregate(conns=NULL, expr=calltext), "unable to find an inherited method for function 'dsIsAsync' for signature 'conn = \"NULL\"'", fixed=TRUE)
     } else {
         fail(message = "Unknown driver type", info = ds.test_env$driver)
     }
@@ -58,11 +60,23 @@ test_that("non existent aggregate foobarDS", {
 
     expect_length(errs, 3)
     expect_length(errs$sim1, 1)
-    expect_true(errs$sim1 %in% c("Command 'fooBarDS()' failed on 'sim1': No such DataSHIELD 'AGGREGATE' method with name: fooBarDS", "[Client error: (400) Bad Request] No such DataSHIELD 'AGGREGATE' method with name: fooBarDS", "Bad request: No such DataSHIELD 'AGGREGATE' method with name: fooBarDS"))
+    if (ds.test_env$driver == "DSLiteDriver") {
+        expect_match(errs$sim1, "^DataSHIELD configuration does not allow expression: fooBarDS\n")
+    } else {
+        expect_true(errs$sim1 %in% c("Command 'fooBarDS()' failed on 'sim1': No such DataSHIELD 'AGGREGATE' method with name: fooBarDS", "[Client error: (400) Bad Request] No such DataSHIELD 'AGGREGATE' method with name: fooBarDS", "Bad request: No such DataSHIELD 'AGGREGATE' method with name: fooBarDS"))
+    }
     expect_length(errs$sim2, 1)
-    expect_true(errs$sim2 %in% c("Command 'fooBarDS()' failed on 'sim2': No such DataSHIELD 'AGGREGATE' method with name: fooBarDS", "[Client error: (400) Bad Request] No such DataSHIELD 'AGGREGATE' method with name: fooBarDS", "Bad request: No such DataSHIELD 'AGGREGATE' method with name: fooBarDS"))
+    if (ds.test_env$driver == "DSLiteDriver") {
+        expect_match(errs$sim2, "^DataSHIELD configuration does not allow expression: fooBarDS\n")
+    } else {
+        expect_true(errs$sim2 %in% c("Command 'fooBarDS()' failed on 'sim2': No such DataSHIELD 'AGGREGATE' method with name: fooBarDS", "[Client error: (400) Bad Request] No such DataSHIELD 'AGGREGATE' method with name: fooBarDS", "Bad request: No such DataSHIELD 'AGGREGATE' method with name: fooBarDS"))
+    }
     expect_length(errs$sim3, 1)
-    expect_true(errs$sim3 %in% c("Command 'fooBarDS()' failed on 'sim3': No such DataSHIELD 'AGGREGATE' method with name: fooBarDS", "[Client error: (400) Bad Request] No such DataSHIELD 'AGGREGATE' method with name: fooBarDS", "Bad request: No such DataSHIELD 'AGGREGATE' method with name: fooBarDS"))
+    if (ds.test_env$driver == "DSLiteDriver") {
+        expect_match(errs$sim3, "^DataSHIELD configuration does not allow expression: fooBarDS\n")
+    } else {
+        expect_true(errs$sim3 %in% c("Command 'fooBarDS()' failed on 'sim3': No such DataSHIELD 'AGGREGATE' method with name: fooBarDS", "[Client error: (400) Bad Request] No such DataSHIELD 'AGGREGATE' method with name: fooBarDS", "Bad request: No such DataSHIELD 'AGGREGATE' method with name: fooBarDS"))
+    }
 })
 
 # context("ds.foobar::arg::assign")
@@ -72,6 +86,8 @@ test_that("NULL connections", {
         expect_error(datashield.assign(conns=NULL, symbol="new_obj", value=calltext), "unable to find an inherited method for function 'dsIsAsync' for signature 'conn = \"NULL\"'", fixed=TRUE)
     } else if (ds.test_env$driver == "OpalDriver") {
         expect_error(datashield.assign(conns=NULL, symbol="new_obj", value=calltext), "unable to find an inherited method for function 'dsIsAsync' for signature 'conn = \"NULL\"'", fixed=TRUE)
+    } else if (ds.test_env$driver == "DSLiteDriver") {
+        expect_error(datashield.assign(conns=NULL, symbol="new_obj", value=calltext), "unable to find an inherited method for function 'dsIsAsync' for signature 'conn = \"NULL\"'", fixed=TRUE)
     } else {
         fail(message = "Unknown driver type", info = ds.test_env$driver)
     }
@@ -105,11 +121,23 @@ test_that("non existent assign foobarDS", {
     errs <- datashield.errors()
     expect_length(errs, 3)
     expect_length(errs$sim1, 1)
-    expect_true(errs$sim1 %in% c("Command 'fooBarDS()' failed on 'sim1': No such DataSHIELD 'ASSIGN' method with name: fooBarDS", "[Client error: (400) Bad Request] No such DataSHIELD 'ASSIGN' method with name: fooBarDS", "Bad request: No such DataSHIELD 'ASSIGN' method with name: fooBarDS"))
+    if (ds.test_env$driver == "DSLiteDriver") {
+        expect_match(errs$sim1, "^DataSHIELD configuration does not allow expression: fooBarDS\n")
+    } else {
+        expect_true(errs$sim1 %in% c("Command 'fooBarDS()' failed on 'sim1': No such DataSHIELD 'ASSIGN' method with name: fooBarDS", "[Client error: (400) Bad Request] No such DataSHIELD 'ASSIGN' method with name: fooBarDS", "Bad request: No such DataSHIELD 'ASSIGN' method with name: fooBarDS"))
+    }
     expect_length(errs$sim2, 1)
-    expect_true(errs$sim2 %in% c("Command 'fooBarDS()' failed on 'sim2': No such DataSHIELD 'ASSIGN' method with name: fooBarDS", "[Client error: (400) Bad Request] No such DataSHIELD 'ASSIGN' method with name: fooBarDS", "Bad request: No such DataSHIELD 'ASSIGN' method with name: fooBarDS"))
+    if (ds.test_env$driver == "DSLiteDriver") {
+        expect_match(errs$sim2, "^DataSHIELD configuration does not allow expression: fooBarDS\n")
+    } else {
+        expect_true(errs$sim2 %in% c("Command 'fooBarDS()' failed on 'sim2': No such DataSHIELD 'ASSIGN' method with name: fooBarDS", "[Client error: (400) Bad Request] No such DataSHIELD 'ASSIGN' method with name: fooBarDS", "Bad request: No such DataSHIELD 'ASSIGN' method with name: fooBarDS"))
+    }
     expect_length(errs$sim3, 1)
-    expect_true(errs$sim3 %in% c("Command 'fooBarDS()' failed on 'sim3': No such DataSHIELD 'ASSIGN' method with name: fooBarDS", "[Client error: (400) Bad Request] No such DataSHIELD 'ASSIGN' method with name: fooBarDS", "Bad request: No such DataSHIELD 'ASSIGN' method with name: fooBarDS"))
+    if (ds.test_env$driver == "DSLiteDriver") {
+        expect_match(errs$sim3, "^DataSHIELD configuration does not allow expression: fooBarDS\n")
+    } else {
+        expect_true(errs$sim3 %in% c("Command 'fooBarDS()' failed on 'sim3': No such DataSHIELD 'ASSIGN' method with name: fooBarDS", "[Client error: (400) Bad Request] No such DataSHIELD 'ASSIGN' method with name: fooBarDS", "Bad request: No such DataSHIELD 'ASSIGN' method with name: fooBarDS"))
+    }
 })
 
 #

tests/testthat/test-arg-ds.glmSLMA.R

@@ -27,9 +27,9 @@ test_that("glmSLMA_errors", {
   res.errors<-datashield.errors()
 
   expect_length(res.errors, 3)
-  expect_match(res.errors$sim1, "* Error in model\\.frame\\.default\\(formula = formula2use, data = dataTable,  : \n  invalid type \\(NULL\\) for variable 'D\\$LAB_TRIG'")
-  expect_match(res.errors$sim2, "* Error in model\\.frame\\.default\\(formula = formula2use, data = dataTable,  : \n  invalid type \\(NULL\\) for variable 'D\\$LAB_TRIG'")
-  expect_match(res.errors$sim3, "* Error in model\\.frame\\.default\\(formula = formula2use, data = dataTable,  : \n  invalid type \\(NULL\\) for variable 'D\\$LAB_TRIG'")
+  expect_match(res.errors$sim1, "invalid type (NULL) for variable 'D$LAB_TRIG'", fixed = TRUE)
+  expect_match(res.errors$sim2, "invalid type (NULL) for variable 'D$LAB_TRIG'", fixed = TRUE)
+  expect_match(res.errors$sim3, "invalid type (NULL) for variable 'D$LAB_TRIG'", fixed = TRUE)
 })
 
 #