Fix: write barrier bypass in setv()/copyv() for STRSXP/VECSXP targets

NEWS.md

@@ -1,5 +1,7 @@
 # collapse 2.1.7
 
+* Fixed a bug in `setv()`/`copyv()` where assignments into character (`STRSXP`) or list (`VECSXP`) vectors bypassed R's generational write barrier, writing element pointers directly instead of using `SET_STRING_ELT()`/`SET_VECTOR_ELT()`. This could cause an old-generation target to hold an unrecorded reference to a younger value, which a subsequent young-generation garbage collection could free while still referenced, leading to memory corruption, cryptic `CHAR()`/`SET_STRING_ELT()` errors, or segfaults, most likely under heavy allocation in long-running processes. Thanks @SebKrantz for reporting and diagnosing (#876).
+
 * Fixed a bug in `fmatch()` (and thus `%in%`/`%!in%`/`%iin%`/`%!iin%` and joins) where a logical `NA` in `x` could spuriously match a non-`NA` value in `table` (e.g. `2L`) when `table` was not itself logical. Thanks @LJ-Jenkins for reporting (#870).
 
 * Fixed a bug in `fslice()` (grouped, `n = 1`, `with.ties = FALSE`) that caused R to crash with a fatal error when a group had only missing values in `order.by`. Thanks @chihyunkim for reporting (#867).

src/programming.c

@@ -341,6 +341,38 @@ SEXP setcopyv(SEXP x, SEXP val, SEXP rep, SEXP Rinvert, SEXP Rset, SEXP Rind1) {
     for(int i = 0; i != n; ++i) if(pv[i] == 0) px[i] = pr[i];   \
   }
 
+  // STRSXP/VECSXP need SET_STRING_ELT()/SET_VECTOR_ELT() instead of raw pointer
+  // writes so that R's generational write barrier records the reference
+  // (see issue about setv()/copyv() corrupting old-generation targets).
+  #define setcopyvLOOP_SEXP(e, SETELT)                              \
+  if(invert) {                                                      \
+    for(int i = 0; i != n; ++i) if(px[i] != v) SETELT(target, i, e); \
+  } else {                                                          \
+    for(int i = 0; i != n; ++i) if(px[i] == v) SETELT(target, i, e); \
+  }
+
+  #define setcopyvLOOPLVEC1_SEXP(SETELT)                             \
+  if(tv == INTSXP) {                                                 \
+    for(int i = 0; i < lv; ++i) SETELT(target, pv[i]-1, r);          \
+  } else if(invert == 0) {                                           \
+    for(int i = 0; i != n; ++i) if(pv[i] > 0) SETELT(target, i, r);  \
+  } else {                                                           \
+    for(int i = 0; i != n; ++i) if(pv[i] == 0) SETELT(target, i, r); \
+  }
+
+  #define setcopyvLOOPLVEC_SEXP(SETELT)                                    \
+  if(tv == INTSXP) {                                                       \
+    if(lr == n) {                                                          \
+      for(int i = 0; i < lv; ++i) SETELT(target, pv[i]-1, pr[pv[i]-1]);    \
+    } else {                                                               \
+      for(int i = 0; i < lv; ++i) SETELT(target, pv[i]-1, pr[i]);          \
+    }                                                                      \
+  } else if(invert == 0) {                                                 \
+    for(int i = 0; i != n; ++i) if(pv[i] > 0) SETELT(target, i, pr[i]);    \
+  } else {                                                                 \
+    for(int i = 0; i != n; ++i) if(pv[i] == 0) SETELT(target, i, pr[i]);   \
+  }
+
   switch(tx) {
   case INTSXP:
   case LGLSXP:
@@ -413,44 +445,45 @@ SEXP setcopyv(SEXP x, SEXP val, SEXP rep, SEXP Rinvert, SEXP Rset, SEXP Rind1) {
   }
   case STRSXP:
   {
-    SEXP *restrict px = set ? SEXPPTR(x) : SEXPPTR(ans);
+    const SEXP target = set ? x : ans;
+    const SEXP *restrict px = SEXPPTR_RO(target);
     if(lv == 1 && ind1 == 0) {
       const SEXP v = PROTECT(asChar(val));
       if(lr == 1) {
         const SEXP r = PROTECT(asChar(rep));
-        setcopyvLOOP(r)
+        setcopyvLOOP_SEXP(r, SET_STRING_ELT)
         UNPROTECT(1);
       } else {
         const SEXP *restrict pr = SEXPPTR_RO(rep);
-        setcopyvLOOP(pr[i])
+        setcopyvLOOP_SEXP(pr[i], SET_STRING_ELT)
       }
       UNPROTECT(1);
     } else {
       const int *restrict pv = INTEGER(val); // ALTREP(val) ? (const int *)ALTVEC_DATAPTR(val) :
       if(lr == 1) {
         const SEXP r = PROTECT(asChar(rep));
-        setcopyvLOOPLVEC1
+        setcopyvLOOPLVEC1_SEXP(SET_STRING_ELT)
         UNPROTECT(1);
       } else {
         const SEXP *restrict pr = SEXPPTR_RO(rep);
-        setcopyvLOOPLVEC
+        setcopyvLOOPLVEC_SEXP(SET_STRING_ELT)
       }
     }
     break;
   }
   case VECSXP:
   {
     if(set && ALTREP(x)) error("cannot modify ALTREP list by reference");
-    SEXP *restrict px = set ? SEXPPTR(x) : SEXPPTR(ans);
+    const SEXP target = set ? x : ans;
     if(lv == 1 && ind1 == 0) error("Cannot compare lists to a value");
     // if(tr != VECSXP) error("If X is a list and xlist = TRUE, R also needs to be a list");
     const int *restrict pv = INTEGER(val); // ALTREP(val) ? (const int *)ALTVEC_DATAPTR(val) :
     if(lr == 1) {
       const SEXP r = VECTOR_ELT(rep, 0);
-      setcopyvLOOPLVEC1
+      setcopyvLOOPLVEC1_SEXP(SET_VECTOR_ELT)
     } else {
       const SEXP *restrict pr = SEXPPTR_RO(rep);
-      setcopyvLOOPLVEC
+      setcopyvLOOPLVEC_SEXP(SET_VECTOR_ELT)
     }
     break;
   }