/
no-segfault.Rin
87 lines (76 loc) · 2.95 KB
/
no-segfault.Rin
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
###-*- R -*-
###--- This "foo.Rin" script is only used to create the real script "foo.R" :
###--- We need to use such a long "real script" instead of a for loop,
###--- because "error --> jump_to_toplevel", i.e., outside any loop.
core.pkgs <-
{x <- installed.packages(file.path(R.home(), "library"));
x[x[,"Priority"]=="base", "Package"]}
## c("base", "eda", "lqs", "modreg", "mva", "stepfun", "ts", "nls","splines")
## .packages(all=TRUE,lib.loc = .lib.loc[length(.lib.loc)])
core.pkgs <- core.pkgs[- match("tcltk", core.pkgs)]
stop.list <- vector("list", length(core.pkgs))
names(stop.list) <- core.pkgs
## -- Stop List for "base" :
edit.int <- c("fix", "edit", "edit.data.frame", "edit.matrix",
"edit.default", "vi",
"emacs", "pico", "xemacs", "xedit")
## warning: readLines will work, but read all the rest of the script
misc.int <- c("browser", "bug.report", "menu", "repeat", "readLines")
stop.list[["base"]] <-
if(nchar(Sys.getenv("R_TESTLOTS"))) {## SEVERE TESTING, try almost ALL
c(edit.int, misc.int)
} else {
inet.list <- c(apropos("download\."),
apropos("^url\."), apropos("\.url"),
apropos("packageStatus"),
paste(c("CRAN", "install", "update", "old"),
"packages",sep="."))
socket.fun <- apropos("socket")
## "Interactive" ones:
dev.int <- c("X11", "x11", "windows", "macintosh", "postscript",
"xfig", "jpeg", "png", "pictex")
## print.plot() will print a blank page on the printer and is
## deprecated anyway --pd
misc.2 <- c("help.start", "print.plot",
"gctorture", "q", "quit", "restart", "try",
"read.fwf", "source",## << MM thinks "FIXME"
"data.entry", "dataentry", "de", apropos("^de\."))
c(inet.list, socket.fun, dev.int, edit.int, misc.int, misc.2)
}
sink("no-segfault.R")
cat('options(pager = "cat", error=expression(NULL))',
"# don't stop on error in batch\n##~~~~~~~~~~~~~~\n")
cat(".proctime00 <- proc.time()\n",
"c0 <- character(0)\n",
"l0 <- logical(0)\n",
"m0 <- matrix(1,0,0)\n",
"df0 <- as.data.frame(c0)\n", sep="")
for (pkg in core.pkgs) {
cat("### Package ", pkg, "\n",
"### ", rep("~",nchar(pkg)), "\n", collapse="", sep="")
if(pkg == "base") {
this.pos <- length(search())
}
else {
library(pkg, character = TRUE)
cat("library(",pkg,")\n")
this.pos <- 2
}
for(nm in ls(pos = this.pos)) {
if(!(nm %in% stop.list[[pkg]]) &&
is.function(f <- get(nm,pos = this.pos))) {
cat("\n## ", nm, " :\n")
cat("f <- get(\"",nm,"\", pos = ", this.pos, ")\n", sep="")
cat("f()\nf(NULL)\nf(,NULL)\nf(NULL,NULL)\n",
"f(list())\nf(l0)\nf(c0)\nf(m0)\nf(df0)\nf(F)\n",
"f(list(),list())\nf(l0,l0)\nf(c0,c0)\nf(df0,df0)\nf(F,F)\n",
sep="")
}
}
if(pkg != "base") {
detach(pos=this.pos)
cat("detach(pos=",this.pos,")\n")
}
cat("\n##__________\n\n")
}
cat("proc.time() - .proctime00\n")