###-*- 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\.")) ## should be more selective here #threads <- c(apropos("Thread"), apropos("Mutex"), apropos("Condvar"), # "Concurrently", "EventLoop", ".Main") threads <- c("EventLoop", ".Main", "ReplConsole", "Snooze") c(inet.list, socket.fun, dev.int, edit.int, misc.int, misc.2, threads) } 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")