diff --git a/R/Aaaa.R b/R/Aaaa.R index 9bfee4d2..6aa58214 100644 --- a/R/Aaaa.R +++ b/R/Aaaa.R @@ -82,6 +82,10 @@ block_list <- c("ENV", "PROB", "PARAM", "INIT", "PREAMBLE", "PRED", "BLOCK", "TRANSIT", "YAML", "NMEXT", "INPUT", "EVENT") +block_list_single <- c("MAIN", "SET", "GLOBAL", "PREAMBLE", "PRED", "PKMODEL", + "ENV", "CMTN", "INCLUDE", "NAMESPACE", "BLOCK", + "TRANSIT", "YAML", "EVENT") + Reserved_cvar <- c("SOLVERTIME","table","ETA","EPS", "AMT", "CMT", "ID", "TIME", "EVID","simeps", "self", "simeta", "NEWIND", "DONE", "CFONSTOP", "DXDTZERO", diff --git a/R/modspec.R b/R/modspec.R index 2f8ce692..9bfc9f97 100644 --- a/R/modspec.R +++ b/R/modspec.R @@ -156,16 +156,17 @@ check_sim_eta_eps_n <- function(x, spec) { return(invisible(NULL)) } -check_spec_contents <- function(x, crump = TRUE, warn = TRUE, ...) { - invalid <- setdiff(x,block_list) - valid <- intersect(x,block_list) - - if(sum("MAIN" == x) > 1){ - stop("Only one $MAIN block allowed in the model.",call.=FALSE) - } - - if(sum("SET" == x) > 1) { - stop("Only one $SET block allowed in the model.", call.=FALSE) +check_spec_contents <- function(x, crump = TRUE, warn = TRUE, ...) { + # Check for valid and invalid blocks + invalid <- base::setdiff(x, block_list) + valid <- base::intersect(x, block_list) + + # Check for block duplicates where we only allow single + dup_x <- x[duplicated(x)] + dups <- base::intersect(dup_x, block_list_single) + if(length(dups)) { + names(dups) <- rep("*", length(dups)) + abort("Multiple blocks found where only one is allowed:", body = dups) } if(warn) { diff --git a/R/mread.R b/R/mread.R index e340fdbe..080cbccf 100644 --- a/R/mread.R +++ b/R/mread.R @@ -283,7 +283,12 @@ mread <- function(model, project = getOption("mrgsolve.project", getwd()), # Collect potential multiples subr <- collect_subr(spec) table <- unlist(spec[names(spec)=="TABLE"], use.names = FALSE) - spec[["ODE"]] <- unlist(spec[names(spec)=="ODE"], use.names = FALSE) + if("ODE" %in% names(spec)) { + spec[["ODE"]] <- unlist(spec[names(spec)=="ODE"], use.names = FALSE) + } + if("PLUGIN" %in% names(spec)) { + spec[["PLUGIN"]] <- unlist(spec[names(spec)=="PLUGIN"], use.names = FALSE) + } # TODO: deprecate audit argument mread.env[["audit_dadt"]] <- @@ -432,7 +437,7 @@ mread <- function(model, project = getOption("mrgsolve.project", getwd()), x <- update_capture(x, .ren.chr(capture_vars)) build$preclean <- TRUE } - + # Check mod ---- check_pkmodel(x, subr, spec) check_globals(mread.env[["move_global"]], Cmt(x)) @@ -561,7 +566,7 @@ mread <- function(model, project = getOption("mrgsolve.project", getwd()), from = temp_write, to = build[["compfile"]] ) - + if(!compile) return(x) if(ignore.stdout & !quiet) { diff --git a/tests/testthat/test-modspec.R b/tests/testthat/test-modspec.R index 1a825d65..3d11057a 100644 --- a/tests/testthat/test-modspec.R +++ b/tests/testthat/test-modspec.R @@ -96,6 +96,36 @@ for(what in c("THETA", "PARAM", "CMT", }) } +test_that("multiple blocks allowed or not allowed", { + + for(bl in mrgsolve:::block_list_single) { + code <- glue::glue("${bl} end = 5\n${bl} delta = 1\n$PARAM x = 3") + model <- glue::glue("test-multiple-{tolower(bl)}") + expect_error( + mcode(model, code, compile = FALSE), + "Multiple blocks found" + ) + } + + code <- "$PLUGIN Rcpp\n$PLUGIN BH evtools\n$PARAM x = 3" + expect_silent( + mod <- mcode("test-multiple-plugin", code, compile = FALSE) + ) + expect_is(mod, "mrgmod") + + code <- "$ODE a = 3\n$ODE b = 55\n$PARAM x = 3" + expect_silent( + mod <- mcode("test-multiple-ode", code, compile = FALSE) + ) + expect_is(mod, "mrgmod") + + code <- "$TABLE x\n$TABLE y = 55\n$PARAM x = 3\n y = 10" + expect_silent( + mod <- mcode("test-multiple-table", code, compile = FALSE) + ) + expect_is(mod, "mrgmod") +}) + test_that("Commented model", { code <- ' // A comment