diff --git a/com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/allocation0.R b/com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/allocation0.R
new file mode 100644
index 0000000000000000000000000000000000000000..eac4f00e6447dc68ea90049b0e5b9af582133908
--- /dev/null
+++ b/com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/allocation0.R
@@ -0,0 +1,10 @@
+stopifnot(require(methods))
+stopifnot(require(tests4))
+
+new("numeric")
+setClass("foo", representation(j="numeric")); new("foo", j=42)
+setClass("foo", representation(j="numeric")); typeof(new("foo", j=42))
+
+setClass("foo", representation(j="numeric")); getClass("foo")
+
+setClass("foo"); setClass("bar", representation(j = "numeric"), contains = "foo"); is.null(getClass("foo")@prototype)
diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/R/allocation1.R b/com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/allocation1.R
similarity index 80%
rename from com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/R/allocation1.R
rename to com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/allocation1.R
index 0a76366e675b399e127b52f04453737fc3742fb1..2f308efe17266c558d664e15058c72b29d6c8054 100644
--- a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/R/allocation1.R
+++ b/com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/allocation1.R
@@ -1,5 +1,7 @@
# test from Hadley Wickham's book
+stopifnot(require(methods))
+stopifnot(require(tests4))
setClass("Person", representation(name = "character", age = "numeric"))
setClass("Employee", representation(boss = "Person"), contains = "Person")
print(new("Person", name = "Hadley", age = 31))
diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/R/allocation10.R b/com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/allocation10.R
similarity index 88%
rename from com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/R/allocation10.R
rename to com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/allocation10.R
index d3c9441b27f6f202ef6ed11991884b5d1fb9bc94..eb3b1bf628f0500bf57e756c45e505644d8dfe77 100644
--- a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/R/allocation10.R
+++ b/com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/allocation10.R
@@ -1,4 +1,6 @@
# test from Hadley Wickham's book
+stopifnot(require(methods))
+stopifnot(require(tests4))
check_person <- function(object) {
errors <- character()
@@ -13,11 +15,11 @@ check_person <- function(object) {
msg <- paste("Name is length ", length_name, ". Should be 1", sep = "")
errors <- c(errors, msg)
}
-
+
if (length(errors) == 0) TRUE else errors
}
setClass("Person", representation(name = "character", age = "numeric"), validity = check_person)
hadley <- new("Person", name = "Hadley", age = 31)
hadley@age <- 1:10
-print(validObject(hadley))
+try(validObject(hadley))
diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/R/allocation2.R b/com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/allocation2.R
similarity index 62%
rename from com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/R/allocation2.R
rename to com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/allocation2.R
index e933ae21432f8ee25d785ccdeaa0987a88cf0fad..05ba0ae214e091ff415924a3807eb3daccfcbe95 100644
--- a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/R/allocation2.R
+++ b/com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/allocation2.R
@@ -1,5 +1,7 @@
# test from Hadley Wickham's book
+stopifnot(require(methods))
+stopifnot(require(tests4))
setClass("Person", representation(name = "character", age = "numeric"))
setClass("Employee", representation(boss = "Person"), contains = "Person")
-print(new("Person", name = "Hadley", age = "thirty"))
+try(new("Person", name = "Hadley", age = "thirty"))
diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/R/allocation3.R b/com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/allocation3.R
similarity index 65%
rename from com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/R/allocation3.R
rename to com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/allocation3.R
index c1c253979c5c9b03db7bab9f1e7d0b4a5e3cf427..6f596d9969082403b5f713e1d21e301cb343b7fc 100644
--- a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/R/allocation3.R
+++ b/com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/allocation3.R
@@ -1,6 +1,8 @@
# IgnoreErrorContext
# test from Hadley Wickham's book
+stopifnot(require(methods))
+stopifnot(require(tests4))
setClass("Person", representation(name = "character", age = "numeric"))
setClass("Employee", representation(boss = "Person"), contains = "Person")
-print(new("Person", name = "Hadley", sex = "male"))
+try(new("Person", name = "Hadley", sex = "male"))
diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/R/allocation4.R b/com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/allocation4.R
similarity index 77%
rename from com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/R/allocation4.R
rename to com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/allocation4.R
index 8d44cf9f272c41080dd38ffc611b1031c9b87b57..0270df7258a49e1294a048a76536b8a4d9e2302a 100644
--- a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/R/allocation4.R
+++ b/com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/allocation4.R
@@ -1,6 +1,8 @@
# test from Hadley Wickham's book
+stopifnot(require(methods))
+stopifnot(require(tests4))
setClass("Person", representation(name = "character", age = "numeric"))
setClass("Employee", representation(boss = "Person"), contains = "Person")
hadley <- new("Person", name = "Hadley")
-print(hadley@age)
+hadley@age
diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/R/allocation5.R b/com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/allocation5.R
similarity index 74%
rename from com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/R/allocation5.R
rename to com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/allocation5.R
index 193c85cf14f28a9cb1bdd921ae83e5e063a9a0d9..998abefbd13e9fd764476c6c084d42f0004d6695 100644
--- a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/R/allocation5.R
+++ b/com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/allocation5.R
@@ -1,6 +1,8 @@
# test from Hadley Wickham's book
+stopifnot(require(methods))
+stopifnot(require(tests4))
setClass("Person", representation(name = "character", age = "numeric"))
setClass("Employee", representation(boss = "Person"), contains = "Person")
hadley <- new("Person", name = "Hadley")
-print(slot(hadley, "age"))
+slot(hadley, "age")
diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/R/allocation6.R b/com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/allocation6.R
similarity index 74%
rename from com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/R/allocation6.R
rename to com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/allocation6.R
index 54b498d595b508e75c54db15a7f9b2aa5aebbd93..e131736c5a91de6e77ab3ad59e2310037e6707a8 100644
--- a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/R/allocation6.R
+++ b/com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/allocation6.R
@@ -1,5 +1,7 @@
# test from Hadley Wickham's book
+stopifnot(require(methods))
+stopifnot(require(tests4))
setClass("Person", representation(name = "character", age = "numeric"), prototype(name = NA_character_, age = NA_real_))
hadley <- new("Person", name = "Hadley")
-print(hadley@age)
+hadley@age
diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/R/allocation7.R b/com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/allocation7.R
similarity index 86%
rename from com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/R/allocation7.R
rename to com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/allocation7.R
index bb07265572319c1ef624c7511ab1b29a451e8096..13b43791850231cf5c99592672ca9d4f5dc5e212 100644
--- a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/R/allocation7.R
+++ b/com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/allocation7.R
@@ -1,5 +1,7 @@
# test from Hadley Wickham's book
+stopifnot(require(methods))
+stopifnot(require(tests4))
check_person <- function(object) {
errors <- character()
length_age <- length(object@age)
@@ -13,9 +15,9 @@ check_person <- function(object) {
msg <- paste("Name is length ", length_name, ". Should be 1", sep = "")
errors <- c(errors, msg)
}
-
+
if (length(errors) == 0) TRUE else errors
}
setClass("Person", representation(name = "character", age = "numeric"), validity = check_person)
-print(new("Person", name = "Hadley"))
+try(new("Person", name = "Hadley"))
diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/R/allocation8.R b/com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/allocation8.R
similarity index 84%
rename from com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/R/allocation8.R
rename to com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/allocation8.R
index 75c2b63b397b11e9a1c3390672578da110fd7d6d..c0d0057cf1f7d2dea17d6225d33a426f9eb9237a 100644
--- a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/R/allocation8.R
+++ b/com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/allocation8.R
@@ -1,5 +1,7 @@
# test from Hadley Wickham's book
+stopifnot(require(methods))
+stopifnot(require(tests4))
check_person <- function(object) {
errors <- character()
length_age <- length(object@age)
@@ -13,9 +15,9 @@ check_person <- function(object) {
msg <- paste("Name is length ", length_name, ". Should be 1", sep = "")
errors <- c(errors, msg)
}
-
+
if (length(errors) == 0) TRUE else errors
}
setClass("Person", representation(name = "character", age = "numeric"), validity = check_person)
-print(new("Person", name = "Hadley", age = 1:10))
+try(new("Person", name = "Hadley", age = 1:10))
diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/R/allocation9.R b/com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/allocation9.R
similarity index 85%
rename from com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/R/allocation9.R
rename to com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/allocation9.R
index 8aa98b24670780875ac300c13241b2dc938ff889..3d6e712d4e92398fb4eb16652cd582e7edd97abd 100644
--- a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/R/allocation9.R
+++ b/com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/allocation9.R
@@ -1,5 +1,7 @@
# test from Hadley Wickham's book
+stopifnot(require(methods))
+stopifnot(require(tests4))
check_person <- function(object) {
errors <- character()
length_age <- length(object@age)
@@ -13,10 +15,9 @@ check_person <- function(object) {
msg <- paste("Name is length ", length_name, ". Should be 1", sep = "")
errors <- c(errors, msg)
}
-
+
if (length(errors) == 0) TRUE else errors
}
setClass("Person", representation(name = "character", age = "numeric"), validity = check_person)
-print(new("Person", name = "Hadley", age = 31))
-
+new("Person", name = "Hadley", age = 31)
diff --git a/com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/conversions.R b/com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/conversions.R
new file mode 100644
index 0000000000000000000000000000000000000000..6881b18794ad0094acbc50fc5c061eb392289847
--- /dev/null
+++ b/com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/conversions.R
@@ -0,0 +1,8 @@
+stopifnot(require(methods))
+stopifnot(require(tests4))
+
+x<-42; isS4(x)
+x<-42; y<-asS4(x); isS4(y)
+isS4(NULL)
+asS4(NULL); isS4(NULL)
+asS4(7:42)
diff --git a/com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/inspect.R b/com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/inspect.R
new file mode 100644
index 0000000000000000000000000000000000000000..a3af8df2ad1eb5866fa4ffce574872e8c484284d
--- /dev/null
+++ b/com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/inspect.R
@@ -0,0 +1,7 @@
+stopifnot(require(methods))
+stopifnot(require(tests4))
+
+tests4:::inspect.vehicle(new("Car"), new("Inspector"))
+tests4:::inspect.vehicle(new("Truck"), new("Inspector"))
+tests4:::inspect.vehicle(new("Car"), new("StateInspector"))
+tests4:::inspect.vehicle(new("Truck"), new("StateInspector"))
diff --git a/com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/methods0.R.bug b/com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/methods0.R.bug
new file mode 100644
index 0000000000000000000000000000000000000000..53b1e01861f8cc95aff7a36f77e1bb3c37f9e99a
--- /dev/null
+++ b/com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/methods0.R.bug
@@ -0,0 +1,15 @@
+# this has differences that the fuzzy compare cannot cope with
+
+stopifnot(require(methods))
+stopifnot(require(tests4))
+
+setGeneric("gen", function(object) standardGeneric("gen")); res<-print(gen); removeGeneric("gen"); res
+gen<-function(object) 0; setGeneric("gen"); res<-print(gen); removeGeneric("gen"); res
+
+gen<-function(object) 0; setGeneric("gen"); setClass("foo", representation(d="numeric")); setMethod("gen", signature(object="foo"), function(object) object@d); res<-print(gen(new("foo", d=42))); removeGeneric("gen"); res
+
+setClass("foo", representation(d="numeric")); setClass("bar", contains="foo"); setGeneric("gen", function(o) standardGeneric("gen")); setMethod("gen", signature(o="foo"), function(o) "FOO"); setMethod("gen", signature(o="bar"), function(o) "BAR"); res<-print(c(gen(new("foo", d=7)), gen(new("bar", d=42)))); removeGeneric("gen"); res
+
+setGeneric("gen", function(o) standardGeneric("gen")); res<-print(setGeneric("gen", function(o) standardGeneric("gen"))); removeGeneric("gen"); res
+
+setClass("foo"); setMethod("diag<-", "foo", function(x, value) 42); removeMethod("diag<-", "foo"); removeGeneric("diag<-"); removeClass("foo")
diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/R/methods1.R b/com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/methods1.R
similarity index 78%
rename from com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/R/methods1.R
rename to com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/methods1.R
index 24dde5f0dff4b61e4ce8f9c7ba2bfff1701afa08..1a1b75d9c5035cb05dd743014ba66f7313ec5557 100644
--- a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/R/methods1.R
+++ b/com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/methods1.R
@@ -1,5 +1,7 @@
# test from Hadley Wickham's book
+stopifnot(require(methods))
+stopifnot(require(tests4))
setGeneric("sides", function(object) {
standardGeneric("sides")
})
@@ -19,5 +21,6 @@ setMethod("sides", signature("Square"), function(object) 4)
# setMethod("sides", signature("Circle"), function(object) Inf)
res<-print(showMethods("sides"))
-removeGeneric("sides")
+# BUG ALERT:In FastR without the "print" the result from removeGeneric (TRUE) is not printed.
+print(removeGeneric("sides"))
print(res)
diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/R/methods2.R b/com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/methods2.R
similarity index 84%
rename from com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/R/methods2.R
rename to com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/methods2.R
index 8afba8e7e92ea0a455904dfe1aa76373aaa7480c..9fdf38279f0e55d1577fe49c0faee99cc8e73c18 100644
--- a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/R/methods2.R
+++ b/com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/methods2.R
@@ -1,5 +1,7 @@
# test from Hadley Wickham's book
+stopifnot(require(methods))
+stopifnot(require(tests4))
setGeneric("sides", function(object) {
standardGeneric("sides")
})
@@ -19,5 +21,6 @@ setMethod("sides", signature("Square"), function(object) 4)
setMethod("sides", signature("Circle"), function(object) Inf)
res<-print(showMethods(class = "Polygon"))
-removeGeneric("sides")
+# BUG print should not be necessary
+print(removeGeneric("sides"))
print(res)
diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/R/methods3.R b/com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/methods3.R
similarity index 73%
rename from com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/R/methods3.R
rename to com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/methods3.R
index a944995797977d03696a9ad21a9324c3e6188a4d..d8d792ffabcb7f5ce5a88f9fc52d37b8efbf1f68 100644
--- a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/R/methods3.R
+++ b/com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/methods3.R
@@ -1,5 +1,7 @@
# test from Hadley Wickham's book
+stopifnot(require(methods))
+stopifnot(require(tests4))
setGeneric("sides", valueClass = "numeric", function(object) {
standardGeneric("sides")
})
@@ -11,4 +13,4 @@ setClass("Square", contains = "Polygon")
# setClass("Circle", contains = "Shape")
setMethod("sides", signature("Triangle"), function(object) "three")
-tryCatch({sides(new("Triangle"))}, error = function(e) { removeGeneric("sides"); stop(e) })
+try(tryCatch({sides(new("Triangle"))}, error = function(e) { removeGeneric("sides"); stop(e) }))
diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/R/methods4.R b/com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/methods4.R
similarity index 64%
rename from com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/R/methods4.R
rename to com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/methods4.R
index a18ecd900b3ef2396ac98a4256d38c49d6b4c0b7..6f75874a4a223faa6315c262bfb8d1ec5bbe5032 100644
--- a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/R/methods4.R
+++ b/com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/methods4.R
@@ -1,14 +1,17 @@
# test from Hadley Wickham's book
+stopifnot(require(methods))
+stopifnot(require(tests4))
setClass("A")
setClass("A1", contains = "A")
setClass("A2", contains = "A1")
setClass("A3", contains = "A2")
-setGeneric("foo", function(a, b) standardGeneric("foo"))
+setGeneric("foo", function(a, b) standardGeneric("foo"))
setMethod("foo", signature("A1", "A2"), function(a, b) "1-2")
setMethod("foo", signature("A2", "A1"), function(a, b) "2-1")
res<-print(foo(new("A2"), new("A2")))
-removeGeneric("foo")
+# BUG print shoukld not be necessary
+print(removeGeneric("foo"))
print(res)
diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/R/methods5.R b/com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/methods5.R
similarity index 84%
rename from com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/R/methods5.R
rename to com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/methods5.R
index 69b502a7d2bff0a00d6d78de17f790d63814d348..e8e93ff718dcdcadc90485f680dd90b3863c8fb7 100644
--- a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/R/methods5.R
+++ b/com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/methods5.R
@@ -1,5 +1,7 @@
# test from Hadley Wickham's book (slightly augmented)
+stopifnot(require(methods))
+stopifnot(require(tests4))
setClass("Vehicle")
setClass("Truck", contains = "Vehicle")
setClass("Car", contains = "Vehicle")
@@ -26,4 +28,5 @@ setMethod("inspect.vehicle",
})
inspect.vehicle(new("Car"), new("Inspector"))
-removeGeneric("inspect.vehicle");
+# BUG print should not be necessary
+print(removeGeneric("inspect.vehicle"))
diff --git a/com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/slotAccess.R b/com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/slotAccess.R
new file mode 100644
index 0000000000000000000000000000000000000000..f4c92749c73436d9931df8acdd9559523798cb71
--- /dev/null
+++ b/com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/slotAccess.R
@@ -0,0 +1,25 @@
+stopifnot(require(methods))
+stopifnot(require(tests4))
+
+`@`(getClass("ClassUnionRepresentation"), "virtual")
+`@`(getClass("ClassUnionRepresentation"), "virtual")
+try(`@`(getClass("ClassUnionRepresentation"), c("virtual", "foo")))
+getClass("ClassUnionRepresentation")@virtual
+getClass("ClassUnionRepresentation")@.S3Class
+c(42)@.Data
+x<-42; `@`(x, ".Data")
+x<-42; `@`(x, .Data)
+x<-42; slot(x, ".Data")
+setClass("foo", contains="numeric"); x<-new("foo"); res<-x@.Data; removeClass("foo"); res
+setClass("foo", contains="numeric"); x<-new("foo"); res<-slot(x, ".Data"); removeClass("foo"); res
+try(getClass("ClassUnionRepresentation")@foo)
+try(c(42)@foo)
+x<-42; attr(x, "foo")<-7; try(x@foo)
+x<-42; attr(x, "foo")<-7; slot(x, "foo")
+x<-c(42); class(x)<-"bar"; try(x@foo)
+x<-getClass("ClassUnionRepresentation"); slot(x, "virtual")
+x<-getClass("ClassUnionRepresentation"); try( slot(x, virtual))
+x<-function() 42; attr(x, "foo")<-7; y<-asS4(x); y@foo
+x<-NULL; try(`@`(x, foo))
+x<-NULL; try(x@foo)
+x<-paste0(".", "Data"); y<-42; slot(y, x)
diff --git a/com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/slotUpdate.R b/com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/slotUpdate.R
new file mode 100644
index 0000000000000000000000000000000000000000..f10261b0573b76d46718af73e12acce0cb59d0bc
--- /dev/null
+++ b/com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/slotUpdate.R
@@ -0,0 +1,12 @@
+stopifnot(require(methods))
+stopifnot(require(tests4))
+
+x<-getClass("ClassUnionRepresentation"); x@virtual<-TRUE; x@virtual
+x<-getClass("ClassUnionRepresentation"); slot(x, "virtual", check=TRUE)<-TRUE; x@virtual
+x<-initialize@valueClass; initialize@valueClass<-"foo"; initialize@valueClass<-x
+
+x<-function() 42; attr(x, "foo")<-7; try(y@foo<-42)
+x<-function() 42; attr(x, "foo")<-7; try(slot(y, "foo")<-42)
+x<-function() 42; attr(x, "foo")<-7; y<-asS4(x); try(y@foo<-42)
+x<-NULL; try(`@<-`(x, foo, "bar"))
+x<-NULL; try(x@foo<-"bar")
diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/R/slot_access1.R b/com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/slot_access1.R
similarity index 80%
rename from com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/R/slot_access1.R
rename to com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/slot_access1.R
index a1743cc28aa17f4131607596ae5d76c117905785..a0160b4bb98a0b33db56bdc99ad484e08a1fe4fa 100644
--- a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/R/slot_access1.R
+++ b/com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/slot_access1.R
@@ -1,5 +1,7 @@
# test from Hadley Wickham's book
+stopifnot(require(methods))
+stopifnot(require(tests4))
setClass("Person", representation(name = "character", age = "numeric"), prototype(name = NA_character_, age = NA_real_))
hadley <- new("Person", name = "Hadley")
print(getSlots("Person"))
diff --git a/com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/stdgeneric.R b/com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/stdgeneric.R
new file mode 100644
index 0000000000000000000000000000000000000000..0293d845770286a283a609d8abcd03b14ce3acec
--- /dev/null
+++ b/com.oracle.truffle.r.test.native/packages/tests4/tests4/tests/stdgeneric.R
@@ -0,0 +1,8 @@
+stopifnot(require(methods))
+stopifnot(require(tests4))
+
+try(standardGeneric(42))
+try(standardGeneric(character()))
+try(standardGeneric(""))
+try(standardGeneric("foo", 42))
+x<-42; class(x)<-character(); try(standardGeneric("foo", x))
diff --git a/com.oracle.truffle.r.test.native/packages/vanilla/vanilla/tests/vanilla.R b/com.oracle.truffle.r.test.native/packages/vanilla/vanilla/tests/vanilla.R
new file mode 100644
index 0000000000000000000000000000000000000000..e9992f04c4310262d137cc241c22eaeb8d8ed2bb
--- /dev/null
+++ b/com.oracle.truffle.r.test.native/packages/vanilla/vanilla/tests/vanilla.R
@@ -0,0 +1,5 @@
+stopifnot(require(vanilla))
+
+vanilla()
+functionTest(c(1,2,3,4,5,6),8:10)
+r<-42; vanilla::foo(r)<-7; r
diff --git a/com.oracle.truffle.r.test.packages/r/install.packages.R b/com.oracle.truffle.r.test.packages/r/install.packages.R
index 397c82bec349f9dab8559a91f42b4106c11caf21..2695cf973fa90487b313cfa7e189ad66ad313408 100644
--- a/com.oracle.truffle.r.test.packages/r/install.packages.R
+++ b/com.oracle.truffle.r.test.packages/r/install.packages.R
@@ -260,6 +260,10 @@ set.repos <- function() {
repos <- character()
needCran <- F
if ("BIOC" %in% repo.list) {
+ # source("http://bioconductor.org/biocLite.R")
+ # repos["BIOC"] <- biocinstallRepos()[1]
+ # above is correct but provokes bug:
+ # Error in read.table(): more columns than column names
repos["BIOC"] <- "https://bioconductor.org/packages/3.4/bioc"
needCran <- T
}
diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/TestS4.java b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/TestS4.java
deleted file mode 100644
index 01287bcef7b2e3a6945cb9955869f56076e6eddc..0000000000000000000000000000000000000000
--- a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/TestS4.java
+++ /dev/null
@@ -1,129 +0,0 @@
-/*
- * Copyright (c) 2015, 2017, Oracle and/or its affiliates. All rights reserved.
- * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
- *
- * This code is free software; you can redistribute it and/or modify it
- * under the terms of the GNU General Public License version 2 only, as
- * published by the Free Software Foundation.
- *
- * This code 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
- * version 2 for more details (a copy is included in the LICENSE file that
- * accompanied this code).
- *
- * You should have received a copy of the GNU General Public License version
- * 2 along with this work; if not, write to the Free Software Foundation,
- * Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA.
- *
- * Please contact Oracle, 500 Oracle Parkway, Redwood Shores, CA 94065 USA
- * or visit www.oracle.com if you need additional information or have any
- * questions.
- */
-package com.oracle.truffle.r.test.S4;
-
-import org.junit.Test;
-
-import com.oracle.truffle.r.test.TestRBase;
-
-// Checkstyle: stop LineLength
-
-/**
- * Tests for the S4 object model implementation.
- */
-public class TestS4 extends TestRBase {
- @Test
- public void testSlotAccess() {
- assertEval("{ `@`(getClass(\"ClassUnionRepresentation\"), virtual) }");
- assertEval("{ `@`(getClass(\"ClassUnionRepresentation\"), \"virtual\") }");
- assertEval(Output.IgnoreErrorContext, "{ `@`(getClass(\"ClassUnionRepresentation\"), c(\"virtual\", \"foo\")) }");
- assertEval("{ getClass(\"ClassUnionRepresentation\")@virtual }");
- assertEval("{ getClass(\"ClassUnionRepresentation\")@.S3Class }");
- assertEval("{ c(42)@.Data }");
- assertEval("{ x<-42; `@`(x, \".Data\") }");
- assertEval("{ x<-42; `@`(x, .Data) }");
- assertEval("{ x<-42; slot(x, \".Data\") }");
- assertEval("{ setClass(\"foo\", contains=\"numeric\"); x<-new(\"foo\"); res<-x@.Data; removeClass(\"foo\"); res }");
- assertEval("{ setClass(\"foo\", contains=\"numeric\"); x<-new(\"foo\"); res<-slot(x, \".Data\"); removeClass(\"foo\"); res }");
- assertEval(Output.IgnoreErrorContext, "{ getClass(\"ClassUnionRepresentation\")@foo }");
- assertEval(Output.IgnoreErrorContext, "{ c(42)@foo }");
- assertEval(Output.IgnoreErrorContext, " { x<-42; attr(x, \"foo\")<-7; x@foo }");
- assertEval("{ x<-42; attr(x, \"foo\")<-7; slot(x, \"foo\") }");
- assertEval(Output.IgnoreErrorContext, "{ x<-c(42); class(x)<-\"bar\"; x@foo }");
- assertEval("{ x<-getClass(\"ClassUnionRepresentation\"); slot(x, \"virtual\") }");
- assertEval(Output.IgnoreErrorContext, "{ x<-getClass(\"ClassUnionRepresentation\"); slot(x, virtual) }");
- assertEval("{ x<-function() 42; attr(x, \"foo\")<-7; y<-asS4(x); y@foo }");
- assertEval(Output.IgnoreErrorContext, "{ x<-NULL; `@`(x, foo) }");
- assertEval(Output.IgnoreErrorContext, "{ x<-NULL; x@foo }");
- assertEval("{ x<-paste0(\".\", \"Data\"); y<-42; slot(y, x) }");
- }
-
- @Test
- public void testSlotUpdate() {
- assertEval("{ x<-getClass(\"ClassUnionRepresentation\"); x@virtual<-TRUE; x@virtual }");
- assertEval("{ x<-getClass(\"ClassUnionRepresentation\"); slot(x, \"virtual\", check=TRUE)<-TRUE; x@virtual }");
- assertEval("{ x<-initialize@valueClass; initialize@valueClass<-\"foo\"; initialize@valueClass<-x }");
-
- assertEval(Output.IgnoreErrorContext, "{ x<-function() 42; attr(x, \"foo\")<-7; y@foo<-42 }");
- assertEval(Output.IgnoreErrorContext, "{ x<-function() 42; attr(x, \"foo\")<-7; slot(y, \"foo\")<-42 }");
- assertEval(Output.IgnoreErrorContext, "{ x<-function() 42; attr(x, \"foo\")<-7; y<-asS4(x); y@foo<-42 }");
- assertEval(Output.IgnoreErrorContext, "{ x<-NULL; `@<-`(x, foo, \"bar\") }");
- assertEval(Output.IgnoreErrorContext, "{ x<-NULL; x@foo<-\"bar\" }");
-
- }
-
- @Test
- public void testConversions() {
- assertEval("{ x<-42; isS4(x) }");
- assertEval("{ x<-42; y<-asS4(x); isS4(y) }");
- assertEval("{ isS4(NULL) }");
- assertEval("{ asS4(NULL); isS4(NULL) }");
- assertEval("{ asS4(7:42) }");
- }
-
- @Test
- public void testAllocation() {
- assertEval("{ new(\"numeric\") }");
- assertEval("{ setClass(\"foo\", representation(j=\"numeric\")); new(\"foo\", j=42) }");
- assertEval("{ setClass(\"foo\", representation(j=\"numeric\")); typeof(new(\"foo\", j=42)) }");
- }
-
- @Test
- public void testClassCreation() {
- // output slightly different from GNU R even though we use R's "show" method to print it
- assertEval(Ignored.OutputFormatting, "{ setClass(\"foo\", representation(j=\"numeric\")); getClass(\"foo\") }");
-
- assertEval("{ setClass(\"foo\"); setClass(\"bar\", representation(j = \"numeric\"), contains = \"foo\"); is.null(getClass(\"foo\")@prototype) }");
- }
-
- @Test
- public void testMethods() {
- // output slightly different from GNU R even though we use R's "show" method to print it
- assertEval(Ignored.OutputFormatting, "{ setGeneric(\"gen\", function(object) standardGeneric(\"gen\")); res<-print(gen); removeGeneric(\"gen\"); res }");
- assertEval(Ignored.OutputFormatting, "{ gen<-function(object) 0; setGeneric(\"gen\"); res<-print(gen); removeGeneric(\"gen\"); res }");
-
- assertEval("{ gen<-function(object) 0; setGeneric(\"gen\"); setClass(\"foo\", representation(d=\"numeric\")); setMethod(\"gen\", signature(object=\"foo\"), function(object) object@d); res<-print(gen(new(\"foo\", d=42))); removeGeneric(\"gen\"); res }");
-
- assertEval("{ setClass(\"foo\", representation(d=\"numeric\")); setClass(\"bar\", contains=\"foo\"); setGeneric(\"gen\", function(o) standardGeneric(\"gen\")); setMethod(\"gen\", signature(o=\"foo\"), function(o) \"FOO\"); setMethod(\"gen\", signature(o=\"bar\"), function(o) \"BAR\"); res<-print(c(gen(new(\"foo\", d=7)), gen(new(\"bar\", d=42)))); removeGeneric(\"gen\"); res }");
-
- assertEval("{ setGeneric(\"gen\", function(o) standardGeneric(\"gen\")); res<-print(setGeneric(\"gen\", function(o) standardGeneric(\"gen\"))); removeGeneric(\"gen\"); res }");
-
- assertEval("{ setClass(\"foo\"); setMethod(\"diag<-\", \"foo\", function(x, value) 42); removeMethod(\"diag<-\", \"foo\"); removeGeneric(\"diag<-\"); removeClass(\"foo\") }");
-
- }
-
- @Test
- public void testStdGeneric() {
- assertEval("{ standardGeneric(42) }");
- assertEval("{ standardGeneric(character()) }");
- assertEval("{ standardGeneric(\"\") }");
- // FastR produces better error contexts
- assertEval(Output.IgnoreErrorContext, "{ standardGeneric(\"foo\", 42) }");
- assertEval(Output.IgnoreErrorContext, "{ x<-42; class(x)<-character(); standardGeneric(\"foo\", x) }");
- }
-
- @Override
- public String getTestDir() {
- return "S4";
- }
-}
diff --git a/mx.fastr/mx_fastr_pkgs.py b/mx.fastr/mx_fastr_pkgs.py
index 62612925639dce59bf0fe06a37278d6652dcfe48..f45348f89c8b8acc476d7b0d1f166c5ec1b21eeb 100644
--- a/mx.fastr/mx_fastr_pkgs.py
+++ b/mx.fastr/mx_fastr_pkgs.py
@@ -297,12 +297,9 @@ def _get_test_outputs(rvm, pkg_name, test_info):
test_info[pkg_name] = TestStatus()
for f in files:
ext = os.path.splitext(f)[1]
- if f == 'test_time' or ext == '.R' or ext == '.Rin' or ext == '.prev':
- continue
# suppress .pdf's for now (we can't compare them)
- if ext == '.pdf':
- continue
- if ext == '.save':
+ ignore = ['.R', '.Rin', '.prev', '.bug', '.pdf', '.save']
+ if f == 'test_time' or ext in ignore:
continue
status = "OK"
if ext == '.fail':
@@ -451,7 +448,13 @@ def _find_start(content):
for i in range(len(content)):
line = content[i]
if marker in line:
- return i + 1
+ # skip blank lines
+ j = i + 1
+ while j < len(content):
+ line = content[j].strip()
+ if len(line) > 0:
+ return j
+ j = j + 1
return None
def _find_end(content):
@@ -484,7 +487,7 @@ def _fuzzy_compare(gnur_content, fastr_content):
fastr_len = len(fastr_content)
if not gnur_start or not gnur_end or not fastr_start:
return -1
- gnur_i = gnur_start + 1 # Gnu has extra empty line
+ gnur_i = gnur_start
fastr_i = fastr_start
result = 0
while gnur_i < gnur_end:
@@ -510,6 +513,9 @@ def _fuzzy_compare(gnur_content, fastr_content):
# skip until lines match (or not)
gnur_i = gnur_i + 1
fastr_i = fastr_i + 1
+ if gnur_i == gnur_end - 1:
+ # at end (there is always a blank line)
+ break
ni = -1
while gnur_i < gnur_end:
ni = _find_line(gnur_content[gnur_i], fastr_content, fastr_i)
@@ -523,16 +529,20 @@ def _fuzzy_compare(gnur_content, fastr_content):
result = 1
break
else:
- # genuine difference
- result = 1
- break
+ # genuine difference (modulo whitespace)
+ if not _ignore_whitespace(gnur_line, fastr_line):
+ result = 1
+ break
gnur_i = gnur_i + 1
fastr_i = fastr_i + 1
return result
+def _ignore_whitespace(gnur_line, fastr_line):
+ return gnur_line.translate(None, ' \t') == fastr_line.translate(None, ' \t')
+
def pkgtest_cmp(args):
with open(args[0]) as f:
gnur_content = f.readlines()
with open(args[1]) as f:
fastr_content = f.readlines()
- _fuzzy_compare(gnur_content, fastr_content)
+ return _fuzzy_compare(gnur_content, fastr_content)