Removed deprecated with_mock() from tests (#153)

* removed with_mock for circlize.R tests

* removed with_mock for color_branches.R tests

* removed with_mock for common_subtrees.R tests

* removed with_mock for cor.dendlist.R tests

* removed with_mock for ggdend.R tests

* removed with_mock for rainbow_fun.R tests

* removed with_mock for rect.dendrogram.R tests

* removed with_mock for rotate.R tests

* removed with_mock for tanglegram.R tests

* removed with_mock for untangle.R tests

* removed with_mock for seriate_dendrogram.R tests

* corrected requireNamespace tests

* removed with_mock for cutree.dendrogram.R tests

* restored lost coverage on common_subtrees.R

* rebinded requireNamespace to NULL

R/circlize.R

@@ -158,3 +158,6 @@ circlize_dendrogram <- function(dend, facing = c("outside", "inside"), labels =
 #  circlize_dendrogram(dend)
 #
 #
+
+
+requireNamespace <- NULL

R/rainbow_fun.R

@@ -29,3 +29,6 @@ rainbow_fun <- function(n, c = 90, l = 50, ...) {
 # n = 10
 # barplot(rep(10, n), col = rainbow_hcl(n) )
 # barplot(rep(10, n), col = rainbow_hcl(n, c=90, l=50) )
+
+
+requireNamespace <- NULL

R/seriate_dendrogram.R

@@ -74,3 +74,6 @@ seriate_dendrogram <- function(dend, x, method = c("OLO", "GW"), ...) {
   dend <- rotate(dend, order = rev(labels(x)[seriation::get_order(o)]))
   dend
 }
+
+
+requireNamespace <- NULL

tests/testthat/test-circlize.R

@@ -20,11 +20,9 @@ test_that("circlize_dendrogram works", {
       circlize_dendrogram(dend)
    )
    # if circlize not installed
-   expect_error(with_mock(
-      requireNamespace = function(...) FALSE,
-      circlize_dendrogram(dend)
+   expect_error(with_mocked_bindings(
+      circlize_dendrogram(dend),
+      requireNamespace = function(...) FALSE
    ))
 
 })
-
-

tests/testthat/test-color_branches.R

@@ -36,9 +36,9 @@ test_that("color_branches works", {
    ) # hc gets converted to dendrogram so should be the same
 
    # temporarily redefine cutree to return 0 so we can activate warning for 'dend has only one level'
-   expect_warning(with_mock(
-      `dendextend::cutree` = function(...) 0,
-      color_branches(dend, k = 2, warn = T) 
+   expect_warning(with_mocked_bindings(
+      color_branches(dend, k = 2, warn = T),
+      cutree = function(...) 0
    ))
    # trigger 'else' clause in addcol
    expect_no_error(color_branches(dend) %>% color_branches())

tests/testthat/test-common_subtrees.R

@@ -94,9 +94,9 @@ test_that("common_subtrees_clusters works", {
    )
 
    # temporarily redefine is.leaf to access and cover lines of code otherwise not possible
-   set.seed(2)
-   with_mock(
-      is.leaf = function(x) sample(c(T,F), 1),
-      common_subtrees_clusters(dend1, dend2)
-   )
+   set.seed(3)
+   with_mocked_bindings(
+      common_subtrees_clusters(dend1, dend2),
+      is.leaf = function(x) sample(c(T,F), 1)
+   )   
 })

tests/testthat/test-cor.dendlist.R

@@ -52,9 +52,9 @@ test_that("cor_FM_index works", {
       cor_FM_index(dend1, dend2)   
    )
    # if all leaves part of the same cluster
-   expect_warning(with_mock(
-      cutree = function(dend, k, ...) rep(0, length(labels(dend))),
-      cor_FM_index(dend1, dend2, k = 2)
+   expect_warning(with_mocked_bindings(
+      cor_FM_index(dend1, dend2, k = 2),
+      cutree = function(dend, k, ...) rep(0, length(labels(dend)))
    ))
 
 })

tests/testthat/test-cutree.dendrogram.R

@@ -89,10 +89,10 @@ test_that("cutree a dendrogram by height h", {
   expect_identical(result, stats::cutree(as.hclust(dend), h = -1))
 
   # if order.dendrogram indices aren't 1:nleaves(dend)
-  expect_warning(with_mock(
+  expect_warning(with_mocked_bindings(
+     cutree_1h.dendrogram(dend, h = 50, order_clusters_as_data = T, warn = T),
      order.dendrogram = function(...) return(2:6),
-     cutree_1h.dendrogram(dend, h = 50, order_clusters_as_data = T, warn = T)
-  ))
+  ))  
 
 })
 
@@ -634,10 +634,10 @@ test_that("cutree.dendrogram works", {
    expect_true(all(result == c(1,1,1,2,2)))
 
    # if order.dendrogram indices aren't 1:nleaves(dend)
-   expect_warning(with_mock(
-      order.dendrogram = function(...) return(2:6),
-      cutree.dendrogram(dend, h = 0.2, try_cutree_hclust = T, warn = T)
-   ))
+   expect_warning(with_mocked_bindings(
+      cutree.dendrogram(dend, h = 0.2, try_cutree_hclust = T, warn = T),
+      order.dendrogram = function(...) return(2:6)
+   ))   
 
 })
 

tests/testthat/test-ggdend.R

@@ -145,9 +145,9 @@ test_that("as.ggdend.dendrogram works", {
   expect_identical(gg2, should_be)
 
   # if dend without leaves is passed in
-  expect_error(with_mock(
-     nleaves = function(x, ...) return(0),
-     as.ggdend(dend),   
+  expect_error(with_mocked_bindings(
+     as.ggdend(dend),
+     nleaves = function(x, ...) return(0)
   ))
 
   # if type triangle used

tests/testthat/test-rainbow_fun.R

@@ -10,9 +10,9 @@ test_that("rainbow_fun works", {
    dend <- as.dendrogram(hclust(dist(mtcars)))
 
    # if colorspace not installed
-   expect_no_error(with_mock(
-      requireNamespace = function(...) FALSE,
-      rainbow_fun(1)
+   expect_no_error(with_mocked_bindings(
+      rainbow_fun(1),
+      requireNamespace = function(...) FALSE
    ))
 
 })

tests/testthat/test-rect.dendrogram.R

@@ -70,18 +70,18 @@ test_that("identify.dendrogram works", {
 
    # replace locator function with one that automatically clicks to make test non-interactive
    locator_counter <<- 0
-   with_mock(
+   with_mocked_bindings(
+      {
+         plot(dend, horiz = TRUE)
+         vec <- identify(dend, horiz = TRUE, FUN = function(x) x + 1, DEV.FUN = 2)
+      },
       locator = function(x) {
          locator_counter <<- locator_counter + 1
          if (locator_counter == 1) return(list(x = 172, y = 5))
          if (locator_counter == 2) return(list(x = 172, y = 1))
          return(NULL)
-      },
-      {
-         plot(dend, horiz = TRUE)
-         vec <- identify(dend, horiz = TRUE, FUN = function(x) x + 1, DEV.FUN = 2)
-      }
-   )
+      }      
+   )   
    expect_identical(
       vec[[2]], c("Connecticut" = 8)
    )

tests/testthat/test-rotate.R

@@ -190,10 +190,10 @@ test_that("click_rotate works", {
    dend <- as.dendrogram(hc)
 
    # temporarily redefine interactive locator function to click leaf which causes no rotation in click_rotate and returns the same dendrogram
-   capture.output(with_mock(
-      locator = function(n = 1) list(x = 1, y = -11),
-      result <- click_rotate(dend, plot = TRUE, horiz = FALSE, continue = TRUE)
-   ))
+   capture.output(with_mocked_bindings(
+      result <- click_rotate(dend, plot = TRUE, horiz = FALSE, continue = TRUE),
+      locator = function(n = 1) list(x = 1, y = -11)
+   ))   
    expect_identical(labels(dend), labels(result))
 
 })

tests/testthat/test-seriate_dendrogram.R

@@ -34,9 +34,9 @@ test_that("seriate_dendrogram works", {
       seriate_dendrogram(fake_dend)
    )
    # if seriation not installed
-   expect_error(with_mock(
-      requireNamespace = function(...) FALSE,
-      seriate_dendrogram(dend)
+   expect_error(with_mocked_bindings(
+      seriate_dendrogram(dend),
+      requireNamespace = function(...) FALSE
    ))
 
 })

tests/testthat/test-tanglegram.R

@@ -128,9 +128,9 @@ test_that("tanglegram works", {
    )
 
    # temporarily overwrite par() function to access error that is otherwise inaccessible
-   expect_error(with_mock(
-      par = function(mar = 0) c(1,1),
-      tanglegram.dendlist(dend12, just_one = F)
+   expect_error(with_mocked_bindings(
+      tanglegram.dendlist(dend12, just_one = F),
+      par = function(mar = 0) c(1,1)
    ))
    # if only 1 dendrogram is passed in
    expect_error(

tests/testthat/test-untangle.R

@@ -102,10 +102,10 @@ test_that("untangle_step_rotate_1side work", {
 
   # if leaf mismatch in dend1 and dend after ordering
   dendextend_options("warn", T)
-  expect_warning(expect_error(with_mock(
-     match_order_by_labels = function(dend1, dend2, ...) return(dend2),
-     untangle_step_rotate_1side(dend2, dend1, "step1side", leaves_matching_method = "order")
-  )))
+  expect_warning(expect_error(with_mocked_bindings(
+     untangle_step_rotate_1side(dend2, dend1, "step1side", leaves_matching_method = "order"),
+     match_order_by_labels = function(dend1, dend2, ...) return(dend2)
+  )))  
   dendextend_options("warn", F)
 
 })
@@ -139,9 +139,9 @@ test_that("untangle_step_rotate_2side work", {
    expect_identical(round(entanglement(dend12_corrected[[1]],dend12_corrected[[2]], L = 2),3) ,  0.059)
 
    # if times reaches 2+ iterations
-   expect_output(with_mock(
-      untangle_step_rotate_1side = function(dend1, dend2, ...) return(list(shuffle(dend2), dend1)),
-      result <- untangle_step_rotate_2side(dend1, dend2, k = 4, print_times = T)
+   expect_output(with_mocked_bindings(
+      result <- untangle_step_rotate_2side(dend1, dend2, k = 4, print_times = T),
+      untangle_step_rotate_1side = function(dend1, dend2, ...) return(list(shuffle(dend2), dend1))
    ))
 
 })