[Rcpp-commits] r657 - pkg/src/Rcpp

[noreply at r-forge.r-project.org]

Author: romain
Date: 2010-02-10 11:47:17 +0100 (Wed, 10 Feb 2010)
New Revision: 657

Modified:
   pkg/src/Rcpp/SEXP_Vector.h
Log:
deal with case of original object not having names but pushing a Named object

Modified: pkg/src/Rcpp/SEXP_Vector.h
===================================================================
--- pkg/src/Rcpp/SEXP_Vector.h	2010-02-10 10:42:55 UTC (rev 656)
+++ pkg/src/Rcpp/SEXP_Vector.h	2010-02-10 10:47:17 UTC (rev 657)
@@ -218,6 +218,11 @@
 				SET_STRING_ELT(x_names, i, Rf_mkChar(name.c_str()) ) ;
 				Rf_setAttrib( x, Rf_install("names"), x_names );
 				UNPROTECT(1) ; /* x_names */
+			} else if(named){
+				SEXP x_names = PROTECT( Rf_allocVector( STRSXP, n+1) );
+				SET_STRING_ELT(x_names, n, Rf_mkChar(name.c_str()) ) ;
+				Rf_setAttrib( x, Rf_install("names"), x_names );
+				UNPROTECT(1) ; /* x_names */
 			}
 			setSEXP( x ); 
 			UNPROTECT(1) ; /* x */
@@ -246,6 +251,11 @@
 				SET_STRING_ELT(x_names, 0, Rf_mkChar(name.c_str()) ) ;
 				Rf_setAttrib( x, Rf_install("names"), x_names );
 				UNPROTECT(1) ; /* x_names */
+			} else if(named){
+				SEXP x_names = PROTECT( Rf_allocVector( STRSXP, n+1) );
+				SET_STRING_ELT(x_names, 0, Rf_mkChar(name.c_str()) ) ;
+				Rf_setAttrib( x, Rf_install("names"), x_names );
+				UNPROTECT(1) ; /* x_names */
 			}
 			setSEXP( x ); 
 			UNPROTECT(1) ; /* x */