tests/aaa.R

In panelPomp: Inference for Panel Partially Observed Markov Processes

## test aaa.R
if (file.exists("_options.R")) source("_options.R")
library(panelPomp,quietly=TRUE)
TESTS_PASS <- NULL
## alternatively: assign(eval(formals(test))$all,NULL) (after defining test)
## does panelPomp:::test (used to test all other codes) work?
test <- function(expr1,expr2,all="TESTS_PASS",env=parent.frame(),...)
  panelPomp:::test(expr1,expr2,all=all,env=env,...)

test(NULL,NULL)
## ... test unevaluated multiple-line expression, ...
test(
  quote(
    {a_multi_line_expression <- NA
    "where_objects_are_defined" -> is_not_evald
    NULL}),NULL)
test(exists("is_not_evald"),FALSE)
## if only one argument ...
test(length(get(eval(formals(test))$all))==3)
## ... the result isn't necessarily logical: hence, 'all' is not changed!
test(length(get(eval(formals(test))$all)),3L)
## test order of expr1 and expr2
test(4L,length(get(eval(formals(test))$all)))
## test stop for wrong parameters
# "Error in eval(expr1) : object 'invalid_expr' not found\n"
test(class(try(stop(test(invalid_expr)),silent=TRUE)),"try-error")
test(wQuotes("Error : in ''test'': missing vector to accumulate logical test ",
             "results.\n"),
     panelPomp:::test(NULL,expr2=NULL,all="wrong_all",env=parent.frame()))
test("Error in exists(all, envir = env) : invalid 'envir' argument\n",
     panelPomp:::test(NULL,NULL,all=eval(formals(test))$all,env="no_env"))
## test identical for range of objects
test(NA,NA)
test(1,1)
test(1L,1L)
test("a","a")
test(matrix(1,nrow=2),matrix(1,nrow=2))
test(list(a="a",b="b"),list(a="a",b="b"))
test(c(TRUE,FALSE),c(TRUE,FALSE))
## consider further testing panelPomp:::test ...
## capturing warnings, ...
## warn <- options(warn=2) # to convert warnings to errors
## test()
## options(warn)
## partially matching error messages, ...
## test(grepl(wQuotes("Error "),test(),fixed=TRUE),TRUE)

## if all tests for panelPomp:::test passed ...
all(get(eval(formals(test))$all))
if (!all(get(eval(formals(test))$all))) stop("Not all tests passed!")
## ... continue testing the rest of the code


## runif.EstimationScale
test(class(panelPomp:::runif.EstimationScale(centers=c(th=1),widths=2))[1],
     "numeric")

## wQuotes
## check for ' in different positions in the character
test(wQuotes("''Error''")==paste0(sQuote("Error")))
test(wQuotes("Error")=="Error")
test(wQuotes("''Error'' : in")==paste0(sQuote("Error")," : in"))
test(wQuotes("Error : in ''fn''")==paste0("Error : in ",sQuote("fn")))
test(wQuotes("''Error'' : in ''fn'': ''object'' is a required argument"),
     paste0(sQuote("Error")," : in ",sQuote("fn"),": ",sQuote("object"),
            " is a required argument"))
test(wQuotes("Error : in ''fn'': ''object'' is a required argument"),
     paste0("Error : in ",sQuote("fn"),": ",sQuote("object"),
            " is a required argument"))
test(wQuotes("in ''fn''",": ''object'' is"," a required argument"," Error : in",
             " ''fn'': ''object'' is a required argument"),
     paste0("in ",sQuote("fn"),": ",sQuote("object")," is a required argument",
            " Error : in ",sQuote("fn"),": ",sQuote("object"),
            " is a required argument"))
## test passing wQuotes as first argument to stop
test(as.character(
  attr(try(stop(wQuotes("in ''fn'': ''object'' is a required argument")),
           silent=TRUE),"condition")),
  paste0(
    "Error in doTryCatch(return(expr), name, parentenv, handler): in ",
    sQuote("fn"),": ",sQuote("object")," is a required argument\n"))

## test quoting variables
test(wQuotes("''",TESTS_PASS[1],"''")==sQuote("TRUE"))

## final check: do all tests pass?
all(get(eval(formals(test))$all))
if (!all(get(eval(formals(test))$all))) stop("Not all tests passed!")