From 82587dc1ccc203fe3f65e4e133eb66f5fbd917d4 Mon Sep 17 00:00:00 2001
From: "Pavel N. Krivitsky" <p.krivitsky@unsw.edu.au>
Date: Tue, 10 Sep 2024 10:14:03 +1000
Subject: [PATCH] No longer use the non-API call SET_TYPEOF(); allocLang()
 (with a workaround for older R) is used instead.

fixes statnet/ergm#575
---
 src/etamap.c | 33 ++++++++++++++++++++++++---------
 1 file changed, 24 insertions(+), 9 deletions(-)

diff --git a/src/etamap.c b/src/etamap.c
index 000cb82dc..61eb7e003 100644
--- a/src/etamap.c
+++ b/src/etamap.c
@@ -8,6 +8,7 @@
  *  Copyright 2003-2023 Statnet Commons
  */
 #include "ergm_etamap.h"
+#include <Rversion.h>
 
 #define SETUP_CALL(fun)                         \
   SEXP cm = VECTOR_ELT(curved, i);              \
@@ -28,6 +29,23 @@
   SETCAR(pos, cov);
 
 
+/*
+   A local implementation of allocLang(), recommended by Writing R
+   Extensions.
+
+   TODO: Delete in mid 2026.
+*/
+#if R_VERSION < R_Version(4, 4, 1)
+static inline SEXP allocLang(int n)
+{
+    if (n > 0)
+	  return LCONS(R_NilValue, allocList(n - 1));
+    else
+	  return R_NilValue;
+}
+#endif
+/* End local implementation of allocLang(). */
+
 SEXP ergm_eta_wrapper(SEXP thetaR, SEXP etamap){
   unsigned int neta = asInteger(getListElement(etamap, "etalength"));
   SEXP etaR = PROTECT(allocVector(REALSXP, neta));
@@ -56,9 +74,8 @@ void ergm_eta(double *theta, SEXP etamap, double *eta){
   unsigned int ncurved = length(curved);
 
   if(ncurved){
-    SEXP call = PROTECT(allocList(4));
-    SET_TYPEOF(call, LANGSXP);
-    
+    SEXP call = PROTECT(allocLang(3));
+
     for(unsigned int i = 0; i < ncurved; i++){
       SETUP_CALL(map);
       memcpy(eta1+to, REAL(eval(call, R_EmptyEnv)), nto*sizeof(double));
@@ -100,9 +117,8 @@ void ergm_etagrad(double *theta, SEXP etamap, double *etagrad){
   unsigned int ncurved = length(curved);
 
   if(ncurved){
-    SEXP call = PROTECT(allocList(4));
-    SET_TYPEOF(call, LANGSXP);
-    
+    SEXP call = PROTECT(allocLang(3));
+
     for(unsigned int i = 0; i < ncurved; i++){
       SETUP_CALL(gradient);
       double *g = REAL(eval(call, R_EmptyEnv));
@@ -158,9 +174,8 @@ void ergm_etagradmult(double *theta, double *v, unsigned int nv, SEXP etamap, do
   unsigned int ncurved = length(curved);
 
   if(ncurved){
-    SEXP call = PROTECT(allocList(4));
-    SET_TYPEOF(call, LANGSXP);
-    
+    SEXP call = PROTECT(allocLang(3));
+
     for(unsigned int i = 0; i < ncurved; i++){
       SETUP_CALL(gradient);
       double *g = REAL(eval(call, R_EmptyEnv));