91 lines
3.3 KiB
R
91 lines
3.3 KiB
R
|
|
||
|
library(compiler)
|
||
|
|
||
|
##
|
||
|
## Tests for findHomeNS()
|
||
|
##
|
||
|
|
||
|
findHomeNS <- compiler:::findHomeNS
|
||
|
|
||
|
## return value for an undefinded variable should be NULL
|
||
|
stopifnot(is.null(findHomeNS("foo", getNamespace("stats"))))
|
||
|
stopifnot(is.null(findHomeNS("foo", parent.env(getNamespace("stats")))))
|
||
|
stopifnot(is.null(findHomeNS("foo", getNamespace("base"))))
|
||
|
|
||
|
## + is found in .BaseNamespaceEnv for stats or base
|
||
|
stopifnot(identical(findHomeNS("+", getNamespace("stats")),
|
||
|
.BaseNamespaceEnv))
|
||
|
stopifnot(identical(findHomeNS("+", parent.env(getNamespace("stats"))),
|
||
|
.BaseNamespaceEnv))
|
||
|
stopifnot(identical(findHomeNS("+", getNamespace("base")),
|
||
|
.BaseNamespaceEnv))
|
||
|
|
||
|
## dnorm is defined in stats
|
||
|
stopifnot(identical(findHomeNS("dnorm", getNamespace("stats")),
|
||
|
getNamespace("stats")))
|
||
|
stopifnot(identical(findHomeNS("dnorm", parent.env(getNamespace("stats"))),
|
||
|
getNamespace("stats")))
|
||
|
stopifnot(is.null(findHomeNS("dnorm", getNamespace("base"))))
|
||
|
|
||
|
## par is available via the stats namespace since stats imports graphics
|
||
|
stopifnot(identical(findHomeNS("par", getNamespace("stats")),
|
||
|
getNamespace("graphics")))
|
||
|
stopifnot(identical(findHomeNS("par", parent.env(getNamespace("stats"))),
|
||
|
getNamespace("graphics")))
|
||
|
stopifnot(is.null(findHomeNS("par", getNamespace("base"))))
|
||
|
|
||
|
## palette is one of a small set of selective imports from grDevices
|
||
|
stopifnot(identical(findHomeNS("palette", getNamespace("stats")),
|
||
|
getNamespace("grDevices")))
|
||
|
stopifnot(identical(findHomeNS("palette", parent.env(getNamespace("stats"))),
|
||
|
getNamespace("grDevices")))
|
||
|
stopifnot(is.null(findHomeNS("palette", getNamespace("base"))))
|
||
|
|
||
|
|
||
|
##
|
||
|
## Tests for getAssignedVar
|
||
|
##
|
||
|
|
||
|
getAssignedVar <- compiler:::getAssignedVar
|
||
|
stopifnot(identical(getAssignedVar(quote("v"<-x)), "v"))
|
||
|
stopifnot(identical(getAssignedVar(quote(v<-x)), "v"))
|
||
|
stopifnot(identical(getAssignedVar(quote(f(v)<-x)), "v"))
|
||
|
stopifnot(identical(getAssignedVar(quote(f(g(v,2),1)<-x)), "v"))
|
||
|
|
||
|
|
||
|
##
|
||
|
## Tests for findLocals
|
||
|
##
|
||
|
|
||
|
findLocals <- compiler:::findLocals
|
||
|
cenv <- compiler:::makeCenv(.GlobalEnv)
|
||
|
cntxt <- compiler:::make.toplevelContext(cenv, NULL)
|
||
|
|
||
|
stopifnot(identical(findLocals(quote(x<-1), cntxt), "x"))
|
||
|
stopifnot(identical(findLocals(quote(f(x)<-1), cntxt), "x"))
|
||
|
stopifnot(identical(findLocals(quote(f(g(x,2),1)<-1), cntxt), "x"))
|
||
|
stopifnot(identical(findLocals(quote(x<-y<-1), cntxt), c("x","y")))
|
||
|
stopifnot(identical(findLocals(quote(local(x<-1,e)), cntxt), "x"))
|
||
|
stopifnot(identical(findLocals(quote(local(x<-1)), cntxt), character(0)))
|
||
|
stopifnot(identical(findLocals(quote({local<-1;local(x<-1)}), cntxt),
|
||
|
c("local", "x")))
|
||
|
|
||
|
local({
|
||
|
f <- function (f, x, y) {
|
||
|
local <- f
|
||
|
local(x <- y)
|
||
|
x
|
||
|
}
|
||
|
stopifnot(identical(findLocals(body(f), cntxt), c("local","x")))
|
||
|
})
|
||
|
|
||
|
local({
|
||
|
cenv <- compiler:::addCenvVars(cenv, "local")
|
||
|
cntxt <- compiler:::make.toplevelContext(cenv, NULL)
|
||
|
stopifnot(identical(findLocals(quote(local(x<-1,e)), cntxt), "x"))
|
||
|
})
|
||
|
|
||
|
stopifnot(identical(findLocals(quote(assign(x, 3)), cntxt), character(0)))
|
||
|
stopifnot(identical(findLocals(quote(assign("x", 3)), cntxt), "x"))
|
||
|
stopifnot(identical(findLocals(quote(assign("x", 3, 4)), cntxt), character(0)))
|