no-segfault.Rin 4.99 KB
Newer Older
Radford Neal's avatar
Radford Neal committed
1 2 3 4 5 6 7 8 9 10
###-*- 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"] %in% "base", "Package"]}
core.pkgs <-
Radford Neal's avatar
Radford Neal committed
11
    core.pkgs[- match(c("methods", "parallel", "tcltk", "stats4"), core.pkgs, 0)]
Radford Neal's avatar
Radford Neal committed
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
## move methods to the end because it has side effects (overrides primitives)
## stats4 requires methods
core.pkgs <- c(core.pkgs, "methods", "stats4")

stop.list <- vector("list", length(core.pkgs))
names(stop.list) <- core.pkgs

## -- Stop List for base/graphics/utils:
edit.int <- c("fix", "edit", "edit.data.frame", "edit.matrix",
              "edit.default", "vi", "file.edit",
              "emacs", "pico", "xemacs", "xedit", "RSiteSearch", "help.request")

## warning: readLines will work, but read all the rest of the script
## warning: trace will load methods.
## warning: rm and remove zap c0, l0, m0, df0
## warning: parent.env(NULL) <- NULL creates a loop
## warning: browseVignettes lanuches many browser processes.
## news, readNEWS, rtags are slow, and R-only code.
misc.int <- c("browser", "browseVignettes", "bug.report", "checkCRAN",
              "getCRANmirrors", "lazyLoad", "menu", "repeat",
              "readLines", "package.skeleton", "trace", "recover",
              "rm", "remove", "parent.env<-",
              "builtins", "data", "help", "news", "rtags", "vignette",
              "installed.packages")
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", "pdf", "postscript",
             "xfig", "jpeg", "png", "pictex", "quartz",
Radford Neal's avatar
Radford Neal committed
44 45
             "svg", "tiff", "cairo_pdf", "cairo_ps",
             "getGraphicsEvent")
Radford Neal's avatar
Radford Neal committed
46
misc.2 <- c("asS4", "help.start", "browseEnv", "make.packages.html",
Radford Neal's avatar
Radford Neal committed
47 48 49 50 51 52 53 54
            "gctorture", "q", "quit", "restart", "try",
            "read.fwf", "source",## << MM thinks "FIXME"
            "data.entry", "dataentry", "de", apropos("^de\\."),
            "chooseCRANmirror", "setRepositories", "select.list", "View")
if(.Platform$OS.type == "windows") {
    dev.int <- c(dev.int, "bmp", "windows", "win.graph", "win.print",
                "win.metafile")
    misc.2 <- c(misc.2, "file.choose", "choose.files", "choose.dir",
Radford Neal's avatar
Radford Neal committed
55 56
    		"setWindowTitle", "loadRconsole",
                "arrangeWindows", "getWindowsHandles")
Radford Neal's avatar
Radford Neal committed
57 58 59 60 61 62 63 64 65 66 67 68 69
}

stop.list[["base"]] <-
    if(nchar(Sys.getenv("R_TESTLOTS"))) {## SEVERE TESTING, try almost ALL
	c(edit.int, misc.int)
    } else {
	c(inet.list, socket.fun, edit.int, misc.int, misc.2)
    }
## warning: browseAll will tend to read all the script and/or loop forever
stop.list[["methods"]] <- c("browseAll", "recover")
stop.list[["tools"]] <- c("write_PACKAGES", # problems with Packages/PACKAGES
                          "testInstalledBasic",
                          "testInstalledPackages", # runs whole suite
Radford Neal's avatar
Radford Neal committed
70 71 72 73
                          "readNEWS",              # slow, pure R code
                          "findHTMLlinks", "pskill",
                          "texi2dvi", "texi2pdf"   # hang on Windows
                          )
Radford Neal's avatar
Radford Neal committed
74 75
stop.list[["ts"]] <- c("arma0f", "KalmanLike")
stop.list[["grDevices"]] <- dev.int
Radford Neal's avatar
Radford Neal committed
76 77
stop.list[["utils"]] <- c("Rprof", "aspell", # hangs on Windows
                          inet.list, socket.fun, edit.int, misc.int, misc.2)
Radford Neal's avatar
Radford Neal committed
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

sink("no-segfault.R")

if(.Platform$OS.type == "unix") cat('options(pager = "cat")\n')
if(.Platform$OS.type == "windows") cat('options(pager = "console")\n')
cat('options(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="")
  pkgname <- paste("package", pkg, sep=":")
  this.pos <- match(paste("package", pkg, sep=":"), search())
  lib.not.loaded <- is.na(this.pos)
  if(lib.not.loaded) {
      library(pkg, character = TRUE, warn.conflicts = FALSE)
      cat("library(", pkg, ")\n")
  }
  this.pos <- match(paste("package", pkg, sep=":"), search())

  for(nm in ls(pkgname)) {
      if(!(nm %in% stop.list[[pkg]]) &&
	 is.function(f <- get(nm, pos = pkgname))) {
	  cat("\n## ", nm, " :\n")
	  cat("f <- get(\"",nm,"\", pos = '", pkgname, "')\n", sep="")
	  cat("f()\nf(NULL)\nf(,NULL)\nf(NULL,NULL)\n",
	      "f(list())\nf(l0)\nf(c0)\nf(m0)\nf(df0)\nf(FALSE)\n",
	      "f(list(),list())\nf(l0,l0)\nf(c0,c0)\n",
              "f(df0,df0)\nf(FALSE,FALSE)\n",
	      sep="")
      }
  }
  if(lib.not.loaded) {
      detach(pos=this.pos)
      cat("detach(pos=", this.pos, ")\n", sep="")
  }

  cat("\n##__________\n\n")
}

cat("proc.time() - .proctime00\n")