Merge pull request #1012 from RcppCore/bugfix/xptr_ctor

small updates incl hide away parts of #1003 if C++11 not available

Author: eddelbuettel

ChangeLog

@@ -1,5 +1,14 @@
 2019-11-06  Dirk Eddelbuettel  <[email protected]>
 
+	* DESCRIPTION (Version, Date): Roll minor version
+	
+	* inst/include/Rcpp/XPtr.h: Provided fallback for old constructor
+	when C++11 is not available (follow-up to #1003)
+	* inst/unitTests/runit.XPTr.R (test.XPtr): On Windows (as a proxy for
+	old compilers) do not test new feature
+
+	* tests/doRUnit.R: Protect printing to /tmp from Windows use
+
 	* vignettes/rmd/Rcpp.bib: Updated
 	* inst/bib/Rcpp.bib: Idem
 

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: Rcpp
 Title: Seamless R and C++ Integration
-Version: 1.0.2.5
-Date: 2019-11-02
+Version: 1.0.2.6
+Date: 2019-11-06
 Author: Dirk Eddelbuettel, Romain Francois, JJ Allaire, Kevin Ushey, Qiang Kou,
  Nathan Russell, Douglas Bates and John Chambers
 Maintainer: Dirk Eddelbuettel <[email protected]>

inst/NEWS.Rd

@@ -14,7 +14,7 @@
       \item \code{XPtr} tags are now preserved in \code{as<>} (Stephen Wade
       in \ghpr{1003} fixing \ghit{986})
       \item A few more temporary allocations are now protected from garbage
-      collection (Romain Francois in \ghpr{1010}).
+      collection (Romain Francois in \ghpr{1010}, and Dirk in \ghpr{1011}).
     }
     \item Changes in Rcpp Modules:
     \itemize{
@@ -36,6 +36,8 @@
       have been added to README.md (Dirk).
       \item Vignettes are now included pre-made (Dirk in \ghpr{1005}
       addressing \ghit{1004})).
+      \item The Rcpp FAQ has two new entries on 'no modules / no rtti' and
+      exceptions across shared libraries (Dirk in \ghpr{1009}).
     }
   }
 }

inst/include/Rcpp/XPtr.h

@@ -58,6 +58,8 @@ class XPtr :
 
     typedef StoragePolicy<XPtr> Storage;
 
+#if defined(RCPP_USING_CXX11)
+
     /**
      * constructs a XPtr wrapping the external pointer (EXTPTRSXP SEXP)
      *
@@ -75,14 +77,34 @@ class XPtr :
      * constructs a XPtr wrapping the external pointer (EXTPTRSXP SEXP)
      *
      * @param xp external pointer to wrap
-     * @param tag tag to assign to external pointer 
+     * @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);
     };
 
+#else
+
+    /**
+     * constructs a XPtr wrapping the external pointer (EXTPTRSXP SEXP)
+     *
+     * @param xp external pointer to wrap
+     */
+    explicit XPtr(SEXP x, SEXP tag = R_NilValue, SEXP prot = R_NilValue) {
+        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);
+        R_SetExternalPtrTag( x, tag);
+        R_SetExternalPtrProtected(x, prot);
+    };
+
+#endif
+
     /**
      * creates a new external pointer wrapping the dumb pointer p.
      *

inst/unitTests/runit.XPTr.R

@@ -20,19 +20,23 @@
 
 .runThisTest <- Sys.getenv("RunAllRcppTests") == "yes"
 
+isWindows <- Sys.info()[["sysname"]] == "Windows"
+
 if (.runThisTest) {
 
     .setUp <- Rcpp:::unitTestSetup("XPtr.cpp")
-    
+
     test.XPtr <- function(){
         xp <- xptr_1()
         checkEquals(typeof( xp ), "externalptr", msg = "checking external pointer creation" )
-        
+
         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")
+        if (!isWindows) {
+            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")
 

tests/doRUnit.R

@@ -60,10 +60,11 @@ if (requireNamespace("RUnit", quietly=TRUE) &&
             Sys.setenv("RunAllRcppTests"="yes")
     }
 
-    tests <- runTestSuite(testSuite)	# Run tests
+    tests <- runTestSuite(testSuite)		# Run tests
 
     printTextProtocol(tests)			# Print results
-    printTextProtocol(tests, file="/tmp/RcppTestLog.txt")
+    if (Sys.info()[["sysname"]] != "Windows")
+        printTextProtocol(tests, file="/tmp/RcppTestLog.txt")
 
     ## Return success or failure to R CMD CHECK
     if (getErrors(tests)$nFail > 0) stop("TEST FAILED!")