In the C implementation of the ergm.eta() family, fixed the memory er…

…ror when the dimension of theta is 0.
statnet · Dec 23, 2024 · d0c5e5c · d0c5e5c
1 parent 8bd0d94
commit d0c5e5c
Show file tree

Hide file tree

Showing 2 changed files with 18 additions and 15 deletions.
diff --git a/src/etamap.c b/src/etamap.c
@@ -10,21 +10,24 @@
 #include "ergm_etamap.h"
 #include <Rversion.h>
 
-#define SETUP_CALL(fun)                         \
-  SEXP cm = VECTOR_ELT(curved, i);              \
-  SEXP toR = getListElement(cm, "to");          \
-  unsigned int to = INTEGER(toR)[0];            \
-  unsigned int nto = length(toR);               \
-  SEXP fromR = getListElement(cm, "from");      \
-  unsigned int from = INTEGER(fromR)[0];        \
-  unsigned int nfrom = length(fromR);           \
-  SEXP cov = getListElement(cm, "cov");         \
-  SEXP fun = getListElement(cm, #fun);          \
-                                                \
+/* UINT_MAX's are there to segfault as soon as possible if empty from
+   and to vectors are actually used rather than return misleading
+   results. */
+#define SETUP_CALL(fun)                                                 \
+  SEXP cm = VECTOR_ELT(curved, i);                                      \
+  SEXP toR = getListElement(cm, "to");                                  \
+  unsigned int nto = length(toR);                                       \
+  unsigned int to = nto ? INTEGER(toR)[0] : UINT_MAX;                   \
+  SEXP fromR = getListElement(cm, "from");                              \
+  unsigned int nfrom = length(fromR);                                   \
+  unsigned int from = nfrom ? INTEGER(fromR)[0] : UINT_MAX;             \
+  SEXP cov = getListElement(cm, "cov");                                 \
+  SEXP fun = getListElement(cm, #fun);                                  \
+                                                                        \
   SEXP pos = call, arg;                                                 \
   SETCAR(pos, fun); pos = CDR(pos);                                     \
   SETCAR(pos, (arg = allocVector(REALSXP, nfrom))); pos = CDR(pos); /* Don't need to PROTECT the vector this way. */ \
-  memcpy(REAL(arg), theta1+from, nfrom*sizeof(double));                 \
+  if(nfrom) memcpy(REAL(arg), theta1+from, nfrom*sizeof(double));       \
   SETCAR(pos, ScalarInteger(nto)); pos = CDR(pos);                      \
   SETCAR(pos, cov);
 

diff --git a/tests/testthat/test-C-curved.R b/tests/testthat/test-C-curved.R
@@ -52,9 +52,9 @@ ergm.etagradmult.R <- function(theta, v, etamap) {
 }
 
 data(faux.mesa.high)
-flom <- ergm_model(~edges+gwesp()+gwdegree()+absdiffcat("Grade")+Offset(~nodefactor("Grade"),c(+1,-1), c(2,3))+gwesp()+NodematchFilter(~gwesp()+nodefactor("Grade"), "Grade"), faux.mesa.high)
-(neta <- nparam(flom, canonical=TRUE))
-(ntheta <- nparam(flom, canonical=FALSE))
+flom <- ergm_model(~edges+gwesp()+gwdegree()+absdiffcat("Grade")+Offset(~edges+edges,c(+1,-1))+Offset(~nodefactor("Grade"),c(+1,-1), c(2,3))+gwesp()+NodematchFilter(~gwesp()+nodefactor("Grade"), "Grade"), faux.mesa.high)
+neta <- nparam(flom, canonical=TRUE)
+ntheta <- nparam(flom, canonical=FALSE)
 
 test_that("C implementation of ergm.eta gives the same answer as R implementation.", {
   expect_equal(ergm.eta(1:ntheta, flom$etamap), ergm.eta.R(1:ntheta, flom$etamap))