Merge pull request #368 from RcppCore/feature/nullable_issue363

Nullable object (closes #363)

Author: eddelbuettel

inst/include/Rcpp.h

@@ -64,6 +64,8 @@
 #include <Rcpp/Module.h>
 #include <Rcpp/InternalFunction.h>
 
+#include <Rcpp/Nullable.h>
+
 #ifndef RCPP_NO_SUGAR
 #include <Rcpp/sugar/sugar.h>
 #include <Rcpp/stats/stats.h>

inst/include/Rcpp/Nullable.h

@@ -0,0 +1,145 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; indent-tabs-mode: nil; -*-
+//
+// Nullable.h: Rcpp R/C++ interface class library -- SEXP container which can be NULL
+//
+// Copyright (C) 2015         Dirk Eddelbuettel and Daniel C. Dillon
+//
+// This file is part of Rcpp.
+//
+// Rcpp is free software: you can redistribute it and/or modify it
+// under the terms of the GNU General Public License as published by
+// the Free Software Foundation, either version 2 of the License, or
+// (at your option) any later version.
+//
+// Rcpp is distributed in the hope that it will be useful, but
+// WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+// GNU General Public License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with Rcpp.  If not, see <http://www.gnu.org/licenses/>.
+
+#ifndef Rcpp_Nullable_h
+#define Rcpp_Nullable_h
+
+// This class could possibly be written in a templated manner too, and we looked
+// into this.  However, as an exception is thrown as soon as an actual proxy
+// object is accessed _when it was initialized with NULL_ we found no
+// satisfactory solution.
+//
+// We looked into the safe_bool_idiom [1] but found that more trouble than is
+// warranted here.  We first and foremost want an operator SEXP() which got in
+// the way of redefining operator bool.
+// [1] http://www.artima.com/cppsource/safebool.html)
+
+namespace Rcpp {
+
+    template<class T>
+    class Nullable {
+    private:
+        template<class U>
+        friend class InputParameter;
+
+        template<class U>
+        friend class traits::Exporter;
+
+    public:
+
+        /**
+         * Empty no-argument constructor of a Nullable object
+         *
+         * Assigns (R's) NULL value, and sets validator to FALSE
+         */
+        inline Nullable() : m_sexp(R_NilValue), m_set(false) {}
+
+        /**
+         * Template constructor of a Nullable object
+         *
+         * Assigns object, and set validator to TRUE
+         */
+
+        inline Nullable(const T &t) : m_sexp(t),  m_set(true) {}
+
+    protected:
+
+        /**
+         * Standard constructor of a Nullable object
+         *
+         * @param SEXP is stored
+         */
+        inline Nullable(SEXP t) {
+            m_sexp = t;
+            m_set = true;
+        }
+
+    public:
+
+        /**
+         * Copy constructor for Nullable object
+         *
+         * @param SEXP is used to update internal copy
+         */
+        inline Nullable &operator=(SEXP sexp) {
+            m_sexp = sexp;
+            m_set = true;
+            return *this;
+        }
+
+        /**
+         * operator SEXP() to return nullable object
+         *
+         * @throw 'not initialized' if object has not been set
+         */
+        inline operator SEXP() {
+            checkIfSet();
+            return m_sexp;
+        }
+
+        /**
+         * get() accessor for object
+         *
+         * @throw 'not initialized' if object has not been set
+         */
+        inline SEXP get() {
+            checkIfSet();
+            return m_sexp;
+        }
+
+        /**
+         * Boolean test for NULL
+         *
+         * @throw 'not initialized' if object has not been set
+         */
+        inline bool isNull() const {
+            checkIfSet();
+            return Rf_isNull(m_sexp);
+        }
+
+        /**
+         * Boolean test for not NULL
+         *
+         * @throw 'not initialized' if object has not been set
+         */
+        inline bool isNotNull() const {
+            return ! isNull();
+        }
+
+        /**
+         * Test function to check if object has been initialized
+         *
+         */
+        inline bool isSet(void) const { return m_set; }
+
+    private:
+        SEXP m_sexp;
+        bool m_set;
+
+        inline void checkIfSet(void) const {
+            if (!m_set) {
+                throw ::Rcpp::exception("Not initialized");
+            }
+        }
+    };
+}
+
+#endif

inst/unitTests/cpp/misc.cpp

@@ -1,8 +1,8 @@
-// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; indent-tabs-mode: nil; -*-
 //
 // misc.cpp: Rcpp R/C++ interface class library -- misc unit tests
 //
-// Copyright (C) 2013    Dirk Eddelbuettel and Romain Francois
+// Copyright (C) 2013 - 2015  Dirk Eddelbuettel and Romain Francois
 //
 // This file is part of Rcpp.
 //
@@ -20,7 +20,7 @@
 // along with Rcpp.  If not, see <http://www.gnu.org/licenses/>.
 
 #include <Rcpp.h>
-using namespace Rcpp ;
+using namespace Rcpp;
 using namespace std;
 #include <iostream>
 #include <fstream>
@@ -34,47 +34,47 @@ class simple {
 };
 
 // [[Rcpp::export]]
-SEXP symbol_(){
+SEXP symbol_() {
     return LogicalVector::create(
         Symbol( Rf_install("foobar") ) == Rf_install("foobar"),
         Symbol( Rf_mkChar("foobar") ) == Rf_install("foobar"),
         Symbol( Rf_mkString("foobar") ) == Rf_install("foobar"),
         Symbol( "foobar" ) == Rf_install("foobar")
-    ) ;
+    );
 }
 
 // [[Rcpp::export]]
-Symbol symbol_ctor(SEXP x){ return Symbol(x); }
+Symbol symbol_ctor(SEXP x) { return Symbol(x); }
 
 // [[Rcpp::export]]
-List Argument_(){
+List Argument_() {
     Argument x("x"), y("y");
     return List::create( x = 2, y = 3 );
 }
 
 // [[Rcpp::export]]
-int Dimension_const( SEXP ia ){
+int Dimension_const( SEXP ia ) {
     simple ss(ia);
-	return ss.nrow();
+        return ss.nrow();
 }
 
 // [[Rcpp::export]]
-SEXP evaluator_error(){
-    return Rcpp_eval( Rf_lang2( Rf_install("stop"), Rf_mkString( "boom" ) ) ) ;
+SEXP evaluator_error() {
+    return Rcpp_eval( Rf_lang2( Rf_install("stop"), Rf_mkString( "boom" ) ) );
 }
 
 // [[Rcpp::export]]
-SEXP evaluator_ok(SEXP x){
-    return Rcpp_eval( Rf_lang2( Rf_install("sample"), x ) ) ;
+SEXP evaluator_ok(SEXP x) {
+    return Rcpp_eval( Rf_lang2( Rf_install("sample"), x ) );
 }
 
 // [[Rcpp::export]]
-void exceptions_(){
-    throw std::range_error("boom") ;
+void exceptions_() {
+    throw std::range_error("boom");
 }
 
 // [[Rcpp::export]]
-LogicalVector has_iterator_( ){
+LogicalVector has_iterator_( ) {
     return LogicalVector::create(
         (bool)Rcpp::traits::has_iterator< std::vector<int> >::value,
         (bool)Rcpp::traits::has_iterator< std::list<int> >::value,
@@ -87,7 +87,7 @@ LogicalVector has_iterator_( ){
 }
 
 // [[Rcpp::export]]
-void test_rcout(std::string tfile, std::string teststring){
+void test_rcout(std::string tfile, std::string teststring) {
     // define and open testfile
     std::ofstream testfile(tfile.c_str());
 
@@ -108,8 +108,8 @@ void test_rcout(std::string tfile, std::string teststring){
 }
 
 // [[Rcpp::export]]
-LogicalVector na_proxy(){
-    CharacterVector s("foo") ;
+LogicalVector na_proxy() {
+    CharacterVector s("foo");
     return LogicalVector::create(
         NA_REAL    == NA,
         NA_INTEGER == NA,
@@ -130,29 +130,49 @@ LogicalVector na_proxy(){
         NA         == 12   ,
         NA         == "foo",
         NA         == s[0]
-        ) ;
+        );
 }
 
 // [[Rcpp::export]]
-StretchyList stretchy_list(){
-    StretchyList out ;
-    out.push_back( 1 ) ;
-    out.push_front( "foo" ) ;
-    out.push_back( 3.2 ) ;
+StretchyList stretchy_list() {
+    StretchyList out;
+    out.push_back( 1 );
+    out.push_front( "foo" );
+    out.push_back( 3.2 );
     return out;
 }
 
 // [[Rcpp::export]]
-StretchyList named_stretchy_list(){
-    StretchyList out ;
-    out.push_back( _["b"] = 1 ) ;
-    out.push_front( _["a"] = "foo" ) ;
-    out.push_back( _["c"] = 3.2 ) ;
+StretchyList named_stretchy_list() {
+    StretchyList out;
+    out.push_back( _["b"] = 1 );
+    out.push_front( _["a"] = "foo" );
+    out.push_back( _["c"] = 3.2 );
     return out;
 }
 
 // [[Rcpp::export]]
-void test_stop_variadic(){
-    stop( "%s %d", "foo", 3 ) ;    
+void test_stop_variadic() {
+    stop( "%s %d", "foo", 3 );
+}
+
+// [[Rcpp::export]]
+bool testNullableForNull(Nullable<NumericMatrix> M) {
+    return M.isNull();
+}
+
+// [[Rcpp::export]]
+bool testNullableForNotNull(Nullable<NumericMatrix> M) {
+    return M.isNotNull();
+}
+
+// [[Rcpp::export]]
+SEXP testNullableOperator(Nullable<NumericMatrix> M) {
+    return M;
+}
+
+// [[Rcpp::export]]
+SEXP testNullableGet(Nullable<NumericMatrix> M) {
+    return M.get();
 }
 

inst/unitTests/runit.misc.R

@@ -1,6 +1,6 @@
 #!/usr/bin/r -t
 #
-# Copyright (C) 2010 - 2014  Dirk Eddelbuettel and Romain Francois
+# Copyright (C) 2010 - 2015  Dirk Eddelbuettel and Romain Francois
 #
 # This file is part of Rcpp.
 #
@@ -147,4 +147,25 @@ if (.runThisTest) {
         checkEquals( m, "foo 3" ) 
     }
 
+    test.NullableForNull <- function() {
+        M <- matrix(1:4, 2, 2)
+        checkTrue(   testNullableForNull(NULL) )
+        checkTrue( ! testNullableForNull(M) )
+    }
+    
+    test.NullableForNotNull <- function() {
+        M <- matrix(1:4, 2, 2)
+        checkTrue( ! testNullableForNotNull(NULL) )
+        checkTrue(   testNullableForNotNull(M) )
+    }
+
+    test.NullableAccessOperator <- function() {
+        M <- matrix(1:4, 2, 2)
+        checkEquals( testNullableOperator(M), M )
+    }
+    
+    test.NullableAccessGet <- function() {
+        M <- matrix(1:4, 2, 2)
+        checkEquals( testNullableGet(M), M )
+    }
 }