test by mocking

Author: teunbrand

R/guides-.R

@@ -920,7 +920,7 @@ validate_guide <- function(guide) {
     if (isTRUE(grepl("::", guide))) {
       # Append prefix as namespaces to search environments
       prefix <- sub("::.*", "", guide)
-      search_env <- c(search_env, list(asNamespace(prefix)))
+      search_env <- c(search_env, list(as_namespace(prefix)))
       # Remove prefix from guide name
       guide <- sub(".*::", "", guide)
     }

R/scale-type.R

@@ -13,7 +13,7 @@ find_scale <- function(aes, x, env = parent.frame()) {
     if (isTRUE(grepl("::", scale))) {
       # Append prefix as namepaces to search environments
       prefix <- sub("::.*", "", scale)
-      search_env <- c(search_env, list(asNamespace(prefix)))
+      search_env <- c(search_env, list(as_namespace(prefix)))
       # Remove prefix from scale name
       scale <- sub(".*::", "", scale)
     }
@@ -41,7 +41,7 @@ find_global <- function(name, env, mode = "any") {
   if (!is.list(env)) {
     env <- list(env)
   }
-  env <- c(env, list(asNamespace("ggplot2")))
+  env <- c(env, list(as_namespace("ggplot2")))
 
   for (e in env) {
     if (exists(name, envir = e, mode = mode)) {
@@ -52,6 +52,13 @@ find_global <- function(name, env, mode = "any") {
   NULL
 }
 
+# This exists for testing purposes (mocking) only
+as_namespace <- function(...) NULL
+on_load({
+  as_namespace <- base::asNamespace
+})
+
+
 #' Determine default scale type
 #'
 #' You will need to define a method for this method if you want to extend

tests/testthat/_snaps/guides.md

@@ -37,6 +37,10 @@
 
     `nrow` * `ncol` needs to be larger than the number of breaks (5).
 
+# validate_guide finds guides with namespace prefixes
+
+    Unknown guide: bar
+
 # get_guide_data retrieves keys appropriately
 
     Code

tests/testthat/test-guides.R

@@ -51,6 +51,34 @@ test_that("guide specifications are properly checked", {
   expect_snapshot_error(ggplotGrob(p))
 })
 
+
+test_that("validate_guide finds guides with namespace prefixes", {
+
+  # Mock foo::bar as namespace
+  fake_namespace <- new_environment()
+  env_bind(
+    fake_namespace,
+    guide_bar = function(...) guide_legend(title = "bar", ...)
+  )
+
+  local_mocked_bindings(
+    as_namespace = function(ns, ...) {
+      if (identical(ns, "foo")) {
+        return(fake_namespace)
+      } else {
+        base::asNamespace(ns, ...)
+      }
+    }
+  )
+
+  # Without prefix, we don't know here to look for guide_bar
+  expect_snapshot_error(validate_guide("bar"))
+  # With prefix, we know the namespace where to look for guide_bar
+  g <- validate_guide("foo::bar")
+  expect_true(is_guide(g))
+  expect_equal(g$params$title, "bar")
+})
+
 test_that("guide_coloursteps and guide_bins return ordered breaks", {
   scale <- scale_colour_viridis_c(breaks = c(2, 3, 1))
   scale$train(c(0, 4))

tests/testthat/test-scale-type.R

@@ -24,3 +24,41 @@ test_that("find_scale gives sensible calls to scales", {
     quote(scale_colour_discrete())
   )
 })
+
+test_that("find_scale finds scales with namespace prefixes", {
+
+  # Mock foo::bar as namespace
+  fake_namespace <- new_environment()
+  env_bind(
+    fake_namespace,
+    scale_x_bar = function(...) scale_x_continuous(name = "barname")
+  )
+
+  local_mocked_bindings(
+    as_namespace = function(ns, ...) {
+      if (identical(ns, "foo")) {
+        return(fake_namespace)
+      } else {
+        base::asNamespace(ns, ...)
+      }
+    }
+  )
+
+  # No loaded namespace has a scale_x_bar
+  registerS3method(
+    "scale_type", "bar",
+    method = function(x) "bar"
+  )
+
+  sc <- find_scale("x", structure(1, class = "bar"))
+  expect_null(sc)
+
+  # With prefix, we know the namespace where to look for scale_x_bar
+  registerS3method(
+    "scale_type", "bar",
+    method = function(x) "foo::bar"
+  )
+
+  sc <- find_scale("x", structure(1, class = "bar"))
+  expect_equal(sc$name, "barname")
+})