ROBUSTNESS: Have devNew() check with capabilities() first

[HenrikBengtsson]

Have devNew() check with capabilities() first and either give an informative warning or an error if requested device type is not supported.

This is what's available

> capabilities()
       jpeg         png        tiff       tcltk         X11        aqua
       TRUE        TRUE        TRUE        TRUE       FALSE       FALSE
   http/ftp     sockets      libxml        fifo      cledit       iconv
       TRUE        TRUE        TRUE        TRUE        TRUE        TRUE
        NLS     profmem       cairo         ICU long.double     libcurl
       TRUE       FALSE        TRUE        TRUE        TRUE       FALSE

> types <- c('jpeg', 'png', 'tiff', 'X11', 'aqua', 'cairo')
> capabilities(types)
 jpeg   png  tiff   X11  aqua cairo
 TRUE  TRUE  TRUE FALSE FALSE  TRUE

> capabilities("X11")
  X11
FALSE

[HenrikBengtsson]

Background: This might fix/detect/ prevent what looks like a core dump(?) - "aborting..." - on CRAN Solaris machines:

checking for unstated dependencies in ‘tests’ ... OK
checking tests ... ERROR
Running the tests in ‘tests/devEval.R’ failed.
Last 13 lines of output:
1: .External2(C_X11, d$display, d$width, d$height, d$pointsize, d$gamma, d$colortype, d$maxcubesize, d$bg, d$canvas, d$fonts, NA_integer_, d$xpos, d$ypos, d$title, type, antialias, d$family)
2: (function (display = "", width, height, pointsize, gamma, bg, canvas, fonts, family, xpos, ypos, title, type, antialias, ...) { if (display != "XImage") { check <- Sys.getenv("_R_CHECK_SCREEN_DEVICE_", "") msg <- "screen devices should not be used in examples etc" if (identical(check, "stop")) stop(msg, domain = NA) else if (identical(check, "warn")) warning(msg, immediate. = TRUE, noBreaks. = TRUE, domain = NA) } if (display == "" && .Platform$GUI == "AQUA" && is.na(Sys.getenv("DISPLAY", NA))) Sys.setenv(DISPLAY = ":0") new <- list() if (!missing(display)) new$display <- display if (!missing(width)) new$width <- width if (!missing(height)) new$height <- height if (!missing(gamma)) new$gamma <- gamma if (!missing(pointsize)) new$pointsize <- pointsize if (!missing(bg)) new$bg <- bg if (!missing(canvas)) new$canvas <- canvas if (!missing(xpos)) new$xpos <- xpos if (!missing(ypos)) new$ypos <- ypos if (!missing(title)) new$title <- title if (!checkIntFormat(new$title)) stop("invalid 'title'") if (!missing(type)) { new$type <- match.arg(type, c("Xlib", "cairo", "nbcairo", "dbcairo")) if (!capabilities("cairo") && type != "Xlib") warning("cairo-based types are not supported on this build - using \"Xlib\"") } if (!missing(family)) new$family <- family if (!missing(fonts)) new$fonts <- fonts if (!missing(antialias) && type != "Xlib") new$antialias <- match.arg(antialias, aa.cairo) d <- check.options(new, name.opt = ".X11.Options", envir = .X11env) if (d$type == "Xlib" && !missing(family)) { fns <- X11Fonts() if (!family %in% names(fns)) stop("unknown family for X11(type = \"XLib\")") d$fonts[1] <- fns[[family]] } type <- if (capabilities("cairo")) switch(d$type, cairo = 1L, nbcairo = 2L, dbcairo = 3L, 0L) else 0L if (display == "XImage") type <- 0L antialias <- match(d$antialias, aa.cairo) if (grepl("darwin", R.version$os)) check_for_XQuartz() .External2(C_X11, d$display, d$width, d$height, d$pointsize, d$gamma, d$colortype, d$maxcubesize, d$bg, d$canvas, d$fonts, NA_integer_, d$xpos, d$ypos, d$title, type, antialias, d$family) invisible()})()
3: do.call(typeT, args = args)
4: devNew(type, which = fullname, ..., .allowUnknownArgs = .allowUnknownArgs)
5: devEval(type = type, expr = expr, initially = NULL, finally = NULL, envir = envir, name = nameOrg, tags = tags, sep = sep, ..., ext = ext, filename = filename, path = path, field = field, onIncomplete = onIncomplete, force = force, .exprAsIs = TRUE, .allowUnknownArgs = TRUE)
6: FUN(X[[i]], ...)
7: lapply(types, FUN = function(type) { devEval(type = type, expr = expr, initially = NULL, finally = NULL, envir = envir, name = nameOrg, tags = tags, sep = sep, ..., ext = ext, filename = filename, path = path, field = field, onIncomplete = onIncomplete, force = force, .exprAsIs = TRUE, .allowUnknownArgs = TRUE)})
8: devEval(type, name = "any", aspectRatio = 2/3, scale = 1.2, { plot(100:1)})
9: doTryCatch(return(expr), name, parentenv, handler)
10: tryCatchOne(expr, names, parentenv, handlers[[1L]])
11: tryCatchList(expr, classes, parentenv, handlers)
12: tryCatch({ res <- devEval(type, name = "any", aspectRatio = 2/3, scale = 1.2, { plot(100:1) }) printf("Result: %s (%s)\n\n", sQuote(res), attr(res, "type")) devOff()}, error = function(ex) { printf("Failed: %s\n\n", sQuote(ex$message))})
aborting ...
checking for unstated dependencies in vignettes ... OK

