Merge branch 'RMemberListTrialSimplify2019'
* RMemberListTrialSimplify2019: ENH R abstract_access_runme ENH R accessor processing test Removed some remaining commented sections moved registration routine and use swig_name_get calling Swig_name_setget Used Swig_name_register so that Swig_name_wrapper produces the correct name without a separate replace call. Removed last instance of using Strcmp to check for a set/get method. Replaced with check for flag. Alternative version of using memberlist processing. This clarifies the logic within OutputMemberReferenceMethod by filtering the lists into classes, rather than doing it internally. Code isn't any shorter. commenting out unused code first pass at removing string comparisons for set/get methods trial changing member list processing
This commit is contained in:
commit
7648542775
2 changed files with 222 additions and 99 deletions
74
Examples/test-suite/r/abstract_access_runme.R
Normal file
74
Examples/test-suite/r/abstract_access_runme.R
Normal file
|
|
@ -0,0 +1,74 @@
|
|||
clargs <- commandArgs(trailing=TRUE)
|
||||
source(file.path(clargs[1], "unittest.R"))
|
||||
|
||||
dyn.load(paste("abstract_access", .Platform$dynlib.ext, sep=""))
|
||||
source("abstract_access.R")
|
||||
|
||||
dd <- D()
|
||||
unittest(1, dd$z())
|
||||
unittest(1, dd$do_x())
|
||||
|
||||
## Original version allowed dd$z <- 2
|
||||
tryCatch({
|
||||
dd$z <- 2
|
||||
# force an error if the previous line doesn't raise an exception
|
||||
stop("Test Failure A")
|
||||
}, error = function(e) {
|
||||
if (e$message == "Test Failure A") {
|
||||
# Raise the error again to cause a failed test
|
||||
stop(e)
|
||||
}
|
||||
message("Correct - no dollar assignment method found")
|
||||
}
|
||||
)
|
||||
|
||||
tryCatch({
|
||||
dd[["z"]] <- 2
|
||||
# force an error if the previous line doesn't raise an exception
|
||||
stop("Test Failure B")
|
||||
}, error = function(e) {
|
||||
if (e$message == "Test Failure B") {
|
||||
# Raise the error again to cause a failed test
|
||||
stop(e)
|
||||
}
|
||||
message("Correct - no dollar assignment method found")
|
||||
}
|
||||
)
|
||||
|
||||
## The methods are attached to the parent class - see if we can get
|
||||
## them
|
||||
tryCatch({
|
||||
m1 <- getMethod('$', "_p_A")
|
||||
}, error = function(e) {
|
||||
stop("No $ method found - there should be one")
|
||||
}
|
||||
)
|
||||
|
||||
## These methods should not be present
|
||||
## They correspond to the tests that are expected
|
||||
## to fail above.
|
||||
tryCatch({
|
||||
m2 <- getMethod('$<-', "_p_A")
|
||||
# force an error if the previous line doesn't raise an exception
|
||||
stop("Test Failure C")
|
||||
}, error = function(e) {
|
||||
if (e$message == "Test Failure C") {
|
||||
# Raise the error again to cause a failed test
|
||||
stop(e)
|
||||
}
|
||||
message("Correct - no dollar assignment method found")
|
||||
}
|
||||
)
|
||||
|
||||
tryCatch({
|
||||
m3 <- getMethod('[[<-', "_p_A")
|
||||
# force an error if the previous line doesn't raise an exception
|
||||
stop("Test Failure D")
|
||||
}, error = function(e) {
|
||||
if (e$message == "Test Failure D") {
|
||||
# Raise the error again to cause a failed test
|
||||
stop(e)
|
||||
}
|
||||
message("Correct - no list assignment method found")
|
||||
}
|
||||
)
|
||||
Loading…
Add table
Add a link
Reference in a new issue