tests/testthat/test-utils.R

In CDMConnector: Connect to an OMOP Common Data Model

# testthat::test_that("cdmCommentContents returns NULL invisibly when non-interactive", {
#   skip_on_cran()
#   skip_on_ci()
#   testthat::local_mocked_bindings(
#     .cdm_comment_interactive = function() FALSE,
#     .package = "CDMConnector"
#   )
#   out <- cdmCommentContents(cdm = list())
#   testthat::expect_null(out)
# })
#
# testthat::test_that("cdmCommentContents validates personIds type", {
#   skip_on_cran()
#   skip_on_ci()
#   testthat::local_mocked_bindings(
#     .cdm_comment_interactive = function() TRUE,
#     .cdm_comment_require_rstudioapi = function() TRUE,
#     .cdm_comment_rstudio_available = function() TRUE,
#     .package = "CDMConnector"
#   )
#   testthat::expect_error(
#     cdmCommentContents(cdm = list(), personIds = "not numeric"),
#     "`personIds` must be a numeric vector"
#   )
# })
#
# testthat::test_that("cdmCommentContents formats comment lines and inserts below call line", {
#   skip_on_cran()
#   skip_on_ci()
#   captured <- new.env(parent = emptyenv())
#   captured$called <- FALSE
#   captured$location <- NULL
#   captured$text <- NULL
#
#   flat_df <- data.frame(
#     person_id   = c(2, 1, 1),
#     start_date  = as.Date(c("2020-01-01", "2021-02-01", "2020-02-01")),
#     end_date    = as.Date(c("2020-01-10", "2021-02-10", NA)),
#     concept_id  = c(100, 200, 201),
#     stringsAsFactors = FALSE
#   )
#
#   ctx <- list(
#     contents = list(
#       "x <- 1",
#       "cdmCommentContents(cdm, personIds = 1)",
#       "y <- 2",
#       "z <- 3"
#     ),
#     selection = list(list(range = list(start = list(row = 4, column = 1))))
#   )
#
#   testthat::local_mocked_bindings(
#     .cdm_comment_interactive = function() TRUE,
#     .cdm_comment_require_rstudioapi = function() TRUE,
#     .cdm_comment_rstudio_available = function() TRUE,
#     .cdm_comment_flatten = function(cdm) flat_df,
#     .cdm_comment_collect = function(x) x,
#     .cdm_comment_get_context = function() ctx,
#     .cdm_comment_doc_position = function(row, column) list(row = row, column = column),
#     .cdm_comment_insert_text = function(location, text) {
#       captured$called <- TRUE
#       captured$location <- location
#       captured$text <- text
#       invisible(NULL)
#     },
#     .package = "CDMConnector"
#   )
#
#   out <- cdmCommentContents(cdm = list(), personIds = 1)
#
#   testthat::expect_true(captured$called)
#   testthat::expect_identical(captured$location$row, 3)
#   testthat::expect_identical(captured$location$column, 1)
#   testthat::expect_match(captured$text, "^# ")
#   testthat::expect_match(captured$text, "person_id\\s+\\|\\s+start_date\\s+\\|\\s+end_date")
#   testthat::expect_match(captured$text, "\n$")
#   testthat::expect_match(captured$text, "# 1\\s+\\|")
#   testthat::expect_false(grepl("# 2\\s+\\|", captured$text, fixed = FALSE))
#   testthat::expect_s3_class(out, "data.frame")
#   testthat::expect_true(all(out$person_id == 1))
# })
#
# testthat::test_that("cdmCommentContents errors if no call line is found above the cursor", {
#   skip_on_cran()
#   skip_on_ci()
#   flat_df <- data.frame(
#     person_id   = 1,
#     start_date  = as.Date("2021-01-01"),
#     end_date    = as.Date("2021-01-02"),
#     stringsAsFactors = FALSE
#   )
#   ctx <- list(
#     contents = list("a <- 1", "b <- 2", "c <- 3"),
#     selection = list(list(range = list(start = list(row = 3, column = 1))))
#   )
#
#   testthat::local_mocked_bindings(
#     .cdm_comment_interactive = function() TRUE,
#     .cdm_comment_require_rstudioapi = function() TRUE,
#     .cdm_comment_rstudio_available = function() TRUE,
#     .cdm_comment_flatten = function(cdm) flat_df,
#     .cdm_comment_collect = function(x) x,
#     .cdm_comment_get_context = function() ctx,
#     .package = "CDMConnector"
#   )
#
#   testthat::expect_error(
#     cdmCommentContents(cdm = st()),
#     "Couldn't find a line containing `cdmCommentContents\\(` above the cursor"
#   )
# })