Merge pull request #1003 from stephematician/master

fix #968 with a single argument XPtr constructor

Author: eddelbuettel

ChangeLog

@@ -1,3 +1,10 @@
+2019-10-19  Stephen Wade  <stephematician@gmail.com>
+
+	* inst/include/Rcpp/XPtr.h: XPtr constructor split up, a single
+	argument does not modify tags and protected data of the external pointer
+	* inst/unitTests/cpp/Xptr.cpp: Added test
+	* inst/unitTests/runit.XPtr.R: Idem
+
 2019-10-14  Dirk Eddelbuettel  <edd@debian.org>
 
 	* README.md: Added CRAN + BioConductor badges for reverse depends,

inst/include/Rcpp/XPtr.h

@@ -63,13 +63,22 @@ class XPtr :
      *
      * @param xp external pointer to wrap
      */
-    explicit XPtr(SEXP x, SEXP tag = R_NilValue, SEXP prot = R_NilValue) {
+    explicit XPtr(SEXP x) {
         if (TYPEOF(x) != EXTPTRSXP) {
             const char* fmt = "Expecting an external pointer: [type=%s].";
             throw ::Rcpp::not_compatible(fmt, Rf_type2char(TYPEOF(x)));
         }
-
         Storage::set__(x);
+    };
+
+    /**
+     * constructs a XPtr wrapping the external pointer (EXTPTRSXP SEXP)
+     *
+     * @param xp external pointer to wrap
+     * @param tag tag to assign to external pointer 
+     * @param prot protected data to assign to external pointer
+     */
+    explicit XPtr(SEXP x, SEXP tag, SEXP prot) : XPtr(x) {
         R_SetExternalPtrTag( x, tag);
         R_SetExternalPtrProtected(x, prot);
     };

inst/unitTests/cpp/XPtr.cpp

@@ -46,6 +46,17 @@ int xptr_2( XPtr< std::vector<int> > p){
     		return p->front() ;
 }
 
+// [[Rcpp::export]]
+void xptr_self_tag( XPtr< std::vector<int> > p ){
+    XPtr< std::vector<int> > self_tag(wrap(p), wrap(p), R_NilValue) ;
+}
+
+// [[Rcpp::export]]
+bool xptr_has_self_tag( XPtr< std::vector<int> > p ){
+    return wrap(p) == R_ExternalPtrTag(p);
+}
+
+
 // [[Rcpp::export]]
 bool xptr_release( XPtr< std::vector<int> > p) {
     p.release();

inst/unitTests/runit.XPTr.R

@@ -31,6 +31,9 @@ if (.runThisTest) {
         front <- xptr_2(xp)
         checkEquals( front, 1L, msg = "check usage of external pointer" )
 
+        xptr_self_tag(xp)
+        checkEquals(xptr_has_self_tag(xp), T, msg = "check external pointer tag preserved")
+
         checkTrue(xptr_release(xp), msg = "check release of external pointer")
 
         checkTrue(xptr_access_released(xp), msg = "check access of released external pointer")