1###-*- R -*-
2###--- This "foo.Rin" script is only used to create the real script "foo.R" :
3
4###--- We need to use such a long "real script" instead of a for loop,
5###--- because "error --> jump_to_toplevel", i.e., outside any loop.
6
7core.pkgs <- local({x <- installed.packages(.Library)
8    unname(x[x[,"Priority"] %in% "base", "Package"])})
9core.pkgs <-
10    core.pkgs[- match(c("methods", "parallel", "tcltk", "stats4"), core.pkgs, 0)]
11## move methods to the end because it has side effects (overrides primitives)
12## stats4 requires methods
13core.pkgs <- c(core.pkgs, "methods", "stats4")
14
15stop.list <- vector("list", length(core.pkgs))
16names(stop.list) <- core.pkgs
17
18## -- Stop List for base/graphics/utils:
19edit.int <- c("fix", "edit", "edit.data.frame", "edit.matrix",
20              "edit.default", "vi", "file.edit",
21              "emacs", "pico", "xemacs", "xedit", "RSiteSearch", "help.request")
22
23## warning: readLines will work, but read all the rest of the script
24## warning: trace will load methods.
25## warning: rm and remove zap c0, l0, m0, df0
26## warning: parent.env(NULL) <- NULL creates a loop
27## warning: browseVignettes launches many browser processes.
28## news, readNEWS, rtags are slow, and R-only code.
29misc.int <- c("browser", "browseVignettes", "bug.report", "checkCRAN",
30              "getCRANmirrors", "lazyLoad", "menu", "repeat",
31              "readLines", "package.skeleton", "trace", "recover",
32              "rm", "remove", "parent.env<-",
33              "builtins", "data", "help", "news", "rtags", "vignette",
34              "installed.packages")
35inet.list <- c(apropos("download\\."),
36               apropos("^url\\."), apropos("\\.url"),
37               apropos("packageStatus"),
38               paste(c("CRAN", "install", "update", "old"), "packages", sep="."))
39socket.fun <- apropos("socket")
40## "Interactive" ones:
41dev.int <- c("X11", "x11", "pdf", "postscript",
42             "xfig", "jpeg", "png", "pictex", "quartz",
43             "svg", "tiff", "cairo_pdf", "cairo_ps",
44             "getGraphicsEvent")
45misc.2 <- c("asS4", "help.start", "browseEnv", "make.packages.html",
46            "gctorture", "q", "quit", "restart", "try",
47            "read.fwf", "source",## << MM thinks "FIXME"
48            "data.entry", "dataentry", "de", apropos("^de\\."),
49            "chooseCRANmirror", "setRepositories", "select.list", "View")
50if(.Platform$OS.type == "windows") {
51    dev.int <- c(dev.int, "bmp", "windows", "win.graph", "win.print",
52                "win.metafile")
53    misc.2 <- c(misc.2, "file.choose", "choose.files", "choose.dir",
54    		"setWindowTitle", "loadRconsole",
55                "arrangeWindows", "getWindowsHandles")
56}
57
58stop.list[["base"]] <-
59    if(nchar(Sys.getenv("R_TESTLOTS"))) {## SEVERE TESTING, try almost ALL
60	c(edit.int, misc.int)
61    } else {
62	c(inet.list, socket.fun, edit.int, misc.int, misc.2)
63    }
64
65## S4 group generics should not be called directly
66## and doing so sometimes leads to infinite recursion
67s4.group.generics <- c("Arith", "Compare", "Ops", "Logic", "Math", "Math2", "Summary", "Complex")
68
69## warning: browseAll will tend to read all the script and/or loop forever
70stop.list[["methods"]] <- c("browseAll", "recover", s4.group.generics)
71stop.list[["tools"]] <- c("write_PACKAGES", # problems with Packages/PACKAGES
72                          "update_PACKAGES",
73                          "dependsOnPkgs", # call to installed.packages() slow w/ large library
74                          "testInstalledBasic",
75                          "testInstalledPackages", # runs whole suite
76                          "readNEWS",              # slow, pure R code
77                          "findHTMLlinks", "pskill",
78                          "texi2dvi", "texi2pdf",  # hang on Windows
79                          "getVignetteInfo",       # very slow on large installation
80                          "CRAN_package_db",       # slow, pure R code
81                          "CRAN_check_results",
82                          "CRAN_check_details",
83                          "CRAN_memtest_notes",
84                          "summarize_CRAN_check_status",
85                          "startDynamicHelp"       # makes R hang on exit
86                                                   # on Windows
87                          )
88stop.list[["grDevices"]] <- dev.int
89stop.list[["utils"]] <- c("Rprof", "aspell", # hangs on Windows
90                          "winProgressBar",
91                          "chooseBioCmirror",# too slow, R code
92                          inet.list, socket.fun, edit.int, misc.int, misc.2)
93
94sink("no-segfault.R")
95
96if(.Platform$OS.type == "unix") cat('options(pager = "cat")\n')
97if(.Platform$OS.type == "windows") cat('options(pager = "console")\n')
98cat('options(error=expression(NULL))',
99    "# don't stop on error in batch\n##~~~~~~~~~~~~~~\n")
100
101cat(".libPaths(tail(.libPaths(), 1), include.site=FALSE) # no extra libraries (w/ many pkgs)\n")
102
103cat(".proctime00 <- proc.time()\n")
104
105for (pkg in core.pkgs) {
106  cat("### Package ", pkg, "\n",
107      "###         ", rep("~",nchar(pkg)), "\n", collapse="", sep="")
108  pkgname <- paste("package", pkg, sep=":")
109  this.pos <- match(paste("package", pkg, sep=":"), search())
110  lib.not.loaded <- is.na(this.pos)
111  if(lib.not.loaded) {
112      library(pkg, character = TRUE, warn.conflicts = FALSE)
113      cat("library(", pkg, ")\n")
114  }
115  this.pos <- match(paste("package", pkg, sep=":"), search())
116
117  for(nm in ls(pkgname)) { # <==>  no '.<name>' functions are tested here
118      if(!(nm %in% stop.list[[pkg]]) &&
119	 is.function(f <- get(nm, pos = pkgname))) {
120	  cat("\n## ", nm, " :\n")
121
122	  cat("c0 <- character(0)\n",
123	      "l0 <- logical(0)\n",
124	      "m0 <- matrix(1,0,0)\n",
125	      "df0 <- as.data.frame(c0)\n", sep="")
126
127	  cat("f <- get(\"",nm,"\", pos = '", pkgname, "')\n", sep="")
128	  cat("f()\nf(NULL)\nf(,NULL)\nf(NULL,NULL)\n",
129	      "f(list())\nf(l0)\nf(c0)\nf(m0)\nf(df0)\nf(FALSE)\n",
130	      "f(list(),list())\nf(l0,l0)\nf(c0,c0)\n",
131              "f(df0,df0)\nf(FALSE,FALSE)\n",
132	      sep="")
133      }
134  }
135  if(lib.not.loaded) {
136      detach(pos=this.pos)
137      cat("detach(pos=", this.pos, ")\n", sep="")
138  }
139
140  cat("\n##__________\n\n")
141}
142
143cat("proc.time() - .proctime00\n")
144