Skip to content

Commit fbce595

Browse files
azimovazimov
committed
Runtime type checking for query namespaces
1 parent e60edeb commit fbce595

4 files changed

Lines changed: 190 additions & 2 deletions

File tree

‎R/QueryNamespace.R‎

Lines changed: 67 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -14,6 +14,52 @@
1414
# See the License for the specific language governing permissions and
1515
# limitations under the License.
1616

17+
18+
.typeCheckVariable <- function(varName, value, typeStr, isArray) {
19+
# Map type strings to checking functions
20+
typeChecks <- list(
21+
INT = function(x) is.numeric(x) && all(x == as.integer(x)),
22+
BIGINT = function(x) is.numeric(x) && all(x %% 1 == 0),
23+
CHAR = function(x) is.character(x),
24+
VARCHAR = function(x) is.character(x),
25+
TEXT = function(x) is.character(x),
26+
NUMERIC = function(x) is.numeric(x),
27+
BOOLEAN = function (x) is.logical(x) || (is.numeric(x) && all(x %in% c(0, 1)))
28+
)
29+
30+
# Check type exists
31+
baseType <- gsub("\\[\\]", "", typeStr)
32+
if (!baseType %in% names(typeChecks)) {
33+
stop(sprintf("Unknown type check: %s", typeStr))
34+
}
35+
checkFun <- typeChecks[[baseType]]
36+
37+
# Check presence
38+
if (is.null(value)) {
39+
stop(sprintf("Required variable '%s' (type check %s) not supplied to render().", varName, typeStr))
40+
}
41+
# Check NA
42+
if (any(is.na(value))) {
43+
stop(sprintf("Variable '%s' (type check %s) contains NA values, which are not allowed.", varName, typeStr))
44+
}
45+
46+
# Array vs scalar
47+
if (isArray) {
48+
if (!checkFun(value)) {
49+
stop(sprintf("Variable '%s' must be an array of type %s.", varName, baseType))
50+
}
51+
# Must be vector of length >= 1
52+
if (!(is.vector(value) && length(value) >= 1)) {
53+
stop(sprintf("Variable '%s' must be a non-empty vector of type %s.", varName, baseType))
54+
}
55+
} else {
56+
if (!checkFun(value) || length(value) != 1) {
57+
stop(sprintf("Variable '%s' must be a scalar of type %s.", varName, baseType))
58+
}
59+
}
60+
}
61+
62+
1763
#' QueryNamespace
1864
#' @export
1965
#' @description
@@ -174,13 +220,32 @@ QueryNamespace <- R6::R6Class(
174220
#' @param ... additional variables to be passed to SqlRender::render - will overwrite anything in namespace
175221
render = function(sql, ...) {
176222
params <- private$replacementVars$as_list()
177-
178223
addVars <- list(...)
179-
180224
for (k in names(addVars)) {
181225
params[[k]] <- addVars[[k]]
182226
}
183227

228+
# Regex for {TYPEC TYPE[@] @var_name}
229+
typecPattern <- "\\{TYPEC\\s+([A-Z]+(\\[\\])?)\\s+@([a-zA-Z0-9_]+)\\}"
230+
typecMatches <- gregexpr(typecPattern, sql, perl = TRUE)
231+
matchPositions <- regmatches(sql, typecMatches)[[1]]
232+
233+
if (length(matchPositions) > 0) {
234+
for (matchStr in matchPositions) {
235+
m <- regexec(typecPattern, matchStr, perl = TRUE)
236+
parts <- regmatches(matchStr, m)[[1]]
237+
if (length(parts) >= 4) {
238+
typeStr <- parts[2] # e.g. INT, INT[], CHAR, CHAR[], NUMERIC, NUMERIC[]
239+
isArray <- grepl("\\[\\]", typeStr)
240+
varName <- parts[4] # <-- Should be parts[4], not parts[3]
241+
value <- params[[varName]]
242+
.typeCheckVariable(varName, value, typeStr, isArray)
243+
}
244+
}
245+
# Remove all {TYPEC ...} lines from SQL
246+
sql <- gsub(typecPattern, "", sql, perl = TRUE)
247+
}
248+
184249
params$sql <- sql
185250
params$warnOnMissingParameters <- FALSE
186251
do.call(SqlRender::render, params)

‎man/ResultModelManager-package.Rd‎

Lines changed: 1 addition & 0 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎tests/testthat/test-QueryNamespace.R‎

Lines changed: 35 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -128,3 +128,38 @@ test_that("create helper function works", {
128128
)
129129
)
130130
})
131+
132+
133+
test_that("render enforces type checks in SQL", {
134+
cohortNamespace <- QueryNamespace$new(
135+
connectionHandler = connectionHandler,
136+
tableSpecification = tableSpecification,
137+
result_schema = "main",
138+
tablePrefix = "cd_"
139+
)
140+
on.exit({
141+
cohortNamespace$closeConnection()
142+
}, add = TRUE)
143+
144+
# INT scalar OK
145+
sql <- "{TYPEC INT @cohort_id} SELECT * FROM @result_schema.@cohort WHERE cohort_definition_id = @cohort_id"
146+
expect_error(cohortNamespace$render(sql, cohort_id = 1.5), "scalar of type INT")
147+
expect_error(cohortNamespace$render(sql, cohort_id = NA), "contains NA")
148+
expect_error(cohortNamespace$render(sql), "not supplied")
149+
150+
# BIGINT array OK
151+
sql <- "{TYPEC BIGINT[] @ids} SELECT * FROM @result_schema.@cohort WHERE cohort_definition_id IN (@ids)"
152+
expect_silent(cohortNamespace$render(sql, ids = c(1, 2, 3)))
153+
expect_error(cohortNamespace$render(sql, ids = c(1, 2.5)), "array of type BIGINT")
154+
155+
# CHAR scalar OK
156+
sql <- "{TYPEC CHAR @cohort_name} SELECT * FROM @result_schema.@cohort WHERE cohort_name = @cohort_name"
157+
expect_silent(cohortNamespace$render(sql, cohort_name = "test"))
158+
expect_error(cohortNamespace$render(sql, cohort_name = c("a", "b")), "scalar of type CHAR")
159+
expect_error(cohortNamespace$render(sql, cohort_name = NA), "contains NA")
160+
161+
# CHAR array OK
162+
sql <- "{TYPEC CHAR[] @names} SELECT * FROM @result_schema.@cohort WHERE cohort_name IN (@names)"
163+
expect_silent(cohortNamespace$render(sql, names = c("a", "b")))
164+
expect_error(cohortNamespace$render(sql, names = c("a", NA)), "contains NA")
165+
})

