From d499fab95b1ba23ee7842293030d4af1e69ae0fe Mon Sep 17 00:00:00 2001
From: luke <luke@00db46b3-68df-0310-9c12-caf00c1e9a41>
Date: Wed, 5 Jun 2024 16:40:48 +0000
Subject: [PATCH] Add VECTOR_PTR_RO for consistency with STRING_PTR_RO.

git-svn-id: https://svn.r-project.org/R/trunk@86694 00db46b3-68df-0310-9c12-caf00c1e9a41
---
 src/include/Defn.h       | 1 +
 src/include/Rinternals.h | 1 +
 src/main/memory.c        | 8 ++++++++
 3 files changed, 10 insertions(+)

diff --git a/src/include/Defn.h b/src/include/Defn.h
index 473b77f464..30dfba5561 100644
--- a/src/include/Defn.h
+++ b/src/include/Defn.h
@@ -425,6 +425,7 @@ typedef union { VECTOR_SEXPREC s; double align; } SEXPREC_ALIGN;
 #define COMPLEX_RO(x)	((const Rcomplex *) DATAPTR_RO(x))
 #define REAL_RO(x)	((const double *) DATAPTR_RO(x))
 #define STRING_PTR_RO(x)((const SEXP *) DATAPTR_RO(x))
+#define VECTOR_PTR_RO(x)((const SEXP *) DATAPTR_RO(x))
 
 /* List Access Macros */
 /* These also work for ... objects */
diff --git a/src/include/Rinternals.h b/src/include/Rinternals.h
index 3b73c80eea..90691a89e5 100644
--- a/src/include/Rinternals.h
+++ b/src/include/Rinternals.h
@@ -292,6 +292,7 @@ void SET_STRING_ELT(SEXP x, R_xlen_t i, SEXP v);
 SEXP SET_VECTOR_ELT(SEXP x, R_xlen_t i, SEXP v);
 SEXP *(STRING_PTR)(SEXP x);
 const SEXP *(STRING_PTR_RO)(SEXP x);
+const SEXP *(VECTOR_PTR_RO)(SEXP x);
 NORET SEXP * (VECTOR_PTR)(SEXP x);
 
 R_xlen_t INTEGER_GET_REGION(SEXP sx, R_xlen_t i, R_xlen_t n, int *buf);
diff --git a/src/main/memory.c b/src/main/memory.c
index 6166f04884..47e295b731 100644
--- a/src/main/memory.c
+++ b/src/main/memory.c
@@ -4216,6 +4216,14 @@ NORET SEXP * (VECTOR_PTR)(SEXP x)
   error(_("not safe to return vector pointer"));
 }
 
+const SEXP *(VECTOR_PTR_RO)(SEXP x) {
+    if(TYPEOF(x) != VECSXP)
+	error("%s() can only be applied to a '%s', not a '%s'",
+	      "STRING_PTR_RO", "list", R_typeToChar(x));
+    CHKZLN(x);
+    return VECTOR_PTR_RO(x);
+}
+
 void (SET_STRING_ELT)(SEXP x, R_xlen_t i, SEXP v) {
     if(TYPEOF(CHK(x)) != STRSXP)
 	error("%s() can only be applied to a '%s', not a '%s'",