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

【问题标题】：How to test a function that depends on a menu() user input如何测试依赖于 menu() 用户输入的函数
【发布时间】：2021-04-20 17:39:57
【问题描述】：

有没有办法自动测试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")
})

【问题讨论】：

标签： r automated-tests testthat

【解决方案1】：

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

library(testthat)

# fancy function
askPermission <- function(old, new , response = NA) {
  cat(paste0(old,
             "\n--->\n", new, "\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

【讨论】：

嗯，这实际上是我目前的解决方法，但我对这个解决方案不满意，因为我必须包含一个仅用于测试目的的参数：/
那么第二个提议的解决方案呢？
对不起，我错过了第二部分。谢谢你指点我这个包。我去看看
mockr 有帮助吗？
感谢您的反馈和分享您的解决方案

【解决方案2】：

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

library(testthat)
# fancy function
askPermission <- function(old, new) {
  cat(paste0(old,
             "\n--->\n", new, "\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", "NO"), title = prompt) == 1
  
  return(new)
}

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

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

【讨论】：