‎tests/testthat/test-TypeChecker.R‎

Lines changed: 87 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,87 @@
1+
test_that(".typeCheckVariable INT checks", {
2+
expect_silent(.typeCheckVariable("x", 1L, "INT", FALSE))
3+
expect_silent(.typeCheckVariable("x", 1, "INT", FALSE))
4+
expect_error(.typeCheckVariable("x", 1.5, "INT", FALSE), "scalar of type INT")
5+
expect_error(.typeCheckVariable("x", NA, "INT", FALSE), "contains NA")
6+
expect_error(.typeCheckVariable("x", NULL, "INT", FALSE), "not supplied")
7+
expect_error(.typeCheckVariable("x", c(1L, 2L), "INT", FALSE), "scalar of type INT")
8+
expect_silent(.typeCheckVariable("x", c(1L, 2L), "INT[]", TRUE))
9+
expect_error(.typeCheckVariable("x", c(1.5, 2L), "INT[]", TRUE), "array of type INT")
10+
expect_error(.typeCheckVariable("x", numeric(0), "INT[]", TRUE), "non-empty vector")
11+
})
12+
13+
test_that(".typeCheckVariable BIGINT checks", {
14+
expect_silent(.typeCheckVariable("x", 123456789012345, "BIGINT", FALSE))
15+
expect_silent(.typeCheckVariable("x", 1e11, "BIGINT", FALSE))
16+
expect_silent(.typeCheckVariable("x", 2, "BIGINT", FALSE))
17+
expect_error(.typeCheckVariable("x", 1.5, "BIGINT", FALSE), "scalar of type BIGINT")
18+
expect_error(.typeCheckVariable("x", NA, "BIGINT", FALSE), "contains NA")
19+
expect_error(.typeCheckVariable("x", NULL, "BIGINT", FALSE), "not supplied")
20+
expect_error(.typeCheckVariable("x", c(1, 2), "BIGINT", FALSE), "scalar of type BIGINT")
21+
expect_silent(.typeCheckVariable("x", c(1, 2, 3), "BIGINT[]", TRUE))
22+
expect_error(.typeCheckVariable("x", c(1, 2.5), "BIGINT[]", TRUE), "array of type BIGINT")
23+
expect_error(.typeCheckVariable("x", numeric(0), "BIGINT[]", TRUE), "non-empty vector")
24+
})
25+
26+
test_that(".typeCheckVariable CHAR checks", {
27+
expect_silent(.typeCheckVariable("x", "a", "CHAR", FALSE))
28+
expect_error(.typeCheckVariable("x", 1, "CHAR", FALSE), "scalar of type CHAR")
29+
expect_error(.typeCheckVariable("x", NA_character_, "CHAR", FALSE), "contains NA")
30+
expect_error(.typeCheckVariable("x", NULL, "CHAR", FALSE), "not supplied")
31+
expect_error(.typeCheckVariable("x", c("a", "b"), "CHAR", FALSE), "scalar of type CHAR")
32+
expect_silent(.typeCheckVariable("x", c("a", "b"), "CHAR[]", TRUE))
33+
expect_error(.typeCheckVariable("x", c("a", NA_character_), "CHAR[]", TRUE), "contains NA")
34+
expect_error(.typeCheckVariable("x", character(0), "CHAR[]", TRUE), "non-empty vector")
35+
})
36+
37+
test_that(".typeCheckVariable VARCHAR checks", {
38+
expect_silent(.typeCheckVariable("x", "hello", "VARCHAR", FALSE))
39+
expect_error(.typeCheckVariable("x", 1, "VARCHAR", FALSE), "scalar of type VARCHAR")
40+
expect_error(.typeCheckVariable("x", NA_character_, "VARCHAR", FALSE), "contains NA")
41+
expect_error(.typeCheckVariable("x", NULL, "VARCHAR", FALSE), "not supplied")
42+
expect_error(.typeCheckVariable("x", c("a", "b"), "VARCHAR", FALSE), "scalar of type VARCHAR")
43+
expect_silent(.typeCheckVariable("x", c("a", "b"), "VARCHAR[]", TRUE))
44+
expect_error(.typeCheckVariable("x", c("a", NA_character_), "VARCHAR[]", TRUE), "contains NA")
45+
expect_error(.typeCheckVariable("x", character(0), "VARCHAR[]", TRUE), "non-empty vector")
46+
})
47+
48+
test_that(".typeCheckVariable TEXT checks", {
49+
expect_silent(.typeCheckVariable("x", "some text", "TEXT", FALSE))
50+
expect_error(.typeCheckVariable("x", 1, "TEXT", FALSE), "scalar of type TEXT")
51+
expect_error(.typeCheckVariable("x", NA_character_, "TEXT", FALSE), "contains NA")
52+
expect_error(.typeCheckVariable("x", NULL, "TEXT", FALSE), "not supplied")
53+
expect_error(.typeCheckVariable("x", c("a", "b"), "TEXT", FALSE), "scalar of type TEXT")
54+
expect_silent(.typeCheckVariable("x", c("a", "b"), "TEXT[]", TRUE))
55+
expect_error(.typeCheckVariable("x", c("a", NA_character_), "TEXT[]", TRUE), "contains NA")
56+
expect_error(.typeCheckVariable("x", character(0), "TEXT[]", TRUE), "non-empty vector")
57+
})
58+
59+
test_that(".typeCheckVariable NUMERIC checks", {
60+
expect_silent(.typeCheckVariable("x", 3.14, "NUMERIC", FALSE))
61+
expect_silent(.typeCheckVariable("x", 1L, "NUMERIC", FALSE))
62+
expect_error(.typeCheckVariable("x", "a", "NUMERIC", FALSE), "scalar of type NUMERIC")
63+
expect_error(.typeCheckVariable("x", NA, "NUMERIC", FALSE), "contains NA")
64+
expect_error(.typeCheckVariable("x", NULL, "NUMERIC", FALSE), "not supplied")
65+
expect_error(.typeCheckVariable("x", c(1, 2), "NUMERIC", FALSE), "scalar of type NUMERIC")
66+
expect_silent(.typeCheckVariable("x", c(1.1, 2.2, 3.3), "NUMERIC[]", TRUE))
67+
expect_error(.typeCheckVariable("x", c(1.1, NA), "NUMERIC[]", TRUE), "contains NA")
68+
expect_error(.typeCheckVariable("x", numeric(0), "NUMERIC[]", TRUE), "non-empty vector")
69+
})
70+
71+
test_that(".typeCheckVariable BOOLEAN checks", {
72+
expect_silent(.typeCheckVariable("x", TRUE, "BOOLEAN", FALSE))
73+
expect_silent(.typeCheckVariable("x", FALSE, "BOOLEAN", FALSE))
74+
expect_silent(.typeCheckVariable("x", 1, "BOOLEAN", FALSE))
75+
expect_silent(.typeCheckVariable("x", 0, "BOOLEAN", FALSE))
76+
expect_error(.typeCheckVariable("x", NA, "BOOLEAN", FALSE), "contains NA")
77+
expect_error(.typeCheckVariable("x", NULL, "BOOLEAN", FALSE), "not supplied")
78+
expect_error(.typeCheckVariable("x", c(TRUE, FALSE), "BOOLEAN", FALSE), "scalar of type BOOLEAN")
79+
expect_silent(.typeCheckVariable("x", c(TRUE, FALSE), "BOOLEAN[]", TRUE))
80+
expect_silent(.typeCheckVariable("x", c(TRUE, 1, 0), "BOOLEAN[]", TRUE))
81+
expect_error(.typeCheckVariable("x", c(TRUE, NA), "BOOLEAN[]", TRUE), "contains NA")
82+
expect_error(.typeCheckVariable("x", logical(0), "BOOLEAN[]", TRUE), "non-empty vector")
83+
})
84+
85+
test_that(".typeCheckVariable unknown type", {
86+
expect_error(.typeCheckVariable("x", 1, "UNKNOWN", FALSE), "Unknown type check")
87+
})

0 commit comments

Comments
 (0)