testthat snippets + rsam addin

testthat_snippet.R

# dummy functions ----

f <- function() {
  testthat::expect_is(data.frame(),'data.frame')
}

f1 <- function() {
  testthat::expect_is(data.frame(),'list')
}

f2 <- function() {
  testthat::describe('a script',{
    it('bad',{
      testthat::expect_is(data.frame(),'list')  
    })
  })
}

f3 <- function() {
  testthat::describe('a script',{
    it('good',{
      testthat::expect_is(data.frame(),'data.frame')
    })
    
    it('bad',{
      testthat::expect_is(data.frame(),'list')    
    })
  })
}

# test singltons ----

lapply(list(f,f1,f2,f3),function(x) testthat::capture_error(x()))

# use rsam to run as addin ----

## https://github.com/yonicd/rsam#limited-liability-addins

## define the hotkey for lla1
## restart IDE
## define the function rsam_fn_1
## highlight script to test in the editor console and use hotkey to invoke

### set hotkey as command + shift + 1
keys <- rsam::KEYS$`left command/window key` + rsam::KEYS$shift + rsam::KEYS$`1`

### update IDE (restart IDE to invoke)
rsam::set_shortcut(fn = 'rsam::lla1',shortcut = keys)

### use lla1 container
rsam_fn_1 <- function(){
  
  adc <- rstudioapi::getSourceEditorContext()
  
  newenv <- new.env()
  
  eval(parse(text = adc$selection[[1]]$text),envir = newenv)
  
  lapply(as.list(newenv),function(x) testthat::capture_error(x()))
  
}

         
# pass functions not to test
## define token as 'sniptest' as the functions that contain the expectations

### invoke the addin incl myfun and test will still work.
         
myfun <- function(x,y) x + y

sniptest_1 <- function() {
 
  testthat::expect_equal(myfun(2,2),3)
  
}

sniptest_2 <- function() {
  testthat::expect_is(data.frame(),'list')
}

rsam_fn_1 <- function(){
  
  adc <- rstudioapi::getSourceEditorContext()
  
  newenv <- new.env()
  
  eval(parse(text = adc$selection[[1]]$text),envir = newenv)
  
  l <- as.list(newenv)
  
  lt <- l[grepl('^sniptest',names(l))]
  
  list2env(l[!grepl('^sniptest',names(l))],envir = environment())
  
  lapply(lt,function(x) testthat::capture_error(x()))
  
}