More execution settings validation #101

OHDSI · Jan 11, 2024 · 2665f6a · 2665f6a
1 parent 912c7c1
commit 2665f6a
Show file tree

Hide file tree

Showing 2 changed files with 77 additions and 2 deletions.
diff --git a/R/Execution.R b/R/Execution.R
@@ -48,9 +48,10 @@ execute <- function(analysisSpecifications,
   checkmate::assertChoice(x = keyringName, choices = keyringList$keyring, null.ok = TRUE, add = errorMessages)
   checkmate::reportAssertions(collection = errorMessages)
 
-  # Assert that the temp emulation schema is set if required for the dbms
-  # specified by the executionSettings
+  # Validate the execution settings
   if (is(executionSettings, "CdmExecutionSettings")) {
+    # Assert that the temp emulation schema is set if required for the dbms
+    # specified by the executionSettings
     connectionDetails <- retrieveConnectionDetails(
       connectionDetailsReference = executionSettings$connectionDetailsReference,
       keyringName = keyringName
@@ -59,7 +60,41 @@ execute <- function(analysisSpecifications,
       dbms = connectionDetails$dbms,
       tempEmulationSchema = executionSettings$tempEmulationSchema
     )
+
+    # Validate that the table names specified in the execution settings
+    # do not violate the maximum table length. To do this we will render
+    # a query using the execution settings so that SqlRender can provide
+    # the appropriate warning. Only stop execution if we are running on
+    # Oracle; otherwise it is unclear if the table name length will have
+    # an impact
+    cohortTableChecks <- lapply(
+      X = executionSettings$cohortTableNames,
+      FUN = function(tableName) {
+        sql <- SqlRender::render(
+          sql = "CREATE TABLE @table;",
+          table =  tableName
+        )
+        tryCatch({
+          SqlRender::translate(
+            sql = sql,
+            targetDialect = connectionDetails$dbms
+          )
+          return(TRUE)
+        }, warning = function(w) {
+          warning(w)
+          return(FALSE)
+        })
+      }
+    )
+
+    # Since the warning is thrown for all dbms systems, only stop if
+    # we are executing on Oracle
+    if (tolower(connectionDetails$dbms) == "oracle" && !all(unlist(cohortTableChecks))) {
+      stop("Your cohort table names are too long for Oracle. Please update your executionSettings to use shorter cohort table names and try again.")
+    }
   }
+
+  # Validate the modules
   modules <- ensureAllModulesInstantiated(analysisSpecifications)
   if (isFALSE(modules$allModulesInstalled)) {
     stop("Stopping execution due to module issues")

diff --git a/tests/testthat/test-Strategus.R b/tests/testthat/test-Strategus.R
@@ -102,3 +102,43 @@ test_that("Run unit test study", {
     expect_true(file.exists(file.path(resultsFolder, "TestModule1_1", "done")))
   }
 })
+
+test_that("Execute on Oracle stops if table names exceed length limit", {
+  sqlRenderTempEmulationSchema <- getOption("sqlRenderTempEmulationSchema", default = "")
+  options(sqlRenderTempEmulationSchema = "some_schema")
+  on.exit(options(sqlRenderTempEmulationSchema = sqlRenderTempEmulationSchema))
+
+  Sys.setenv("STRATEGUS_KEYRING_PASSWORD" = keyringPassword)
+  createKeyringForUnitTest(selectedKeyring = keyringName, selectedKeyringPassword = keyringPassword)
+  on.exit(deleteKeyringForUnitTest())
+
+  connectionDetails <- DatabaseConnector::createConnectionDetails(
+    dbms = "oracle"
+  )
+  Strategus::storeConnectionDetails(connectionDetails = connectionDetails,
+                                    connectionDetailsReference = "oracle-test",
+                                    keyringName = keyringName)
+  executionSettings <- Strategus::createCdmExecutionSettings(
+    connectionDetailsReference = "oracle-test",
+    workDatabaseSchema = "does_not_matter",
+    cdmDatabaseSchema = "does_not_matter",
+    cohortTableNames = CohortGenerator::getCohortTableNames("some_really_long_table_name_for_testing_that_oracle_throws_a_warning"),
+    workFolder = file.path(tempDir, "work_folder"),
+    resultsFolder = file.path(tempDir, "results_folder"),
+    minCellCount = 5
+  )
+
+  analysisSpecifications <- ParallelLogger::loadSettingsFromJson(
+    fileName = system.file("testdata/unitTestAnalysisSpecification.json",
+                           package = "Strategus"
+    )
+  )
+
+  expect_error(
+    Strategus::execute(
+      analysisSpecifications = analysisSpecifications,
+      executionSettings = executionSettings,
+      keyringName = keyringName
+      )
+  )
+})