I'm not sure exactly which type is used, but I guess it's 99% the "x11" type. In any case, the above problem is triggered by the tests/devEval.R tests:

types <- list(
  "png|jpg|pdf",               # PNG, JPG and then PDF
  "dummy|png|jpg|pdf",         # "Non-existing", PNG, JPG and then PDF
  "quartz|x11|windows",        # Any interactive device (depending on OS)
  c("png|jpg", "x11|windows"), # PNG or JPG and then x11 or windows
  "eps|postscript|pdf",        # EPS, Postscript or PDF
  "jpeg2|jpeg",                # JPEG via bitmap() or via jpeg()
  "png,jpg|x11|windows"        # == c("png", "jpg|x11|windows")
)

devList0 <- devList()

for (type in types) {
  printf("Any of %s\n", paste(sQuote(type), collapse=" + "))

  # Use try-catch in case not supported on some test systems
  tryCatch({
    res <- devEval(type, name="any", aspectRatio=2/3, scale=1.2, {
      plot(100:1)
    })
    printf("Result: %s (%s)\n\n", sQuote(res), attr(res, "type"))

    devOff()
  }, error = function(ex) {
    printf("Failed: %s\n\n", sQuote(ex$message))
  })
} # for (type ...)

[HenrikBengtsson]

The problem with using capabilities("X11") is that it is only set when R is started (REFERENCE?). For instance, if starting R with X11 server disabled, then I get:

$ R --quiet
> capabilities("X11")
  X11
FALSE
> x11()
Error in .External2(C_X11, d$display, d$width, d$height, d$pointsize,  :
  unable to start device X11cairo
In addition: Warning message:
In x11() : unable to open connection to X11 display ''

If I then enable the X11 server, I still get that:

> capabilities("X11")
  X11
FALSE

but

> x11()

opens an X11 plot window.

The only way to have capabilities() reflect the change is to restart R, i.e.

$ R --quiet
> capabilities("X11")
 X11
TRUE

[HenrikBengtsson]

ACTION: Add

capabilitiesX11 <- function() {
  bin <- file.path(R.home("bin"), "Rscript")
  cmd <- "cat(capabilities('X11'))"
  value <- system2(bin, args=c("-e", dQuote(cmd)), stdout=TRUE)
  as.logical(value)
}

See also [Rd] capabilities("X11"): Force refresh from within R? (... and minor documentation issue)

[HenrikBengtsson]

Will not implement a check for device capabilities in devNew() at this point, but I did update the tests/devEval.R to check with capabilitiesX11() before testing on X11.