/usr/lib/R/site-library/Biobase/unitTests/test_unsaveSetSlot.R is in r-bioc-biobase 2.34.0-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 | ## Use of unsafeSetSlot is currently 'safe' inside a repelacement
## method, because under specific conditions the object is duplicated
## (referenced exactly once) on the way in. This test tries to catch
## any changes to R that eliminate this duplication, and hence
## invalidates the unsafe slot assignments used in Biobase
testUnsafeSetSlotInSlotAssignment1 <- function() {
## calls like set(x) <- value
setClass("A", representation=representation(x="numeric"),
where=.GlobalEnv)
on.exit(removeClass("A", .GlobalEnv))
setGeneric("set<-",
function(object, value) standardGeneric("set<-"),
where=.GlobalEnv)
setReplaceMethod("set",
signature=signature(object="A"),
function(object, value) {
Biobase:::unsafeSetSlot(object, "x", value)
},
where=.GlobalEnv)
on.exit(removeMethod("set<-", c(object="A"), .GlobalEnv))
on.exit(removeGeneric("set<-", .GlobalEnv))
b <- a <- new("A", x=1:10)
set(a) <- 10:1
checkIdentical(a@x, 10:1)
checkIdentical(b@x, 1:10)
}
testUnsafeSetSlotInSlotAssignment2 <- function() {
## calls like x <- "set<-"(x, value)
setClass("A", representation=representation(x="numeric"),
where=.GlobalEnv)
on.exit(removeClass("A", .GlobalEnv))
setGeneric("set<-",
function(object, value) standardGeneric("set<-"),
where=.GlobalEnv)
setReplaceMethod("set",
signature=signature(object="A"),
function(object, value) {
object@x <- value
Biobase:::unsafeSetSlot(object, "x", value)
},
where=.GlobalEnv)
on.exit(removeMethod("set<-", c(object="A"), .GlobalEnv))
on.exit(removeGeneric("set<-", .GlobalEnv))
b <- a <- new("A", x=1:10)
a <- "set<-"(a, 10:1)
checkIdentical(a@x, 10:1)
checkIdentical(b@x, 1:10)
}
|