Skip to content

Commit

Permalink
Add guard to export when called outside of module
Browse files Browse the repository at this point in the history
  • Loading branch information
wahani committed Oct 1, 2023
1 parent 57d1e4e commit 28b8164
Show file tree
Hide file tree
Showing 4 changed files with 31 additions and 8 deletions.
2 changes: 1 addition & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
Package: modules
Title: Self Contained Units of Source Code
Version: 0.12.0
Version: 0.12.1
Authors@R: person("Sebastian", "Warnholz", email = "[email protected]", role = c("aut", "cre"))
Description: Provides modules as an organizational unit for source code. Modules
enforce to be more rigorous when defining dependencies and have
Expand Down
4 changes: 4 additions & 0 deletions NEWS
Original file line number Diff line number Diff line change
@@ -1,3 +1,7 @@
Version 0.13.0
- 'export' no raises a warning when called from outside of a module instead of
raising an error. #47

Version 0.12.0
- Bugfix when exporting object with special characters of length 1, e.g. `!` #45

Expand Down
24 changes: 18 additions & 6 deletions R/export.R
Original file line number Diff line number Diff line change
Expand Up @@ -16,6 +16,9 @@
#' declared. A regular expression is denoted, as a convention, as character
#' vector of length one with a leading "^".
#'
#' When \code{export} is called outside of a module, it has no effect and
#' returns early. A warning is raised in this case.
#'
#' @examples
#' module({
#' export("foo")
Expand Down Expand Up @@ -48,6 +51,7 @@
#' })
#' @export
export <- function(..., where = parent.frame()) {
if (exportCalledOutsideOfModule(where)) return(invisible(NULL))
exportWarnOnNonStandardCalls(match.call())
objectsToExport <- deparseEllipsis(match.call(), "where")
currentExports <- exportGetCurrentValue(where)
Expand All @@ -60,6 +64,14 @@ export <- function(..., where = parent.frame()) {
invisible(NULL)
}

exportCalledOutsideOfModule <- function(where) {
calledOutsideOfModule <- !exists(exportNameWithinModule(), where, inherits = FALSE)
if (calledOutsideOfModule) {
warning("Calling 'export' outside of a module has no effect.")
}
calledOutsideOfModule
}

exportWarnOnNonStandardCalls <- function(call) {
# exporting with do.call is not working properly, so we throw a warning, in
# case we can detect it. Consider the following examples:
Expand All @@ -71,7 +83,7 @@ exportWarnOnNonStandardCalls <- function(call) {
# do.call(export, list(fun = sm$fun))
# })
# It will not work, although `export(fun = sm$fun)` does work as expected.
# This is extremely difficult to dubug and it seems to be better to turn it
# This is extremely difficult to debug and it seems to be better to turn it
# off until someone can fix it.
if (length(deparse(call[[1]])) > 1) {
warning(
Expand Down Expand Up @@ -110,13 +122,13 @@ exportResolveFinalValue <- function(envir) {
exportExtractElement <- function(where) {
function(element, name) {
name <- if (name == "") element else name
# we need to make sure that special names,
# - infix operators: %*%,
# - S3 methods for binary operators: ==.foo
# - names with whitespaces
# we need to make sure that special names,
# - infix operators: %*%,
# - S3 methods for binary operators: ==.foo
# - names with whitespace
# - single character punctuation: !
# are parsed correctly
regexp <- "^%.*%$|^[[:alnum:][:space:]]+$|^[[:punct:]]{2,}.*$|^[[:punct:]]$"
regexp <- "^%.*%$|^[[:alnum:][:space:]]+$|^[[:punct:]]{2,}.*$|^[[:punct:]]$"
element <- if (grepl(regexp, element)) paste0("`", element, "`") else element # Exclude Linting
object <- tryCatch(
eval(parse(text = element), where, baseenv()),
Expand Down
9 changes: 8 additions & 1 deletion tests/testthat/test-export.R
Original file line number Diff line number Diff line change
@@ -1,7 +1,14 @@
testthat::test_that("export can be called savely outside of module #47", {
testthat::expect_warning(
modules::export("something"),
"Calling 'export' outside of a module has no effect."
)
})

test_that("Exports of special names #43", {
m <- module({
"==.foo" <- function(lhs, rhs) base::`==`(lhs, rhs) # Exclude Linting
"!.foo" <- function(lhs, rhs) base::`!=`(lhs, rhs) # Exclude Linting
"!.foo" <- function(lhs, rhs) base::`!=`(lhs, rhs) # Exclude Linting
})
testthat::expect_true(m$`==.foo`(1, 1))
testthat::expect_true(m$`!.foo`(1, 2))
Expand Down

0 comments on commit 28b8164

Please sign in to comment.