Rf_xlength and a simple testing case

Author: Qiang Kou

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

@@ -27,7 +27,7 @@ namespace internal{
 
     template <typename InputIterator, typename value_type>
     void export_range__dispatch( SEXP x, InputIterator first, ::Rcpp::traits::r_type_generic_tag ) {
-        R_xlen_t n = ::Rf_length(x) ;
+        R_xlen_t n = ::Rf_xlength(x) ;
         for( R_xlen_t i=0; i<n; i++, ++first ){
             *first = ::Rcpp::as<value_type>( VECTOR_ELT(x, i) ) ;
         }
@@ -49,9 +49,9 @@ namespace internal{
             Container get(){
                 if( TYPEOF(object) == RTYPE ){
                    T* start = Rcpp::internal::r_vector_start<RTYPE>(object) ;
-                   return Container( start, start + Rf_length(object) ) ;
+                   return Container( start, start + Rf_xlength(object) ) ;
                 }
-                Container vec( ::Rf_length(object) );
+                Container vec( ::Rf_xlength(object) );
                 ::Rcpp::internal::export_range( object, vec.begin() ) ;
                 return vec ;
             }

inst/include/Rcpp/internal/export.h

@@ -52,7 +52,7 @@ namespace Rcpp{
 			typedef typename ::Rcpp::traits::storage_type<RTYPE>::type STORAGE ;
 			Shield<SEXP> y( ::Rcpp::r_cast<RTYPE>(x) ) ;
 			STORAGE* start = ::Rcpp::internal::r_vector_start<RTYPE>(y) ;
-			std::copy( start, start + ::Rf_length(y), first ) ;
+			std::copy( start, start + ::Rf_xlength(y), first ) ;
 		}
 
 		template <typename InputIterator, typename value_type>
@@ -61,7 +61,7 @@ namespace Rcpp{
 			typedef typename ::Rcpp::traits::storage_type<RTYPE>::type STORAGE ;
 			Shield<SEXP> y( ::Rcpp::r_cast<RTYPE>(x) ) ;
 			STORAGE* start = ::Rcpp::internal::r_vector_start<RTYPE>(y) ;
-			std::transform( start, start + ::Rf_length(y) , first, caster<STORAGE,value_type> ) ;
+			std::transform( start, start + ::Rf_xlength(y) , first, caster<STORAGE,value_type> ) ;
         }
 
         // implemented in meat
@@ -80,7 +80,7 @@ namespace Rcpp{
 		template <typename InputIterator, typename value_type>
 		void export_range__dispatch( SEXP x, InputIterator first, ::Rcpp::traits::r_type_string_tag ) {
 			if( ! ::Rf_isString( x) ) throw ::Rcpp::not_compatible( "expecting a string vector" ) ;
-			R_xlen_t n = ::Rf_length(x) ;
+			R_xlen_t n = ::Rf_xlength(x) ;
 			for( R_xlen_t i=0; i<n; i++, ++first ){
 				*first = as_string_elt<typename std::iterator_traits<InputIterator>::value_type> ( x, i ) ;
 			}
@@ -104,7 +104,7 @@ namespace Rcpp{
 			typedef typename ::Rcpp::traits::storage_type<RTYPE>::type STORAGE ;
 			Shield<SEXP> y( ::Rcpp::r_cast<RTYPE>(x) ) ;
 			STORAGE* start = ::Rcpp::internal::r_vector_start<RTYPE>(y) ;
-			R_xlen_t size = ::Rf_length(y)  ;
+			R_xlen_t size = ::Rf_xlength(y)  ;
 			for( R_xlen_t i=0; i<size; i++){
 				res[i] =  start[i] ;
 			}
@@ -116,7 +116,7 @@ namespace Rcpp{
 			typedef typename ::Rcpp::traits::storage_type<RTYPE>::type STORAGE ;
 			Shield<SEXP> y( ::Rcpp::r_cast<RTYPE>(x) );
 			STORAGE* start = ::Rcpp::internal::r_vector_start<RTYPE>(y) ;
-			R_xlen_t size = ::Rf_length(y)  ;
+			R_xlen_t size = ::Rf_xlength(y)  ;
 			for( R_xlen_t i=0; i<size; i++){
 				res[i] = caster<STORAGE,value_type>(start[i]) ;
 			}
@@ -134,7 +134,7 @@ namespace Rcpp{
 		template <typename T, typename value_type>
 		void export_indexing__dispatch( SEXP x, T& res, ::Rcpp::traits::r_type_string_tag ) {
 			if( ! ::Rf_isString( x) ) throw Rcpp::not_compatible( "expecting a string vector" ) ;
-			R_xlen_t n = ::Rf_length(x) ;
+			R_xlen_t n = ::Rf_xlength(x) ;
 			for( R_xlen_t i=0; i<n; i++ ){
 				res[i] = as_string_elt< value_type >( x, i) ;
 			}

inst/include/Rcpp/internal/r_vector.h

@@ -61,7 +61,7 @@ inline Rcomplex get_zero<CPLXSXP,Rcomplex>(){
 template<int RTYPE> void r_init_vector(SEXP x){
 	typedef typename ::Rcpp::traits::storage_type<RTYPE>::type CTYPE ;
 	CTYPE* start=r_vector_start<RTYPE>(x) ;
-	std::fill( start, start + Rf_length(x), get_zero<RTYPE,CTYPE>() ) ;
+	std::fill( start, start + Rf_xlength(x), get_zero<RTYPE,CTYPE>() ) ;
 }
 /**
  * Initializes a generic vector (VECSXP). Does nothing since

inst/include/Rcpp/vector/Vector.h

@@ -259,17 +259,17 @@ class Vector :
     #endif
 
     /**
-     * the length of the vector, uses Rf_length
+     * the length of the vector, uses Rf_xlength
      */
     inline R_xlen_t length() const {
-        return ::Rf_length( Storage::get__() ) ;
+        return ::Rf_xlength( Storage::get__() ) ;
     }
 
     /**
      * alias of length
      */
     inline R_xlen_t size() const {
-        return ::Rf_length( Storage::get__() ) ;
+        return ::Rf_xlength( Storage::get__() ) ;
     }
 
     /**
@@ -291,7 +291,7 @@ class Vector :
      * it is valid
      */
     size_t offset(const size_t& i) const {
-        if( static_cast<R_xlen_t>(i) >= ::Rf_length(Storage::get__()) ) throw index_out_of_bounds() ;
+        if( static_cast<R_xlen_t>(i) >= ::Rf_xlength(Storage::get__()) ) throw index_out_of_bounds() ;
         return i ;
     }
 
@@ -549,7 +549,7 @@ class Vector :
     bool containsElementNamed( const char* target ) const {
           SEXP names = RCPP_GET_NAMES(Storage::get__()) ;
         if( Rf_isNull(names) ) return false ;
-        R_xlen_t n = Rf_length(names) ;
+        R_xlen_t n = Rf_xlength(names) ;
         for( R_xlen_t i=0; i<n; i++){
             if( !strcmp( target, CHAR(STRING_ELT(names, i)) ) )
                 return true ;
@@ -560,7 +560,7 @@ class Vector :
     int findName(const std::string& name) const {
         SEXP names = RCPP_GET_NAMES(Storage::get__());
         if (Rf_isNull(names)) stop("'names' attribute is null");
-        R_xlen_t n = Rf_length(names);
+        R_xlen_t n = Rf_xlength(names);
         for (R_xlen_t i=0; i < n; ++i) {
             if (strcmp(name.c_str(), CHAR(STRING_ELT(names, i))) == 0) {
                 return i;

inst/unitTests/cpp/Vector.cpp

@@ -19,6 +19,7 @@
 // You should have received a copy of the GNU General Public License
 // along with Rcpp.  If not, see <http://www.gnu.org/licenses/>.
 
+#include <climits>
 #include <Rcpp.h>
 using namespace Rcpp ;
 
@@ -646,6 +647,13 @@ IntegerVector IntegerVector_int_init(){
     return x ;
 }
 
+// [[Rcpp::export]]
+R_xlen_t Long_IntegerVector_length(){
+	R_xlen_t l = INT_MAX + 100L;
+    IntegerVector x(l,4) ;
+    return x.size() ;
+}
+
 // [[Rcpp::export]]
 bool containsElementNamed( List l, CharacterVector n){
     return l.containsElementNamed(n[0]);

inst/unitTests/runit.Vector.R

@@ -567,6 +567,11 @@ if (.runThisTest) {
         checkEquals( fun(), c(4L,4L), msg = "IntegerVector int init regression test" )
     }
 
+    test.Long_IntegerVector_length <- function(){
+        fun <-  Long_IntegerVector_length
+        checkTrue( fun() > 0, msg = "Long IntegerVector length test" )
+    }
+
     test.containsElementNamed <- function() {
         fun <- containsElementNamed