如何测试依赖于 menu() 用户输入的函数

问题描述

有没有办法自动测试 menu() 函数？

我在需要一些用户交互的包中创建了一个函数。它基本上会询问用户结果是否符合预期。我想要一个 testthat-body 来接受输入并创建和检查输出。然而，用户交互阻碍了这个框架。有没有办法以编程方式插入用户答案？我尝试了 interactive() 函数但没有成功。

library(testthat)

# fancy function
askPermission <- function(old,new) {
  cat(paste0(old,"\n--->\n",new,"\n\n"))
  prompt <- "Use this? "
  response <- menu(c("YES","NO"),title = prompt) == 1
  return(new)
}

# tests
test_that("test Permission",{
  expect_equal(askPermission("A","B"),"B")
})

解决方法

您可以添加一个额外的 response 参数，默认值为 NA，您可以将其设置为仅在测试期间强制响应：

library(testthat)

# fancy function
askPermission <- function(old,new,response = NA) {
  cat(paste0(old,"\n--->\n","\n\n"))
  prompt <- "Use this? "
 if (is.na(response)) { 
    response <- menu(c("YES","NO"),title = prompt) == 2
  } 
  return(new)
}

# tests
library(testthat)
test_that("test Permission",{
  expect_equal(askPermission("A","B",2),"B")
})
#> A
#> --->
#> B
#> 
#> Test passed

另一种选择是使用 mockr 包来模拟 menu 函数：

library(testthat)
library(mockr)

local({
  # Here,we override the menu function to force expected choice
  local_mock(menu = function(choices,title=NULL) 2)
  
  test_that("test Permission",{
    expect_equal(askPermission("A","B"),"B")
  })
})
#> A
#> --->
#> B
#> 
#> Test passed

请注意，您作为示例提供的 AskPermission 函数始终返回 new 并且不依赖于 response

,

通过检查调用范围，我找到了一种不使用任何其他依赖项的方法。 test_that() 有自己的函数环境，名为 test_env。如果在任何更高级别包含此类环境的嵌套作用域中调用函数 askPermission()，则跳过 menu() 函数。此外，menu() 仅在交互式上下文中才有意义。

library(testthat)
# fancy function
askPermission <- function(old,new) {
  cat(paste0(old,"\n\n"))
  prompt <- "Use this? "
  
  # calling scope
  tb <- .traceback(x = 0)

  # check if called in testthat or interactive
  if(!any(unlist(lapply(tb,function(x) any(grepl("test_env",x))))) && interactive())
    response <- menu(c("YES",title = prompt) == 1
  
  return(new)
}

# tests
test_that("test Permission","B")
})
#> A
#> --->
#> B
#> 
#> Test passed

# regular usage --------
askPermission("A","B")
#> A
#> --->
#> B
#> Use this?  
#>   
#>   1: YES
#>   2: NO
#> 
#> Choice: