R Under development (unstable) (2024-12-07 r87428 ucrt) -- "Unsuffered Consequences" Copyright (C) 2024 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > ## 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) [1] TRUE > ## ... test unevaluated multiple-line expression, ... > test( + quote( + {a_multi_line_expression <- NA + "where_objects_are_defined" -> is_not_evald + NULL}),NULL) [1] TRUE > test(exists("is_not_evald"),FALSE) [1] TRUE > ## if only one argument ... > test(length(get(eval(formals(test))$all))==3) [1] TRUE > ## ... the result isn't necessarily logical: hence, 'all' is not changed! > test(length(get(eval(formals(test))$all)),3L) [1] TRUE > ## test order of expr1 and expr2 > test(4L,length(get(eval(formals(test))$all))) [1] TRUE > ## 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") [1] TRUE > test(wQuotes("Error : in ''test'': missing vector to accumulate logical test ", + "results.\n"), + panelPomp:::test(NULL,expr2=NULL,all="wrong_all",env=parent.frame())) [1] TRUE > test("Error in exists(all, envir = env) : invalid 'envir' argument\n", + panelPomp:::test(NULL,NULL,all=eval(formals(test))$all,env="no_env")) [1] TRUE > ## test identical for range of objects > test(NA,NA) [1] TRUE > test(1,1) [1] TRUE > test(1L,1L) [1] TRUE > test("a","a") [1] TRUE > test(matrix(1,nrow=2),matrix(1,nrow=2)) [1] TRUE > test(list(a="a",b="b"),list(a="a",b="b")) [1] TRUE > test(c(TRUE,FALSE),c(TRUE,FALSE)) [1] TRUE > ## 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)) [1] TRUE > 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") [1] TRUE > > ## wQuotes > ## check for ' in different positions in the character > test(wQuotes("''Error''")==paste0(sQuote("Error"))) [1] TRUE > test(wQuotes("Error")=="Error") [1] TRUE > test(wQuotes("''Error'' : in")==paste0(sQuote("Error")," : in")) [1] TRUE > test(wQuotes("Error : in ''fn''")==paste0("Error : in ",sQuote("fn"))) [1] TRUE > test(wQuotes("''Error'' : in ''fn'': ''object'' is a required argument"), + paste0(sQuote("Error")," : in ",sQuote("fn"),": ",sQuote("object"), + " is a required argument")) [1] TRUE > test(wQuotes("Error : in ''fn'': ''object'' is a required argument"), + paste0("Error : in ",sQuote("fn"),": ",sQuote("object"), + " is a required argument")) [1] TRUE > 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")) [1] TRUE > ## 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")) [1] TRUE > > ## test quoting variables > test(wQuotes("''",TESTS_PASS[1],"''")==sQuote("TRUE")) [1] TRUE > > ## final check: do all tests pass? > all(get(eval(formals(test))$all)) [1] TRUE > if (!all(get(eval(formals(test))$all))) stop("Not all tests passed!") > > proc.time() user system elapsed 0.68 0.20 0.89