Running ‘testthat.R’ [288s/331s]
Running the tests in ‘tests/testthat.R’ failed.
Complete output:
  > Sys.setenv("R_TESTS" = "")
  > library(testthat)
  > library(RxODE)
  > test_check("RxODE")
  ── 1. Error: Issue #56 (@test-issue-56.R#9)  ───────────────────────────────────
  Error building model
  1: RxODE(model = ode, modName = "m1", wd = "/tmp") at testthat/test-issue-56.R:9
  2: .env$compile()
  3: with(<environment>, {
         .lwd <- getwd()
         if (!file.exists(wd)) 
             dir.create(wd, recursive = TRUE)
         if (file.exists(wd)) 
             setwd(wd)
         on.exit(setwd(.lwd))
         if (missing.modName) {
             .rxDll <- RxODE::rxCompile(.mv, extraC = extraC, debug = debug, package = NULL)
         }
         else {
             .rxDll <- RxODE::rxCompile(.mv, dir = mdir, extraC = extraC, debug = debug, 
                 modName = modName, package = NULL)
         }
         assign("rxDll", .rxDll, envir = <environment>)
         assign(".mv", .rxDll$modVars, envir = <environment>)
     })
  4: with.default(<environment>, {
         .lwd <- getwd()
         if (!file.exists(wd)) 
             dir.create(wd, recursive = TRUE)
         if (file.exists(wd)) 
             setwd(wd)
         on.exit(setwd(.lwd))
         if (missing.modName) {
             .rxDll <- RxODE::rxCompile(.mv, extraC = extraC, debug = debug, package = NULL)
         }
         else {
             .rxDll <- RxODE::rxCompile(.mv, dir = mdir, extraC = extraC, debug = debug, 
                 modName = modName, package = NULL)
         }
         assign("rxDll", .rxDll, envir = <environment>)
         assign(".mv", .rxDll$modVars, envir = <environment>)
     })
  5: eval(substitute(expr), data, enclos = parent.frame())
  6: eval(substitute(expr), data, enclos = parent.frame())
  7: RxODE::rxCompile(.mv, dir = mdir, extraC = extraC, debug = debug, modName = modName, 
         package = NULL)
  8: rxCompile.rxModelVars(.mv, dir = mdir, extraC = extraC, debug = debug, modName = modName, 
         package = NULL)
  9: .badBuild("Error building model")
  10: stop(msg, call. = FALSE)
  
  
   *** caught segfault ***
  address 1, cause 'memory not mapped'
  
  Traceback:
   1: .requirePackage(where)
   2: .getGeneric(f, where, package)
   3: getGeneric(what, FALSE, where)
   4: .recMembers(members, .requirePackage(where))
   5: getGroupMembers(fdef, TRUE, FALSE)
   6: .checkGroupSigLength(list(generic@generic), list(generic))
   7: .updateMethodsInTable(fdef, where, attach)
   8: methods::cacheMetaData(ns, TRUE, ns)
   9: loadNamespace(name)
  10: getNamespace(ns)
  11: asNamespace(ns)
  12: getExportedValue(pkg, name)
  13: Matrix::.bdiag
  14: (function (mat, diag.xform = c("sqrt", "log", "identity")) {    diag.xform <- match.arg(diag.xform)    mat2 <- mat    mat2 <- rxInv(mat2)    mat2 <- try({        chol(mat2)    })    if (inherits(mat2, "try-error")) {        stop("Initial Omega matrix inverse is non-positive definite.")    }    mat3 = mat2    if (diag.xform == "sqrt") {        diag(mat3) <- sqrt(diag(mat3))    }    else if (diag.xform == "log") {        diag(mat3) <- log(diag(mat3))    }    w <- which(as.vector(lower.tri(mat3, TRUE)) * 1 == 1)    elts <- as.vector(mat3)[w]    ini <- as.vector(mat3)[as.vector(upper.tri(mat3, TRUE))]    th.unscaled <- c()    for (i in seq_along(elts)) {        if (elts[i] != 0) {            th.unscaled[length(th.unscaled) + 1] <- elts[i]        }    }    mat1 <- (mat != 0) * 1    if (length(mat1) == 1) {        mat1 <- matrix(mat1, 1)    }    dmat <- dim(mat1)[1] - 1    block <- list()    last <- 1    if (dmat != 0) {        for (i in 1:dmat) {            if (all(mat1[rxBlockZeros(mat1, i)] == 0)) {                s <- seq(last, i)                cur <- matrix(as.double(mat[s, s]), length(s))                last <- i + 1                block[[length(block) + 1]] <- cur            }        }    }    if (length(block) != 0) {        s <- seq(last, dmat + 1)        cur <- matrix(as.double(mat[s, s]), length(s))        block[[length(block) + 1]] <- cur    }    if (length(block) == 0) {        if (diag.xform == "sqrt" && dim(mat1)[1] <= .Call(`_rxCholInv`,             0L, NULL, NULL)) {            fmat <- mat1            num <- as.vector(mat1[upper.tri(mat1, TRUE)])            i <- 0            num <- sapply(num, function(x) {                if (x == 1) {                  i <<- i + 1                  return(i)                }                else {                  return(0)                }            })            fmat[upper.tri(fmat, TRUE)] <- num - 1            fmat[lower.tri(fmat)] <- t(fmat)[lower.tri(fmat)]            d <- dim(fmat)[1]            fmat <- paste0("t", fmat)            fmat[fmat == "t-1"] <- "0"            fmat <- matrix(fmat, d)            if (diag.xform == "sqrt") {                diag(fmat) <- sprintf("%s^2", diag(fmat))            }            else if (diag.xform == "log") {                diag(fmat) <- sprintf("exp(%s)", diag(fmat))            }            else {                diag(fmat) <- sprintf("(%s)", diag(fmat))            }            w <- which(fmat[upper.tri(fmat, TRUE)] != "0")            if (length(w) == 0) {                stop("zero matrix.")            }            fn <- eval(bquote(function(theta, tn) {                if (is.null(tn)) {                  .ret <- matrix(rep(TRUE, .(d * d)), nrow = .(d))                  .ret[lower.tri(.ret)] <- FALSE                  return(.ret[lower.tri(.ret, TRUE)])                }                else if (is.na(tn)) {                  new.theta <- rep(0, .((d + 1) * d/2))                  new.theta[.(w)] <- theta                  return(.Call(`_rxCholInv`, .(as.integer(d)),                     as.double(new.theta), NA_integer_))                }                if (tn == -2L) {                  return(.(length(w)))                }                new.theta <- rep(0, .((d + 1) * d/2))                new.theta[.(w)] <- theta                return(.Call(`_rxCholInv`, .(as.integer(d)),                   as.double(new.theta), as.integer(tn)))            }))            ret <- list(fmat = fmat, fn = fn, ini = ini, cache = TRUE)            class(ret) <- "rxSymInvChol"            return(ret)        }        else {            ret <- rxSymInvC2(mat1 = mat1, diag.xform = diag.xform)            th <- th.unscaled            ret <- list(fmat = ret[[2]], ini = ini, fn = rxSymInvCreate2C(ret[[1]]))            class(ret) <- "rxSymInvChol"            return(ret)        }    }    else {        mat <- Matrix::.bdiag(block)        matI <- lapply(block, rxSymInvCreateC_, diag.xform = diag.xform)        ini <- unlist(lapply(matI, function(x) {            x$ini        }))        ntheta <- sum(sapply(matI, function(x) {            return(x$fn(NULL, -2L))        }))        i <- 1        theta.part <- lapply(matI, function(x) {            len <- x$fn(NULL, -2L)            ret <- as.integer(seq(i, by = 1, length = len))            i <<- max(ret) + 1            return(ret)        })        fn <- eval(bquote(function(theta, tn) {            force(matI)            theta.part <- .(theta.part)            if (is.null(tn)) {                if (is.null(theta)) {                  return(unlist(lapply(theta.part, function(x) {                    .j <- .k <- 1                    .ret <- logical(length(x))                    for (.i in seq_along(x)) {                      if (.j == .k) {                        .ret[.i] <- TRUE                        .k <- .k + 1                        .j <- 1                      } else {                        .ret[.i] <- FALSE                        .j <- .j + 1                      }                    }                    return(.ret)                  })))                }            }            else if (!is.na(tn)) {                if (tn == -2L) {                  return(.(ntheta))                }            }            lst <- lapply(seq_along(theta.part), function(x) {                mt <- matI[[x]]                w <- theta.part[[x]]                new.theta <- theta[w]                ctn <- as.integer(tn)                if (is.na(ctn)) {                  return(mt$fn(as.double(new.theta), ctn))                }                else if (ctn == -1L || ctn == 0L) {                  return(mt$fn(as.double(new.theta), ctn))                }                else {                  if (ctn > 0L) {                    if (ctn > max(w) | ctn < min(w)) {                      mat <- mt$fn(as.double(new.theta), 0L)                      d <- dim(mat)[1]                      return(matrix(rep(0, d * d), d))                    }                    else {                      ctn <- as.integer(ctn - min(w) + 1)                      return(mt$fn(as.double(new.theta), ctn))                    }                  }                  else {                    ctn <- as.integer(-ctn - 2)                    if (ctn > max(w) | ctn < min(w)) {                      vec <- mt$fn(as.double(new.theta), -3L)                      d <- length(vec)                      return(rep(0, d))                    }                    else {                      ctn <- as.integer(-(ctn - min(w) + 1) -                         2L)                      return(mt$fn(as.double(new.theta), ctn))                    }                  }                }            })            if (is.na(tn)) {                return(unlist(lst))            }            else if (tn >= -1) {                return(as.matrix(Matrix::.bdiag(lst)))            }            else {                return(unlist(lst))            }        }))        ret <- list(fmat = mat, ini = ini, fn = fn)        class(ret) <- "rxSymInvChol"        return(ret)    }})(mat = matrix(c(1, 0.9, 0, 0.9, 1, 0, 0, 0, 1), ncol = 3))
  15: do.call(rxSymInvCreateC_, args, envir = envir)
  16: rxSymInvCholCreate(matrix(c(1, 0.9, 0, 0.9, 1, 0, 0, 0, 1), ncol = 3))
  17: eval(code, test_env)
  18: eval(code, test_env)
  19: withCallingHandlers({    eval(code, test_env)    if (!handled && !is.null(test)) {        skip_empty()    }}, expectation = handle_expectation, skip = handle_skip, warning = handle_warning,     message = handle_message, error = handle_error)
  20: doTryCatch(return(expr), name, parentenv, handler)
  21: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  22: tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
  23: doTryCatch(return(expr), name, parentenv, handler)
  24: tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]),     names[nh], parentenv, handlers[[nh]])
  25: tryCatchList(expr, classes, parentenv, handlers)
  26: tryCatch(withCallingHandlers({    eval(code, test_env)    if (!handled && !is.null(test)) {        skip_empty()    }}, expectation = handle_expectation, skip = handle_skip, warning = handle_warning,     message = handle_message, error = handle_error), error = handle_fatal,     skip = function(e) {    })
  27: test_code(desc, code, env = parent.frame())
  28: test_that("diagonal indicator give correct values", {    tmp <- rxSymInvCholCreate(matrix(c(1, 0.9, 0, 0.9, 1, 0,         0, 0, 1), ncol = 3))    expect_equal(tmp$theta.diag, c(TRUE, FALSE, TRUE, TRUE))    tmp <- rxSymInvCholCreate(matrix(c(1, 0.9, 0.9, 1), ncol = 2))    expect_equal(tmp$theta.diag, c(TRUE, FALSE, TRUE))})
  29: eval(code, test_env)
  30: eval(code, test_env)
  31: withCallingHandlers({    eval(code, test_env)    if (!handled && !is.null(test)) {        skip_empty()    }}, expectation = handle_expectation, skip = handle_skip, warning = handle_warning,     message = handle_message, error = handle_error)
  32: doTryCatch(return(expr), name, parentenv, handler)
  33: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  34: tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
  35: doTryCatch(return(expr), name, parentenv, handler)
  36: tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]),     names[nh], parentenv, handlers[[nh]])
  37: tryCatchList(expr, classes, parentenv, handlers)
  38: tryCatch(withCallingHandlers({    eval(code, test_env)    if (!handled && !is.null(test)) {        skip_empty()    }}, expectation = handle_expectation, skip = handle_skip, warning = handle_warning,     message = handle_message, error = handle_error), error = handle_fatal,     skip = function(e) {    })
  39: test_code(NULL, exprs, env)
  40: source_file(path, new.env(parent = env), chdir = TRUE, wrap = wrap)
  41: force(code)
  42: with_reporter(reporter = reporter, start_end_reporter = start_end_reporter,     {        reporter$start_file(basename(path))        lister$start_file(basename(path))        source_file(path, new.env(parent = env), chdir = TRUE,             wrap = wrap)        reporter$end_context()        reporter$end_file()    })
  43: FUN(X[[i]], ...)
  44: lapply(paths, test_file, env = env, reporter = current_reporter,     start_end_reporter = FALSE, load_helpers = FALSE, wrap = wrap)
  45: force(code)
  46: with_reporter(reporter = current_reporter, results <- lapply(paths,     test_file, env = env, reporter = current_reporter, start_end_reporter = FALSE,     load_helpers = FALSE, wrap = wrap))
  47: test_files(paths, reporter = reporter, env = env, stop_on_failure = stop_on_failure,     stop_on_warning = stop_on_warning, wrap = wrap)
  48: test_dir(path = test_path, reporter = reporter, env = env, filter = filter,     ..., stop_on_failure = stop_on_failure, stop_on_warning = stop_on_warning,     wrap = wrap)
  49: test_package_dir(package = package, test_path = test_path, filter = filter,     reporter = reporter, ..., stop_on_failure = stop_on_failure,     stop_on_warning = stop_on_warning, wrap = wrap)
  50: test_check("RxODE")
  An irrecoverable exception occurred. R is aborting now ...