Skip to content

Instantly share code, notes, and snippets.

@wch
Created February 2, 2012 06:24
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save wch/1721954 to your computer and use it in GitHub Desktop.
Save wch/1721954 to your computer and use it in GitHub Desktop.
bisect test for geom_rug_alt() problem in granovaGG
#!/usr/bin/Rscript
# =========================================
# Functions for devtools
# =========================================
mark_commit_good <- function() {
cat("Returning code: good (0)\n\n")
quit(status = 0)
}
mark_commit_bad <- function() {
cat("Returning code: bad (1)\n\n")
quit(status = 1)
}
mark_commit_skip <- function() {
cat("Returning code: skip (125)\n\n")
quit(status = 125)
}
# Call this function from within the test when an interactive response
# is needed
bisect_return_interactive <- function () {
while (1) {
cat("Mark this commit [g]ood, [b]ad, or [s]kip? ")
response <- scan("stdin", what = character(), n = 1, quiet = TRUE)
if (identical(tolower(response), "g")) {
return(TRUE)
} else if (identical(tolower(response), "b")) {
return(FALSE)
} else if (identical(tolower(response), "s")) {
return(NA)
} else {
cat(sprintf("Unknown response: '%s'\n", response))
}
}
}
bisect_test <- function(fun, on_error = NA, message = "\nRunning test...\n") {
cat(message)
if (is.na(on_error)) {
error_fun <- function(e) {
print(e)
cat("Error encountered in test\n")
return(NA)
}
} else if (on_error == TRUE) {
error_fun <- function(e) {
print(e)
cat("Error encountered in test\n")
return(TRUE)
}
} else if (on_error == FALSE) {
error_fun <- function(e) {
print(e)
cat("Error encountered in test\n")
return(FALSE)
}
}
status <- tryCatch(fun(), error = error_fun)
if (is.null(status)) {
# Return NULL, but don't print
invisible(NULL)
} else if (is.na(status)) {
mark_commit_skip()
} else if (status == TRUE) {
mark_commit_good()
} else if (status == FALSE) {
mark_commit_bad()
}
}
bisect_load_all <- function(dir = ".", on_error = NA) {
bisect_test(function() {
dev_mode(TRUE)
load_all(dir)
},
on_error = on_error,
message = sprintf("Loading package in directory %s\n", dir))
}
# =========================================
# Tests go here
# =========================================
cat("\n===== Running test script ======\n")
library(devtools)
dev_mode(TRUE)
# Install the current commit version of ggplot2
install.packages('.', repos = NULL, type = "source")
load_all("../granovaGG")
library(ggplot2)
# The test code
test_rug_alt <- function() {
# Bad: Throws error in 0.9.0
p <- qplot(cty, hwy, data = mpg) + geom_rug_alt()
x11()
print(p)
# If it reaches this point, then it successfully printed. Mark GOOD
return(TRUE)
}
# If error, mark BAD
bisect_test(test_rug_alt, on_error = FALSE)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment