[Rcpp-commits] r2755 - in pkg/Rcpp: . R inst inst/include/Rcpp inst/unitTests src
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Dec 9 21:42:04 CET 2010
Author: jmc
Date: 2010-12-09 21:42:02 +0100 (Thu, 09 Dec 2010)
New Revision: 2755
Modified:
pkg/Rcpp/ChangeLog
pkg/Rcpp/R/Module.R
pkg/Rcpp/R/zzz.R
pkg/Rcpp/inst/NEWS
pkg/Rcpp/inst/include/Rcpp/exceptions.h
pkg/Rcpp/inst/include/Rcpp/routines.h
pkg/Rcpp/inst/unitTests/runit.Module.R
pkg/Rcpp/src/Module.cpp
pkg/Rcpp/src/Rcpp_init.c
pkg/Rcpp/src/exceptions.cpp
Log:
add dummy_pointer, not_initialized exception, test for same in method invocation
Modified: pkg/Rcpp/ChangeLog
===================================================================
--- pkg/Rcpp/ChangeLog 2010-12-09 13:18:47 UTC (rev 2754)
+++ pkg/Rcpp/ChangeLog 2010-12-09 20:42:02 UTC (rev 2755)
@@ -1,3 +1,9 @@
+2010-12-09 John M Chambers <jmc at r-project.org>
+
+ * Rcpp/src/Module.cpp: Rcpp/src/exceptions.cpp,
+ Rcpp/src/Rcpp_init.c, etc. add a not_initialized exception and a
+ dummy_pointer to identify such objects, throw exc. back to R
+
2010-12-07 Romain Francois <romain at r-enthusiasts.com>
* inst/include/Rcpp/vector/matrix.h: Matrix gains a nested ::Sub typedef
Modified: pkg/Rcpp/R/Module.R
===================================================================
--- pkg/Rcpp/R/Module.R 2010-12-09 13:18:47 UTC (rev 2754)
+++ pkg/Rcpp/R/Module.R 2010-12-09 20:42:02 UTC (rev 2755)
@@ -109,7 +109,10 @@
.External( class__newInstance, module, pointer, ... )
}
+new_dummyObject <- function(...)
+ .External( "class__dummyInstance", ...)
+
# class method for $initialize
cpp_object_initializer <- function(.self, .refClassDef, ...){
selfEnv <- as.environment(.self)
@@ -123,6 +126,18 @@
.self
}
+cpp_object_dummy <- function(.self, .refClassDef) {
+ selfEnv <- as.environment(.self)
+ ## like initializer but a dummy for the case of no default
+ ## constructor. Will throw an error if the object is used.
+ fields <- .refClassDef at fieldPrototypes
+ pointer <- new_dummyObject()
+ assign(".module", fields$.module, envir = selfEnv)
+ assign(".pointer", pointer, envir = selfEnv)
+ assign(".cppclass", fields$.pointer, envir = selfEnv)
+ .self
+}
+
Module <- function( module, PACKAGE = getPackageName(where), where = topenv(parent.frame()), mustStart = FALSE ) {
if(is(module, "Module")) {
xp <- .getModulePointer(module, FALSE)
@@ -196,7 +211,7 @@
else
function(...) {
if(nargs()) Rcpp:::cpp_object_initializer(.self,.refClassDef, ...)
- else .self
+ else Rcpp:::cpp_object_dummy(.self, .refClassDef)
}
)
Modified: pkg/Rcpp/R/zzz.R
===================================================================
--- pkg/Rcpp/R/zzz.R 2010-12-09 13:18:47 UTC (rev 2754)
+++ pkg/Rcpp/R/zzz.R 2010-12-09 20:42:02 UTC (rev 2755)
@@ -15,6 +15,8 @@
# You should have received a copy of the GNU General Public License
# along with Rcpp. If not, see <http://www.gnu.org/licenses/>.
+.dummyInstancePointer <- new.env() # just something permanent
+
.onLoad <- function(libname, pkgname){
.Call("init_Rcpp_cache", PACKAGE = "Rcpp" )
minimum_svn_rev <- packageDescription( pkgname )[["MinimumSvnRev"]]
@@ -23,5 +25,6 @@
# "for full use of reference methods"),
# R.version[["svn rev"]], minimum_svn_rev))
# }
+ new_dummyObject(.dummyInstancePointer);
}
Modified: pkg/Rcpp/inst/NEWS
===================================================================
--- pkg/Rcpp/inst/NEWS 2010-12-09 13:18:47 UTC (rev 2754)
+++ pkg/Rcpp/inst/NEWS 2010-12-09 20:42:02 UTC (rev 2755)
@@ -5,6 +5,8 @@
o Date::getYear() corrected (where addition of 1900 was not called for)
+ o An Rcpp::not_initialized exception was added and forwarded to R if such an object is used.
+
0.8.9 2010-11-27
o Many improvements were made to in 'Rcpp modules':
Modified: pkg/Rcpp/inst/include/Rcpp/exceptions.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/exceptions.h 2010-12-09 13:18:47 UTC (rev 2754)
+++ pkg/Rcpp/inst/include/Rcpp/exceptions.h 2010-12-09 20:42:02 UTC (rev 2755)
@@ -74,6 +74,7 @@
RCPP_SIMPLE_EXCEPTION_CLASS(parse_error, "parse error")
RCPP_SIMPLE_EXCEPTION_CLASS(not_s4, "not an S4 object")
RCPP_SIMPLE_EXCEPTION_CLASS(not_reference, "not an S4 object of a reference class")
+RCPP_SIMPLE_EXCEPTION_CLASS(not_initialized, "C++ object not initialized (missing default constructor?)")
RCPP_SIMPLE_EXCEPTION_CLASS(no_such_slot, "no such slot")
RCPP_SIMPLE_EXCEPTION_CLASS(no_such_field, "no such field")
RCPP_SIMPLE_EXCEPTION_CLASS(not_a_closure, "not a closure")
Modified: pkg/Rcpp/inst/include/Rcpp/routines.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/routines.h 2010-12-09 13:18:47 UTC (rev 2754)
+++ pkg/Rcpp/inst/include/Rcpp/routines.h 2010-12-09 20:42:02 UTC (rev 2755)
@@ -75,6 +75,7 @@
EXTFUN(InternalFunction_invoke) ;
EXTFUN(Module__invoke) ;
EXTFUN(class__newInstance) ;
+EXTFUN(class__dummyInstance) ;
#ifdef __cplusplus
}
Modified: pkg/Rcpp/inst/unitTests/runit.Module.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.Module.R 2010-12-09 13:18:47 UTC (rev 2754)
+++ pkg/Rcpp/inst/unitTests/runit.Module.R 2010-12-09 20:42:02 UTC (rev 2755)
@@ -196,4 +196,48 @@
checkException( { w$y <- 3 } )
}
+test.Module.Constructor <- function() {
+ inc <- '
+
+class Randomizer {
+public:
+
+ // Randomizer() : min(0), max(1){}
+ Randomizer( double min_, double max_) : min(min_), max(max_){}
+
+ NumericVector get( int n ){
+ RNGScope scope ;
+ return runif( n, min, max );
+ }
+
+private:
+ double min, max ;
+} ;
+
+RCPP_MODULE(mod){
+
+ class_<Randomizer>( "Randomizer" )
+
+ // No default: .default_constructor()
+ .constructor<double,double>()
+
+ .method( "get" , &Randomizer::get ) ;
+
}
+'
+ fx <- cxxfunction( , '', includes = inc, plugin = "Rcpp" )
+
+ mod <- Module( "mod", getDynLib( fx ) )
+
+ Randomizer <- mod$Randomizer
+ r <- new( Randomizer, 10.0, 20.0 )
+ set.seed(123)
+ x10 <- runif(10, 10.0, 20.0)
+ set.seed(123)
+ checkEquals(r$get(10), x10)
+
+ r <- new( Randomizer )
+ stopifnot(is(tryCatch(r$get(10), error = function(e)e), "error"))
+}
+
+}
Modified: pkg/Rcpp/src/Module.cpp
===================================================================
--- pkg/Rcpp/src/Module.cpp 2010-12-09 13:18:47 UTC (rev 2754)
+++ pkg/Rcpp/src/Module.cpp 2010-12-09 20:42:02 UTC (rev 2755)
@@ -157,6 +157,24 @@
return clazz->newInstance(cargs, nargs ) ;
}
+SEXP rcpp_dummy_pointer = R_NilValue; // relies on being set in .onLoad()
+
+#define CHECK_DUMMY_OBJ(p) if(p == rcpp_dummy_pointer) forward_exception_to_r ( Rcpp::not_initialized())
+
+
+
+extern "C" SEXP class__dummyInstance(SEXP args) {
+ SEXP p;
+
+ if(args == R_NilValue)
+ return rcpp_dummy_pointer;
+ p = CDR(args);
+
+ if(p != R_NilValue)
+ rcpp_dummy_pointer = CAR(p);
+ return rcpp_dummy_pointer;
+}
+
extern "C" SEXP CppMethod__invoke(SEXP args){
SEXP p = CDR(args) ;
@@ -168,6 +186,7 @@
// the external pointer to the object
SEXP obj = CAR(p); p = CDR(p) ;
+ CHECK_DUMMY_OBJ(obj);
// additional arguments, processed the same way as .Call does
SEXP cargs[MAX_ARGS] ;
@@ -192,6 +211,7 @@
// the external pointer to the object
SEXP obj = CAR(p); p = CDR(p) ;
+ CHECK_DUMMY_OBJ(obj);
// additional arguments, processed the same way as .Call does
SEXP cargs[MAX_ARGS] ;
@@ -216,6 +236,7 @@
// the external pointer to the object
SEXP obj = CAR(p); p = CDR(p) ;
+ CHECK_DUMMY_OBJ(obj);
// additional arguments, processed the same way as .Call does
SEXP cargs[MAX_ARGS] ;
Modified: pkg/Rcpp/src/Rcpp_init.c
===================================================================
--- pkg/Rcpp/src/Rcpp_init.c 2010-12-09 13:18:47 UTC (rev 2754)
+++ pkg/Rcpp/src/Rcpp_init.c 2010-12-09 20:42:02 UTC (rev 2755)
@@ -77,6 +77,7 @@
EXTDEF(InternalFunction_invoke),
EXTDEF(Module__invoke),
EXTDEF(class__newInstance),
+ EXTDEF(class__dummyInstance),
{NULL, NULL, 0}
} ;
Modified: pkg/Rcpp/src/exceptions.cpp
===================================================================
--- pkg/Rcpp/src/exceptions.cpp 2010-12-09 13:18:47 UTC (rev 2754)
+++ pkg/Rcpp/src/exceptions.cpp 2010-12-09 20:42:02 UTC (rev 2755)
@@ -51,6 +51,7 @@
RCPP_SIMPLE_EXCEPTION_WHAT(parse_error, "parse error")
RCPP_SIMPLE_EXCEPTION_WHAT(not_s4, "not an S4 object" )
RCPP_SIMPLE_EXCEPTION_WHAT(not_reference, "not a reference S4 object" )
+RCPP_SIMPLE_EXCEPTION_WHAT(not_initialized, "C++ object not initialized" )
RCPP_SIMPLE_EXCEPTION_WHAT(no_such_slot, "no such slot" )
RCPP_SIMPLE_EXCEPTION_WHAT(no_such_field, "no such field" )
RCPP_SIMPLE_EXCEPTION_WHAT(not_a_closure, "not a closure" )
More information about the Rcpp-commits
mailing list