AttributeProxy::set() (#947)

* AttributeProxy::set() fix

* no need to Shield<> in meat

* slightly nicer to inline Shield<>

* Vector(SEXP) needs to protect `x` because `r_cast()` allocates.

* safer NameProxy::set(). rchk.

* safer clone<>

* safer Vector ctors with various Shield<SEXP>

Author: romainfrancois

inst/include/Rcpp/api/meat/proxy.h

@@ -30,7 +30,7 @@ template <typename CLASS>
 template <typename T>
 typename AttributeProxyPolicy<CLASS>::AttributeProxy&
 AttributeProxyPolicy<CLASS>::AttributeProxy::operator=(const T& rhs) {
-    set(Shield<SEXP>(wrap(rhs)));
+    set(wrap(rhs));
     return *this;
 }
 

inst/include/Rcpp/clone.h

@@ -31,8 +31,9 @@ namespace Rcpp{
    - T has a SEXP constructor
 */
 template <typename T> T clone(const T& object) {
-    SEXP x = const_cast<T&>(object) ;
-    return T( Rf_duplicate( x ) ) ;
+    Shield<SEXP> x(const_cast<T&>(object));
+    Shield<SEXP> copy(Rf_duplicate(x));
+    return T((SEXP)copy);
 }
 
 } // namespace Rcpp

inst/include/Rcpp/proxy/AttributeProxy.h

@@ -49,7 +49,7 @@ class AttributeProxyPolicy {
             return Rf_getAttrib( parent, attr_name ) ;
         }
         void set(SEXP x ){
-            Rf_setAttrib( parent, attr_name, x ) ;
+            Rf_setAttrib( parent, attr_name, Shield<SEXP>(x) ) ;
         }
     } ;
 

inst/include/Rcpp/proxy/NamesProxy.h

@@ -47,14 +47,16 @@ class NamesProxyPolicy{
         }
 
         void set(SEXP x) {
+            Shield<SEXP> safe_x(x);
+
             /* check if we can use a fast version */
             if( TYPEOF(x) == STRSXP && parent.size() == Rf_length(x) ){
-                SEXP y = parent.get__() ;
-                Rf_setAttrib( y, R_NamesSymbol, x ) ;
+                Rf_namesgets(parent, x);
             } else {
                 /* use the slower and more flexible version (callback to R) */
                 SEXP namesSym = Rf_install( "names<-" );
-                Shield<SEXP> new_vec(Rcpp_fast_eval(Rf_lang3(namesSym, parent, x), R_GlobalEnv));
+                Shield<SEXP> call(Rf_lang3(namesSym, parent, x));
+                Shield<SEXP> new_vec(Rcpp_fast_eval(call, R_GlobalEnv));
                 parent.set__(new_vec);
             }
 

inst/include/Rcpp/vector/Matrix.h

@@ -50,7 +50,7 @@ class Matrix : public Vector<RTYPE, StoragePolicy>, public MatrixBase<RTYPE, tru
 
     Matrix() : VECTOR(Dimension(0, 0)), nrows(0) {}
 
-    Matrix(SEXP x) : VECTOR( r_cast<RTYPE>( x ) ), nrows( VECTOR::dims()[0] ) {}
+    Matrix(SEXP x) : VECTOR(x), nrows( VECTOR::dims()[0] ) {}
 
     Matrix( const Dimension& dims) : VECTOR( Rf_allocMatrix( RTYPE, dims[0], dims[1] ) ), nrows(dims[0]) {
         if( dims.size() != 2 ) throw not_a_matrix();

inst/include/Rcpp/vector/Vector.h

@@ -71,12 +71,14 @@ class Vector :
     }
 
     Vector( SEXP x ) {
-        Storage::set__( r_cast<RTYPE>(x) ) ;
+        Rcpp::Shield<SEXP> safe(x);
+        Storage::set__( r_cast<RTYPE>(safe) ) ;
     }
 
     template <typename Proxy>
     Vector( const GenericProxy<Proxy>& proxy ){
-        Storage::set__( r_cast<RTYPE>(proxy.get()) ) ;
+        Rcpp::Shield<SEXP> safe(proxy.get());
+        Storage::set__( r_cast<RTYPE>(safe) ) ;
     }
 
     explicit Vector( const no_init_vector& obj) {
@@ -174,7 +176,8 @@ class Vector :
 
     template <bool NA, typename T>
     Vector( const sugar::SingleLogicalResult<NA,T>& obj ) {
-        Storage::set__( r_cast<RTYPE>( const_cast<sugar::SingleLogicalResult<NA,T>&>(obj).get_sexp() ) ) ;
+        Rcpp::Shield<SEXP> safe(const_cast<sugar::SingleLogicalResult<NA,T>&>(obj).get_sexp() );
+        Storage::set__( r_cast<RTYPE>(safe) ) ;
         RCPP_DEBUG_2( "Vector<%d>( const sugar::SingleLogicalResult<NA,T>& ) [T = %s]", RTYPE, DEMANGLE(T) )
     }