Merge pull request #146 from OHDSI/getDbCohortMethodData-tests

getDbCohortMethodData unit-tests

R/DataLoadingSaving.R

@@ -136,7 +136,7 @@ getDbCohortMethodData <- function(connectionDetails,
   checkmate::assertCharacter(exposureTable, len = 1, add = errorMessages)
   checkmate::assertCharacter(outcomeDatabaseSchema, len = 1, add = errorMessages)
   checkmate::assertCharacter(outcomeTable, len = 1, add = errorMessages)
-  checkmate::assertCharacter(cdmVersion, len = 1, add = errorMessages)
+  checkmate::assertCharacter(cdmVersion, len = 1, n.chars = 1, pattern = "^[5]$", add = errorMessages)
   checkmate::assertLogical(firstExposureOnly, len = 1, add = errorMessages)
   checkmate::assertChoice(removeDuplicateSubjects, c("keep all", "keep first", "remove all"), add = errorMessages)
   checkmate::assertLogical(restrictToCommonPeriod, len = 1, add = errorMessages)
@@ -145,12 +145,9 @@ getDbCohortMethodData <- function(connectionDetails,
   checkmate::assertList(covariateSettings, add = errorMessages)
   checkmate::reportAssertions(collection = errorMessages)
 
-  if (is.null(studyStartDate)) {
-    studyStartDate <- ""
-  }
-  if (is.null(studyEndDate)) {
-    studyEndDate <- ""
-  }
+  dateCheck(studyStartDate)
+  dateCheck(studyEndDate)
+
   if (studyStartDate != "" &&
     regexpr("^[12][0-9]{3}[01][0-9][0-3][0-9]$", studyStartDate) == -1) {
     stop("Study start date must have format YYYYMMDD")
@@ -469,3 +466,20 @@ handleCohortCovariateBuilders <- function(covariateSettings,
   }
   return(covariateSettings)
 }
+
+dateCheck <- function(date) {
+  if (date != "") {
+    tryCatch({
+      dateFormatted <- paste0(
+        substr(x = date, start = 1, stop = 4), "-",
+        substr(x = date, start = 5, stop = 6), "-",
+        substr(x = date, start = 7, stop = 8)
+      )
+
+      date <- as.Date(dateFormatted)
+    }, error = function(e) {
+      stop(sprintf("Date: %s (%s) is not valid", date, dateFormatted))
+    })
+    checkmate::assertDate(date, lower = "1000-01-01", upper = "2999-12-31")
+  }
+}

R/Viewer.R

@@ -91,7 +91,14 @@ uploadExportedResults <- function(connectionDetails,
 
   ensureInstalled("ResultModelManager")
   connection <- DatabaseConnector::connect(connectionDetails)
-  on.exit(DatabaseConnector::disconnect(connection))
+
+  withr::defer({
+    tryCatch({
+      DatabaseConnector::disconnect(connection)
+    }, error = function(e) {
+      message(e)
+    })
+  })
 
   if (!append) {
     # Create tables
@@ -137,8 +144,13 @@ uploadExportedResults <- function(connectionDetails,
     dropTableIfExists = FALSE,
     createTable = !append
   )
-  on.exit(unlink(databaseIdentifierFile), add = TRUE)
-
+  withr::defer({
+    tryCatch({
+      unlink(databaseIdentifierFile)
+    }, error = function(e) {
+      message(e)
+    })
+  })
   # Upload results
   ResultModelManager::uploadResults(
     connection = connection,