Skip to content
Snippets Groups Projects
Commit 28c1cd09 authored by Mick Jordan's avatar Mick Jordan
Browse files

[GR-3088] Fix dropped tests4/vanilla package tests.

parent 460d9f67
Branches
No related tags found
No related merge requests found
Showing
with 118 additions and 20 deletions
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)
# 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))
......
# 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))
# 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"))
# 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"))
# 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
# 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")
# 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
# 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"))
# 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))
# 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)
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)
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"))
# 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")
# 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)
# 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)
# 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) }))
# 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)
# 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"))
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)
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment