Intel c work-around

R/rxValidate.R

@@ -17,7 +17,9 @@ rxValidate <- function(type = NULL, skipOnCran=TRUE) {
         return(invisible())
       }
     }
-    rxUnloadAll()
+    if (!.Call(`_rxode2_isIntel`)) {
+      rxUnloadAll()
+    }
     return(force(type))
   }
   pt <- proc.time()

src/utilc.c

@@ -46,13 +46,14 @@ extern void RSprintf(const char *format, ...) {
   }
 }
 
-#if defined(__INTEL_LLVM_COMPILER)
+#if defined(__INTEL_LLVM_COMPILER) || defined(__INTEL_COMPILER__)
 SEXP _rxode2_isIntel(void) {
   SEXP ret = PROTECT(Rf_allocVector(LGLSXP, 1));
   INTEGER(ret)[0] = 1;
   UNPROTECT(1);
   return ret;
 }
+
 #else
 SEXP _rxode2_isIntel(void) {
   SEXP ret = PROTECT(Rf_allocVector(LGLSXP, 1));

tests/testthat/test-as-ini.R

@@ -1,86 +1,88 @@
-test_that("as.ini ini expression", {
-
-  is.ini <- function(x) {
-    expect_true(is.call(x))
-    expect_true(identical(x[[1]], quote(`ini`)))
-  }
-
-  ini <- quote(ini({
-    tka <- log(1.57)
-    tcl <- log(2.72)
-    tv <- log(31.5)
-    eta.ka ~ 0.6
-    eta.cl ~ 0.3
-    eta.v ~ 0.1
-    add.sd <- 0.7
-  }))
-
-  is.ini(as.ini(ini))
-
-  l <- quote(lotri({
-    tka <- log(1.57)
-    tcl <- log(2.72)
-    tv <- log(31.5)
-    eta.ka ~ 0.6
-    eta.cl ~ 0.3
-    eta.v ~ 0.1
-    add.sd <- 0.7
-  }))
-
-  is.ini(as.ini(l))
-
-  m <- lotri({
-    eta.ka ~ 0.6
-    eta.cl ~ 0.3
-    eta.v ~ 0.1
-  })
+if (!.Call(`_rxode2_isIntel`)) {
+  test_that("as.ini ini expression", {
 
-  is.ini(as.ini(m))
+    is.ini <- function(x) {
+      expect_true(is.call(x))
+      expect_true(identical(x[[1]], quote(`ini`)))
+    }
 
-  one.compartment <- function() {
-    ini({
+    ini <- quote(ini({
       tka <- log(1.57)
       tcl <- log(2.72)
       tv <- log(31.5)
       eta.ka ~ 0.6
       eta.cl ~ 0.3
       eta.v ~ 0.1
       add.sd <- 0.7
+    }))
+
+    is.ini(as.ini(ini))
+
+    l <- quote(lotri({
+      tka <- log(1.57)
+      tcl <- log(2.72)
+      tv <- log(31.5)
+      eta.ka ~ 0.6
+      eta.cl ~ 0.3
+      eta.v ~ 0.1
+      add.sd <- 0.7
+    }))
+
+    is.ini(as.ini(l))
+
+    m <- lotri({
+      eta.ka ~ 0.6
+      eta.cl ~ 0.3
+      eta.v ~ 0.1
     })
-    model({
-      ka <- exp(tka + eta.ka)
-      cl <- exp(tcl + eta.cl)
-      v <- exp(tv + eta.v)
-      d/dt(depot) = -ka * depot
-      d/dt(center) = ka * depot - cl / v * center
-      cp = center / v
-      cp ~ add(add.sd)
-    })
-  }
 
-  is.ini(as.ini(one.compartment))
-
-  ui <- one.compartment()
+    is.ini(as.ini(m))
 
-  is.ini(as.ini(ui))
+    one.compartment <- function() {
+      ini({
+        tka <- log(1.57)
+        tcl <- log(2.72)
+        tv <- log(31.5)
+        eta.ka ~ 0.6
+        eta.cl ~ 0.3
+        eta.v ~ 0.1
+        add.sd <- 0.7
+      })
+      model({
+        ka <- exp(tka + eta.ka)
+        cl <- exp(tcl + eta.cl)
+        v <- exp(tv + eta.v)
+        d/dt(depot) = -ka * depot
+        d/dt(center) = ka * depot - cl / v * center
+        cp = center / v
+        cp ~ add(add.sd)
+      })
+    }
 
-  is.ini(as.ini(ui$iniDf))
+    is.ini(as.ini(one.compartment))
 
-  ini <- c("ini({",
-           "tka <- log(1.57)",
-           "tcl <- log(2.72)",
-           "tv <- log(31.5)",
-           "eta.ka ~ 0.6",
-           "eta.cl ~ 0.3",
-           "eta.v ~ 0.1",
-           "add.sd <- 0.7",
-           "})")
+    ui <- one.compartment()
 
-  is.ini(as.ini(ini))
+    is.ini(as.ini(ui))
 
-  ini <- paste(ini, collapse="\n")
+    is.ini(as.ini(ui$iniDf))
 
-  is.ini(as.ini(ini))
-
+    ini <- c("ini({",
+             "tka <- log(1.57)",
+             "tcl <- log(2.72)",
+             "tv <- log(31.5)",
+             "eta.ka ~ 0.6",
+             "eta.cl ~ 0.3",
+             "eta.v ~ 0.1",
+             "add.sd <- 0.7",
+             "})")
 
-})
+    is.ini(as.ini(ini))
+
+    ini <- paste(ini, collapse="\n")
+
+    is.ini(as.ini(ini))
+
+
+  })
+}

tests/testthat/test-as-model.R

@@ -1,63 +1,65 @@
-test_that("as.model expression", {
-
-  is.model <- function(x) {
-    expect_true(is.call(x))
-    expect_true(identical(x[[1]], quote(`model`)))
-  }
-
-  model <- quote(model({
-    ka <- exp(tka + eta.ka)
-    cl <- exp(tcl + eta.cl)
-    v <- exp(tv + eta.v)
-    d/dt(depot) = -ka * depot
-    d/dt(center) = ka * depot - cl / v * center
-    cp = center / v
-    cp ~ add(add.sd)
-  }))
-
-  is.model(as.model(model))
-
-  one.compartment <- function() {
-    ini({
-      tka <- log(1.57)
-      tcl <- log(2.72)
-      tv <- log(31.5)
-      eta.ka ~ 0.6
-      eta.cl ~ 0.3
-      eta.v ~ 0.1
-      add.sd <- 0.7
-    })
-    model({
+if (!.Call(`_rxode2_isIntel`)) {
+  test_that("as.model expression", {
+
+    is.model <- function(x) {
+      expect_true(is.call(x))
+      expect_true(identical(x[[1]], quote(`model`)))
+    }
+
+    model <- quote(model({
       ka <- exp(tka + eta.ka)
       cl <- exp(tcl + eta.cl)
       v <- exp(tv + eta.v)
       d/dt(depot) = -ka * depot
       d/dt(center) = ka * depot - cl / v * center
       cp = center / v
       cp ~ add(add.sd)
-    })
-  }
+    }))
+
+    is.model(as.model(model))
+
+    one.compartment <- function() {
+      ini({
+        tka <- log(1.57)
+        tcl <- log(2.72)
+        tv <- log(31.5)
+        eta.ka ~ 0.6
+        eta.cl ~ 0.3
+        eta.v ~ 0.1
+        add.sd <- 0.7
+      })
+      model({
+        ka <- exp(tka + eta.ka)
+        cl <- exp(tcl + eta.cl)
+        v <- exp(tv + eta.v)
+        d/dt(depot) = -ka * depot
+        d/dt(center) = ka * depot - cl / v * center
+        cp = center / v
+        cp ~ add(add.sd)
+      })
+    }
+
+    is.model(as.model(one.compartment))
+
+    ui <- one.compartment()
 
-  is.model(as.model(one.compartment))
-
-  ui <- one.compartment()
+    is.model(as.model(ui))
 
-  is.model(as.model(ui))
+    model <- c("model({",
+               "ka <- exp(tka + eta.ka)",
+               "cl <- exp(tcl + eta.cl)",
+               "v <- exp(tv + eta.v)",
+               "d/dt(depot) = -ka * depot",
+               "d/dt(center) = ka * depot - cl / v * center",
+               "cp = center / v",
+               "cp ~ add(add.sd)",
+               "})")
 
-  model <- c("model({",
-             "ka <- exp(tka + eta.ka)",
-             "cl <- exp(tcl + eta.cl)",
-             "v <- exp(tv + eta.v)",
-             "d/dt(depot) = -ka * depot",
-             "d/dt(center) = ka * depot - cl / v * center",
-             "cp = center / v",
-             "cp ~ add(add.sd)",
-             "})")
+    is.model(as.model(model))
 
-  is.model(as.model(model))
+    model <- paste(model, collapse="\n")
 
-  model <- paste(model, collapse="\n")
+    is.model(as.model(model))
 
-  is.model(as.model(model))
-
-})
+  })
+}

tests/testthat/test-assert.R

@@ -1,23 +1,25 @@
-test_that("assertRxUiRandomOnIdOnly", {
-  one.cmt <- function() {
-    ini({
-      tka <- 0.45; label("Ka")
-      tcl <- log(c(0, 2.7, 100)); label("Cl")
-      tv <- 3.45; label("V")
-      eta.ka ~ 0.6
-      eta.cl ~ 0.3
-      eta.v ~ 0.1
-      add.sd <- 0.7
-    })
-    model({
-      ka <- exp(tka + eta.ka)
-      cl <- exp(tcl + eta.cl)
-      v <- exp(tv + eta.v)
-      linCmt() ~ add(add.sd)
-    })
-  }
-  expect_equal(
-    assertRxUiRandomOnIdOnly(one.cmt),
-    as.rxUi(one.cmt)
-  )
-})
+if (!.Call(`_rxode2_isIntel`)) {
+  test_that("assertRxUiRandomOnIdOnly", {
+    one.cmt <- function() {
+      ini({
+        tka <- 0.45; label("Ka")
+        tcl <- log(c(0, 2.7, 100)); label("Cl")
+        tv <- 3.45; label("V")
+        eta.ka ~ 0.6
+        eta.cl ~ 0.3
+        eta.v ~ 0.1
+        add.sd <- 0.7
+      })
+      model({
+        ka <- exp(tka + eta.ka)
+        cl <- exp(tcl + eta.cl)
+        v <- exp(tv + eta.v)
+        linCmt() ~ add(add.sd)
+      })
+    }
+    expect_equal(
+      assertRxUiRandomOnIdOnly(one.cmt),
+      as.rxUi(one.cmt)
+    )
+  })
+}