tests/test-locked-bindings.R

In medicalcoder: A Unified and Longitudinally Aware Framework for ICD-Based Comorbidity Assessment

source('utilities.R')
if (!requireNamespace("data.table", quietly = TRUE)) {
  message("SKIP: data.table not available; skipping test-locked-bindings.R")
  quit(save = "no", status = 0, runLast = FALSE)
}

library(data.table)

# it is possible for a end user to modify the internal objects, this is a R
# problem. For example, if you use data.table::setDT on datasets::mtcars you can
# modify the object. The following example worked as of 29 Aug 2025 in R 4.5.1
# and datasets_4.5.1.
#
#> setDT(datasets::mtcars)
#> set(datasets::mtcars, j = "cyl", value = 1L)
#> stopifnot(all(mtcars[["cyl"]] == 1L))
#> stopifnot(all(datasets::mtcars[["cyl"]] == 1L))

# medicalcoder tries to prevent this for its lookup tables.  Importally, :w
#
# several user friendly data sets in .onLoad.  If a end user tries to
# modify the non-exported internal objects, only accessable via ::: then the
# namespace is loaded _before_ anything else can be done and the data sets used
# within the package should be preserved.
setDT(medicalcoder:::..mdcr_internal_icd_codes..)
x <- medicalcoder:::..mdcr_internal_icd_codes..

# bad user, don't modify things, even if you can!
x[, icdv := 8L]
stopifnot(medicalcoder:::..mdcr_internal_icd_codes..[, all(icdv == 8L)])

# but the good news is that when the namespace was loaded the data set that
# needed to be provided to the user and is called within the package via
# get_icd_codes is not modified!
x <- medicalcoder::get_icd_codes()
stopifnot(x[["icdv"]] %in% c(9L, 10L))

# now, what about getting at the built objects?
# first, the ..mdcr_data_env.. is not accessable other than by :::
library(medicalcoder)
stopifnot(medicalcoder:::..mdcr_internal_icd_codes..[, all(icdv == 8L)])  # still bad, but...

# the environment is hard to get to
x <- tryCatchError(..mdcr_data_env..)
stopifnot(inherits(x, "error"))
x <- tryCatchError(medicalcoder::..mdcr_data_env..)
stopifnot(inherits(x, "error"))

x <- medicalcoder:::..mdcr_data_env..
stopifnot(is.environment(x))
# and modifing the data will error
t <- tryCatchError(x$icd_codes[["icdv"]] <- 11L)
stopifnot(inherits(t, "error"))

# data.table will also fail, at first.  Note that accessing the icd_codes right
# now it is just a data.frame
stopifnot(
   is.data.frame(medicalcoder:::..mdcr_data_env..$icd_codes),
  !is.data.table(medicalcoder:::..mdcr_data_env..$icd_codes)
)

# an error is thrown, but the class has been modified and it is now a data.table
t <- tryCatchError(setDT(x$icd_codes))
stopifnot(inherits(t, "error"))
stopifnot(
   is.data.frame(medicalcoder:::..mdcr_data_env..$icd_codes),
   is.data.table(medicalcoder:::..mdcr_data_env..$icd_codes)
)

# so now, end user could modify the object and the return from get_icd_codes()
# will reflect this change
stopifnot(all(get_icd_codes()[["icdv"]] %in% c(9L, 10L)))
medicalcoder:::..mdcr_data_env..$icd_codes[, icdv := 98L]
stopifnot(all(get_icd_codes()[["icdv"]] == 98L))

# so, yeah, end users could mess things up but if someone does this that is on
# them.  Importantly, the get_x functions use
#
# unserialize(serialize(x, connection = NULL))
#
# to ensure end users only get deep copies of the chached data sets.  One quick
# check.
detach("package:medicalcoder", unload = TRUE)
library(medicalcoder)
x <- get_icd_codes()
setDT(x)
y <- data.table::copy(x)
x[, icdv := 42L]
z <- get_icd_codes()

stopifnot(
  all(y[["icdv"]] %in% c(9L, 10L)),
  all(z[["icdv"]] %in% c(9L, 10L)),
  all(x[["icdv"]] == 42L)
)

################################################################################
#                                 End of File                                  #
################################################################################