Quick and dirty smoke test infrastructure

.Rbuildignore

@@ -6,6 +6,7 @@
 ^shiny\.cmd$
 ^run\.R$
 ^\.gitignore$
+^smoketests$
 ^res$
 ^man-roxygen$
 ^\.travis\.yml$

smoketests/.gitignore

@@ -0,0 +1 @@
+output

smoketests/README.md

@@ -0,0 +1,19 @@
+## Smoke tests
+
+This directory contains application subdirectories that produce deterministic output on stdout/stderr. After flushing output once, each app exits (due to `session$onFlushed(stopApp)`).
+
+`Rscript snapshot.R` runs each app and visits it using phantomjs. The resulting stdout/stderr output is written to an `R.out.save` file in the app directory.
+
+`Rscript test.R` also runs each app, but instead of saving to `R.out.save`, the results are compared to the `R.out.save` and any discrepancy is reported as test failure.
+
+### Prerequisites
+
+`phantomjs` must be in your path (tested with phantomjs 1.9, but later versions should be fine). On Ubuntu this is simply `apt-get install phantomjs`. On Mac if you have homebrew you can do `brew install phantomjs`. Otherwise, see http://phantomjs.org/download.html.
+
+### Adding tests
+
+1. Create a new directory and put either an app.R file or ui.R/server.R pair.
+2. Add the line `session$onFlushed(stopApp)` to your server function.
+3. Add whatever logic to emit info to stdout/stderr.
+4. Run `Rscript snapshot.R`.
+5. Add the new directory to git.

smoketests/functions.R

@@ -0,0 +1,37 @@
+appdirs <- function() {
+  res <- list.dirs(full.names = FALSE, recursive = FALSE)
+  res[res != "output"]
+}
+
+executeApp <- function(appPath) {
+  if (system2("which", "phantomjs", stdout = NULL) != 0) {
+    stop("phantomjs must be installed and on the system path")
+  }
+
+  system2("phantomjs", "visit.js", wait = FALSE)
+  result <- system2(
+  	"R",
+	c("--slave", "-e",
+      shQuote(sprintf("shiny::runApp('%s', port = 8765)", appPath))
+	),
+    stdout = TRUE, stderr = TRUE
+  )
+  gsub(getwd(), "${PWD}", result)
+}
+
+# Returns TRUE if the files indicated in artifactPaths exist, and
+# have mtimes that are later than or equal to all the other mtimes
+# in the dir.
+# Example:
+# upToDate("./bin", "a.out")
+upToDate <- function(dirname, artifactPaths) {
+  files <- list.files(dirname, recursive = TRUE)
+  if (!all(artifactPaths %in% files)) {
+    # One or more artifacts missing
+    return(FALSE)
+  }
+  times <- file.mtime(file.path(dirname, files))
+  artifactTimes <- times[files %in% artifactPaths]
+
+  max(artifactTimes) >= max(times)
+}

smoketests/snapshot.R

@@ -0,0 +1,13 @@
+source("functions.R")
+
+for (dir in appdirs()) {
+  snapshotPath <- file.path(dir, "R.out.save")
+  if (upToDate(dir, "R.out.save"))
+    next
+
+  cat("Snapshotting", dir, "\n")
+  res <- executeApp(dir)
+  writeLines(res, snapshotPath)
+}
+
+invisible()

smoketests/stacktrace1/R.out.save

