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