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:
William S Fulton 2020-01-30 07:29:45 +00:00
commit 7648542775
2 changed files with 222 additions and 99 deletions

View 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")
}
)