@@ -0,0 +1,17 @@
+Loading required package: shiny
+Loading required package: methods
+
+Listening on http://127.0.0.1:8765
+Warning: Error in badfunc: boom
+Stack trace (innermost first):
+    113: badfunc [${PWD}/stacktrace1/app.R#4]
+    112: reactive A [${PWD}/stacktrace1/app.R#8]
+    101: A [/home/jcheng/development/shiny/R/reactives.R#376]
+    100: reactive B [${PWD}/stacktrace1/app.R#12]
+     89: B [/home/jcheng/development/shiny/R/reactives.R#376]
+     88: reactive C [${PWD}/stacktrace1/app.R#16]
+     77: C [/home/jcheng/development/shiny/R/reactives.R#376]
+     76: renderPlot [${PWD}/stacktrace1/app.R#27]
+     68: output$foo [/home/jcheng/development/shiny/R/render-plot.R#111]
+      1: shiny::runApp [/home/jcheng/development/shiny/R/server.R#685]
+NULL

smoketests/stacktrace1/app.R

@@ -0,0 +1,31 @@
+library(shiny)
+
+badfunc <- function() {
+  stop("boom")
+}
+
+A <- reactive({
+  badfunc()
+})
+
+B <- reactive({
+  A()
+})
+
+C <- reactive({
+  B()
+})
+
+ui <- fluidPage(
+  plotOutput("foo")
+)
+
+server <- function(input, output, session) {
+  session$onFlushed(stopApp)
+
+  output$foo <- renderPlot({
+    C()
+  })
+}
+
+shinyApp(ui, server)

smoketests/stacktrace2/R.out.save

@@ -0,0 +1,27 @@
+Loading required package: shiny
+Loading required package: methods
+
+Listening on http://127.0.0.1:8765
+Warning: Error in badfunc: boom
+Stack trace (innermost first):
+    106: badfunc [${PWD}/stacktrace2/app.R#4]
+    105: reactive A [${PWD}/stacktrace2/app.R#8]
+     94: A [/home/jcheng/development/shiny/R/reactives.R#376]
+     93: reactive B [${PWD}/stacktrace2/app.R#12]
+     82: B [/home/jcheng/development/shiny/R/reactives.R#376]
+     81: reactive C [${PWD}/stacktrace2/app.R#16]
+     70: C [/home/jcheng/development/shiny/R/reactives.R#376]
+     69: renderText [${PWD}/stacktrace2/app.R#28]
+     68: func
+     67: output$foo [/home/jcheng/development/shiny/R/shinywrappers.R#280]
+      1: shiny::runApp [/home/jcheng/development/shiny/R/server.R#685]
+Warning: Error in doTryCatch: 
+Stack trace (innermost first):
+    73: <Anonymous>
+    72: stop
+    71: C [/home/jcheng/development/shiny/R/reactives.R#384]
+    70: renderDataTable [${PWD}/stacktrace2/app.R#31]
+    69: func
+    68: output$bar [/home/jcheng/development/shiny/R/shinywrappers.R#456]
+     1: shiny::runApp [/home/jcheng/development/shiny/R/server.R#685]
+NULL

smoketests/stacktrace2/app.R

@@ -0,0 +1,35 @@
+library(shiny)
+
+badfunc <- function() {
+  stop("boom")
+}
+
+A <- reactive({
+  badfunc()
+})
+
+B <- reactive({
+  A()
+})
+
+C <- reactive({
+  B()
+})
+
+ui <- fluidPage(
+  textOutput("foo"),
+  dataTableOutput("bar")
+)
+
+server <- function(input, output, session) {
+  session$onFlushed(stopApp)
+
+  output$foo <- renderText({
+    C()
+  })
+  output$bar <- renderDataTable({
+    C()
+  })
+}
+
+shinyApp(ui, server)

smoketests/test.R

@@ -0,0 +1,27 @@
+source("functions.R")
+
+options(warn = 1)
+
+failures <- 0
+for (dir in appdirs()) {
+  cat("Testing", dir, "\n")
+
+  snapshotPath <- file.path(dir, "R.out.save")
+  if (!upToDate(dir, "R.out.save")) {
+    warning(dir, " snapshot may be out of date")
+  }
+
+  res <- executeApp(dir)
+  if (!identical(readLines(snapshotPath), res)) {
+    resultPath <- file.path("output", dir, "R.out")
+    dir.create(dirname(resultPath), showWarnings = FALSE, recursive = TRUE, mode = "0775")
+    writeLines(res, resultPath)
+    message("Results differ! Writing output to ", resultPath)
+    failures <- failures + 1
+  }
+}
+
+if (failures) {
+  cat(file = stderr(), paste0("--\n", failures, " test(s) failed\n"))
+  q("no", status = 1)
+}

smoketests/visit.js

@@ -0,0 +1,8 @@
+var page = require('webpage').create();
+setTimeout(function() {
+  page.open('http://localhost:8765', function(status) {
+    setTimeout(function() {
+      phantom.exit();
+    }, 1000);
+  });
+}, 1000);