"Fossies" - the Fresh Open Source Software Archive

Member "swig-4.1.1/Examples/test-suite/r/abstract_access_runme.R" (30 Nov 2022, 1887 Bytes) of package /linux/misc/swig-4.1.1.tar.gz:

As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) R source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. 
    1 clargs <- commandArgs(trailing=TRUE)
    2 source(file.path(clargs[1], "unittest.R"))
    3 
    4 dyn.load(paste("abstract_access", .Platform$dynlib.ext, sep=""))
    5 source("abstract_access.R")
    6 
    7 dd <- D()
    8 unittest(1, dd$z())
    9 unittest(1, dd$do_x())
   10 
   11 ## Original version allowed dd$z <- 2
   12 tryCatch({
   13     dd$z <- 2
   14     # force an error if the previous line doesn't raise an exception
   15     stop("Test Failure A")
   16 }, error = function(e) {
   17     if (e$message == "Test Failure A") {
   18       # Raise the error again to cause a failed test
   19       stop(e)
   20     }
   21     message("Correct - no dollar assignment method found")
   22 }
   23 )
   24 
   25 tryCatch({
   26     dd[["z"]] <- 2
   27     # force an error if the previous line doesn't raise an exception
   28     stop("Test Failure B")
   29 }, error = function(e) {
   30   if (e$message == "Test Failure B") {
   31     # Raise the error again to cause a failed test
   32     stop(e)
   33   }
   34   message("Correct - no dollar assignment method found")
   35 }
   36 )
   37 
   38 ## The methods are attached to the parent class - see if we can get
   39 ## them
   40 tryCatch({
   41     m1 <- getMethod('$', "_p_A")
   42 }, error = function(e) {
   43     stop("No $ method found - there should be one")
   44 }
   45 )
   46 
   47 ## These methods should not be present
   48 ## They correspond to the tests that are expected
   49 ## to fail above.
   50 tryCatch({
   51     m2 <- getMethod('$<-', "_p_A")
   52     # force an error if the previous line doesn't raise an exception
   53     stop("Test Failure C")
   54 }, error = function(e) {
   55   if (e$message == "Test Failure C") {
   56     # Raise the error again to cause a failed test
   57     stop(e)
   58   }
   59   message("Correct - no dollar assignment method found")
   60 }
   61 )
   62 
   63 tryCatch({
   64     m3 <- getMethod('[[<-', "_p_A")
   65     # force an error if the previous line doesn't raise an exception
   66     stop("Test Failure D")
   67 }, error = function(e) {
   68   if (e$message == "Test Failure D") {
   69     # Raise the error again to cause a failed test
   70     stop(e)
   71   }
   72   message("Correct - no list assignment method found")
   73 }
   74 )