Merge pull request #256 from mrc-ide/cran-fix

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: odin
 Title: ODE Generation and Integration
-Version: 1.3.3
+Version: 1.3.4
 Authors@R: c(person("Rich", "FitzJohn", role = c("aut", "cre"),
                     email = "rich.fitzjohn@gmail.com"),
              person("Thibaut", "Jombart", role = "ctb"),

R/generate_c_compiled.R

@@ -33,7 +33,10 @@ generate_c_compiled <- function(eqs, dat, rewrite) {
 
 
 generate_c_compiled_headers <- function() {
-  c("#include <R.h>",
+  ## It would be nice to define STRICT_R_HEADERS here but we get
+  ## tripped up by ring.
+  c("#include <float.h>",
+    "#include <R.h>",
     "#include <Rmath.h>",
     "#include <Rinternals.h>",
     "#include <stdbool.h>",
@@ -89,12 +92,12 @@ generate_c_compiled_finalise <- function(dat, rewrite) {
     for (el in dat$data$elements) {
       if (el$rank > 0 && el$location == "internal" &&
           el$storage_type %in% c("int", "double")) {
-        body$add("  Free(%s->%s);", internal, el$name)
+        body$add("  R_Free(%s->%s);", internal, el$name)
       }
     }
   }
 
-  body$add("  Free(%s);", internal)
+  body$add("  R_Free(%s);", internal)
   body$add("  R_ClearExternalPtr(%s);", ptr)
   body$add("}")
 
@@ -134,11 +137,11 @@ generate_c_compiled_create <- function(eqs, dat, rewrite) {
   internal_t <- dat$meta$c$internal_t
 
   body <- collector()
-  body$add("%s *%s = (%s*) Calloc(1, %s);",
+  body$add("%s *%s = (%s*) R_Calloc(1, %s);",
            internal_t, internal, internal_t, internal_t)
 
   ## Assign all arrays as NULL, which allows all allocations to be
-  ## written as Free/Calloc because Free will not try to free a
+  ## written as R_Free/R_Calloc because R_Free will not try to free a
   ## pointer that has been set to NULL.
   null_initial <- names_if(vlapply(dat$data$elements, function(x) {
     (x$rank > 0 && x$location == "internal") ||

R/generate_c_equation.R

@@ -93,8 +93,8 @@ generate_c_equation_alloc <- function(eq, data_info, dat, rewrite) {
   ## TODO: this is fine for now, but if we know that some variables
   ## have constant size, then we do not have to ever free them.  It's
   ## fairly harmless though.
-  c(sprintf_safe("Free(%s);", lhs),
-    sprintf_safe("%s = (%s*) Calloc(%s, %s);", lhs, ctype, len, ctype))
+  c(sprintf_safe("R_Free(%s);", lhs),
+    sprintf_safe("%s = (%s*) R_Calloc(%s, %s);", lhs, ctype, len, ctype))
 }
 
 
@@ -224,7 +224,7 @@ generate_c_equation_user <- function(eq, data_info, dat, rewrite) {
   previous <- lhs
 
   if (eq$user$dim) {
-    free <- sprintf_safe("Free(%s);", lhs)
+    free <- sprintf_safe("R_Free(%s);", lhs)
     len <- data_info$dimnames$length
     if (rank == 1L) {
       ret <-
@@ -270,11 +270,11 @@ generate_c_equation_delay_index <- function(eq, data_info, dat, rewrite) {
   lhs <- rewrite(eq$lhs)
   state <- rewrite(delay$state)
 
-  alloc <- c(sprintf_safe("Free(%s);", lhs),
-             sprintf_safe("%s = Calloc(%s, int);",
+  alloc <- c(sprintf_safe("R_Free(%s);", lhs),
+             sprintf_safe("%s = R_Calloc(%s, int);",
                           lhs, rewrite(delay$variables$length)),
-             sprintf_safe("Free(%s);", state),
-             sprintf_safe("%s = Calloc(%s, double);",
+             sprintf_safe("R_Free(%s);", state),
+             sprintf_safe("%s = R_Calloc(%s, double);",
                           state, rewrite(delay$variables$length)))
 
   index1 <- function(v) {

inst/library.c

@@ -111,13 +111,13 @@ void* user_get_array(SEXP user, bool is_integer, void * previous,
 
   void *dest = NULL;
   if (is_integer) {
-    dest = Calloc(len, int);
+    dest = R_Calloc(len, int);
     memcpy(dest, INTEGER(el), len * sizeof(int));
   } else {
-    dest = Calloc(len, double);
+    dest = R_Calloc(len, double);
     memcpy(dest, REAL(el), len * sizeof(double));
   }
-  Free(previous);
+  R_Free(previous);
 
   UNPROTECT(1);
 
@@ -203,13 +203,13 @@ void* user_get_array_dim(SEXP user, bool is_integer, void * previous,
   int len = LENGTH(el);
   void *dest = NULL;
   if (is_integer) {
-    dest = Calloc(len, int);
+    dest = R_Calloc(len, int);
     memcpy(dest, INTEGER(el), len * sizeof(int));
   } else {
-    dest = Calloc(len, double);
+    dest = R_Calloc(len, double);
     memcpy(dest, REAL(el), len * sizeof(double));
   }
-  Free(previous);
+  R_Free(previous);
 
   UNPROTECT(1);
 
@@ -415,7 +415,7 @@ int scalar_int(SEXP x, const char * name) {
   } else if (TYPEOF(x) == REALSXP) {
     double rx = REAL(x)[0];
     ret = rx;
-    if (fabs(rx - ret) > sqrt(DOUBLE_EPS)) {
+    if (fabs(rx - ret) > sqrt(DBL_EPSILON)) {
       Rf_error("Expected a integer-like for '%s'", name);
     }
   } else {