Fix bug; extend unit test to cover subset of modules

R/Execution.R

@@ -233,7 +233,7 @@ execute <- function(analysisSpecifications,
   cat(error(paste0("ERROR: ", message, "\n")))
 }
 
-.subsetAnalysisSpecificationByModulesToExecute <- function(analysisSpecification, modulesToExecute) {
+.subsetAnalysisSpecificationByModulesToExecute <- function(analysisSpecifications, modulesToExecute) {
   # Get the modules in the analysis specification with their
   # index in the array
   modulesWithIndex <- lapply(

tests/testthat/test-Execution.R

@@ -282,6 +282,49 @@ test_that("Specify subset of modules to run", {
   )
 
   expect_true(all(modulesExecuted %in% modulesToExecute))
+
+  # Create a results DB and upload results
+  dbFilePath <- file.path(tempDir, "testdm.sqlite")
+  mydb <- dbConnect(RSQLite::SQLite(), dbFilePath)
+  dbDisconnect(mydb)
+
+  withr::defer(
+    {
+      unlink(dbFilePath, recursive = TRUE, force = TRUE)
+    },
+    testthat::teardown_env()
+  )
+
+  resultsConnectionDetails <- DatabaseConnector::createConnectionDetails(
+    dbms = "sqlite",
+    server = dbFilePath
+  )
+
+  resultsDataModelSettings <- Strategus::createResultsDataModelSettings(
+    resultsDatabaseSchema = "main",
+    resultsFolder = executionSettings$resultsFolder,
+    modulesToExecute = modulesToExecute
+  )
+
+  # Create cdm modules results data model -------------------------
+  cdmModulesAnalysisSpecifications <- ParallelLogger::loadSettingsFromJson(
+    fileName = system.file("testdata/cdmModulesAnalysisSpecifications.json",
+                           package = "Strategus"
+    )
+  )
+
+  Strategus::createResultDataModel(
+    analysisSpecifications = cdmModulesAnalysisSpecifications,
+    resultsDataModelSettings = resultsDataModelSettings,
+    resultsConnectionDetails = resultsConnectionDetails
+  )
+
+  # Upload cdm related results --------------------
+  Strategus::uploadResults(
+    analysisSpecifications = analysisSpecifications,
+    resultsDataModelSettings = resultsDataModelSettings,
+    resultsConnectionDetails = resultsConnectionDetails
+  )
 })
 
 test_that("Stop if error occurs during cohort generation", {