diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R index f8ce4cf7f..c14c61b0a 100644 --- a/tests/testthat/setup.R +++ b/tests/testthat/setup.R @@ -786,11 +786,30 @@ if (run_cvvs) { # diagnostics. Additionally to suppressWarnings(), suppressMessages() could be # used here (because of the refits in K-fold CV): cvvss <- suppressWarnings(lapply(args_cvvs, function(args_cvvs_i) { - do.call(cv_varsel, c( + cvvs_expr <- expression(do.call(cv_varsel, c( list(object = refmods[[args_cvvs_i$tstsetup_ref]]), excl_nonargs(args_cvvs_i) - )) + ))) + if (args_cvvs_i$mod_nm == "gamm" && + !identical(args_cvvs_i$cv_method, "kfold")) { + # Due to issue #239, we have to wrap the call to cv_varsel() in try(): + return(try(eval(cvvs_expr), silent = TRUE)) + } else { + return(eval(cvvs_expr)) + } })) + success_cvvs <- !sapply(cvvss, inherits, "try-error") + err_ok <- sapply(cvvss[!success_cvvs], function(cvvs_err) { + attr(cvvs_err, "condition")$message == + "Not enough (non-NA) data to do anything meaningful" + }) + expect_true( + all(err_ok), + info = paste("Unexpected error for", + paste(names(cvvss[!success_cvvs])[!err_ok], collapse = ", ")) + ) + cvvss <- cvvss[success_cvvs] + args_cvvs <- args_cvvs[success_cvvs] } ## Projection -------------------------------------------------------------