-
Notifications
You must be signed in to change notification settings - Fork 204
/
Copy pathreg-packages.R
157 lines (145 loc) · 6.39 KB
/
reg-packages.R
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
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
## PR 1271 detach("package:base") crashes R.
tools::assertError(detach("package:base"))
## invalid 'lib.loc'
stopifnot(length(installed.packages("mgcv")) == 0)
## gave a low-level error message
## package.skeleton() with metadata-only code
## work in current (= ./tests/ directory):
tmp <- tempfile()
writeLines(c('setClass("foo", contains="numeric")',
'setMethod("show", "foo",',
' function(object) cat("I am a \\"foo\\"\\n"))'),
tmp)
if(file.exists("myTst")) unlink("myTst", recursive=TRUE)
package.skeleton("myTst", code_files = tmp)# with a file name warning
file.copy(tmp, (tm2 <- paste(tmp,".R", sep="")))
unlink("myTst", recursive=TRUE)
op <- options(warn=2) # *NO* "invalid file name" warning {failed in 2.7.[01]}:
package.skeleton("myTst", code_files = tm2)
options(op)
##_2_ only a class, no generics/methods:
writeLines(c('setClass("DocLink",',
'representation(name="character",',
' desc="character"))'), tmp)
if(file.exists("myTst2")) unlink("myTst2", recursive=TRUE)
package.skeleton("myTst2", code_files = tmp)
##- end_2_ # failed in R 2.11.0
stopifnot(1 == grep("setClass",
readLines(list.files("myTst/R", full.names=TRUE))),
c("foo-class.Rd","show-methods.Rd") %in% list.files("myTst/man"))
## failed for several reasons in R < 2.7.0
##
## Part 2: -- build, install, load and "inspect" the package:
build.pkg <- function(dir) {
stopifnot(dir.exists(dir))
patt <- paste(basename(dir), ".*tar\\.gz$", sep="_")
unlink(dir('.', pattern = patt))
Rcmd <- paste(file.path(R.home("bin"), "R"), "CMD")
r <- tail(system(paste(Rcmd, "build --keep-empty-dirs", shQuote(dir)),
intern = TRUE), 3)
## return name of tar file built
dir('.', pattern = patt)
}
build.pkg("myTst")
## clean up any previous attempt (which might have left a 00LOCK)
unlink("myLib", recursive = TRUE)
dir.create("myLib")
install.packages("myTst", lib = "myLib", repos=NULL, type = "source") # with warnings
print(installed.packages(lib.loc= "myLib", priority= "NA"))## (PR#13332)
stopifnot(require("myTst",lib = "myLib"))
sm <- findMethods(show, where= as.environment("package:myTst"))
stopifnot(names(sm@names) == "foo")
unlink("myTst_*")
## getPackageName() for "package:foo":
require('methods')
library(tools)
oo <- options(warn=2)
detach("package:tools", unload=TRUE)
options(oo)
## gave warning (-> Error) about creating package name
## --- keep this at end --- so we do not need a large if(.) { .. }
## More building & installing packages
## NB: tests were added here for 2.11.0.
## NB^2: do not do this in the R sources!
## and this testdir is not installed.
if(interactive() && Sys.getenv("USER") == "maechler")
Sys.setenv(SRCDIR = normalizePath("~/R/D/r-devel/R/tests"))
(pkgSrcPath <- file.path(Sys.getenv("SRCDIR"), "Pkgs"))
if(!file_test("-d", pkgSrcPath) && !interactive()) {
unlink("myTst", recursive=TRUE)
print(proc.time())
q("no")
}
## else w/o clause:
## file.copy(pkgSrcPath, tempdir(), recursive = TRUE) - not ok: replaces symlink by copy
system(paste('cp -R', shQuote(pkgSrcPath), shQuote(tempdir())))
pkgPath <- file.path(tempdir(), "Pkgs")
## pkgB tests an empty R directory
dir.create(file.path(pkgPath, "pkgB", "R"), recursive = TRUE,
showWarnings = FALSE)
p.lis <- if("Matrix" %in% row.names(installed.packages(.Library)))
c("pkgA", "pkgB", "exNSS4") else "exNSS4"
pkgApath <- file.path(pkgPath, "pkgA")
if("pkgA" %in% p.lis && !dir.exists(d <- pkgApath)) {
cat("symlink 'pkgA' does not exist as directory ",d,"; copying it\n", sep='')
file.copy(file.path(pkgPath, "xDir", "pkg"), to = d, recursive=TRUE)
## if even the copy failed (NB: pkgB depends on pkgA)
if(!dir.exists(d)) p.lis <- p.lis[!(p.lis %in% c("pkgA", "pkgB"))]
}
for(p. in p.lis) {
cat("building package", p., "...\n")
r <- build.pkg(file.path(pkgPath, p.))
cat("installing package", p., "using file", r, "...\n")
## we could install the tar file ... (see build.pkg()'s definition)
install.packages(r, lib = "myLib", repos=NULL, type = "source")
stopifnot(require(p.,lib = "myLib", character.only=TRUE))
detach(pos = match(p., sub("^package:","", search())))
}
(res <- installed.packages(lib.loc = "myLib", priority = "NA"))
stopifnot(identical(res[,"Package"], setNames(,sort(c(p.lis, "myTst")))),
res[,"LibPath"] == "myLib")
### Specific Tests on our "special" packages: ------------------------------
## These used to fail because of the sym.link in pkgA
if("pkgA" %in% p.lis && dir.exists(pkgApath)) {
cat("undoc(pkgA):\n"); print(uA <- tools::undoc(dir = pkgApath))
cat("codoc(pkgA):\n"); print(cA <- tools::codoc(dir = pkgApath))
stopifnot(identical(uA$`code objects`, c("nil", "search")),
identical(uA$`data sets`, "nilData"))
}
## - Check conflict message.
## - Find objects which are NULL via "::" -- not to be expected often
## we have one in our pkgA, but only if Matrix is present.
if(dir.exists(file.path("myLib", "pkgA"))) {
msgs <- capture.output(require(pkgA, lib="myLib"), type = "message")
writeLines(msgs)
stopifnot(length(msgs) > 2,
length(grep("The following object is masked.*package:base", msgs)) > 0,
length(grep("\\bsearch\\b", msgs)) > 0)
data(package = "pkgA") # -> nilData
stopifnot(is.null( pkgA:: nil),
is.null( pkgA::: nil),
is.null( pkgA:: nilData)) # <-
## R-devel (pre 3.2.0) wrongly errored for NULL lazy data
## ::: does not apply to data sets:
tools::assertError(is.null(pkgA:::nilData))
}
## tests here should *NOT* assume recommended packages,
## let alone where they are installed
if(dir.exists(file.path("myLib", "exNSS4")) &&
dir.exists(file.path(.Library, "Matrix"))) {
for(ns in c(rev(p.lis), "Matrix")) unloadNamespace(ns)
## Both exNSS4 and Matrix define "atomicVector" *the same*,
## but 'exNSS4' has it extended - and hence *both* are registered in cache -> "conflicts"
requireNamespace("exNSS4", lib= "myLib")
requireNamespace("Matrix", lib= .Library)
tools::assertCondition( ## condition, because this *still* uses message():
acl <- getClass("atomicVector")
) ## gave an Error: “atomicVector” is not a defined class
## ... because it was found non-uniquely
stopifnot(is(acl, "classRepresentation"), isVirtualClass(acl))
}
## clean up
unlink("myLib", recursive = TRUE)
unlink(file.path(pkgPath), recursive = TRUE)
unlink("myTst", recursive = TRUE)
proc.time()