scale_fill_manual order test

test_scale_fill_manual.r

#!/usr/bin/Rscript

# To run this script:
# git bisect reset
# git bisect start master remotes/origin/ggplot-0.8.9
# git bisect run test_scale_fill_manual.r

# When finished:
# git bisect reset

# ====================================================
# bisect utility functions here
# ====================================================

bisect_runtest <- function(fun, on_error = NA, msg = "Running test...") {

  # Check that fun is a function -- easy to accidentally pass myfun()
  # instead of myfun.
  if (!is.function(fun)) {
    stop("'fun' is not a function. Make sure to pass 'myfunction' and not 'myfunction()'")
  }

  message(msg)

  if (is.na(on_error)) {
    error_fun <- function(e) {
      print(e)
      message("Error encountered in test.")
      return(NA)
    }
  } else if (on_error == TRUE) {
    error_fun <- function(e) {
      print(e)
      message("Error encountered in test.")
      return(TRUE)
    }
  } else if (on_error == FALSE) {
    error_fun <- function(e) {
      print(e)
      message("Error encountered in test.")
      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(pkgdir = ".", on_error = NA) {
  bisect_runtest(function() {
      load_all(pkgdir)
    }, 
    on_error = on_error,
    msg = paste("Loading package in directory", pkgdir))
}

bisect_return_interactive <- function () {
  while (1) {
    message("Mark this commit [g]ood, [b]ad, or [s]kip? ", appendLF = FALSE)
    
    # Need to use "stdin" to get user input in a script -- stdin() doesn't work
    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 {
      message(paste("Unknown response:", response))
    }
  }
}

bisect_load_and_test <- function(fun, pkgdir = ".", on_load_error = NA, on_run_error = NA) {
  bisect_load_all(pkgdir = pkgdir, on_error = on_load_error)
  bisect_runtest(fun = fun, on_error = on_run_error)
}


# ===========================================================
# Functions to quit with return code for marking commits

mark_commit_good <- function() {
  message("Returning code: good (0)\n")
  quit(status = 0)
}

mark_commit_bad <- function() {
  message("Returning code: bad (1)\n")
  quit(status = 1)
}

mark_commit_skip <- function() {
  message("Returning code: skip (125)\n")
  quit(status = 125)
}



# ====================================================
# Test code here
# ====================================================


cat("\n===== Running test script ======\n")

library(devtools)

# A test that requires visual inspection and manual response
testRunInteractive <- function() {

  dat <- data.frame(x=factor(1:3),
                     y=3,
                     g=c("A","B","B"))
  
  p <- ggplot(dat, aes(x=x,y=y,fill=g)) + geom_bar()
  
  # Not OK: Scale with three values, order BCA
  p2 <- p + scale_fill_manual(values=c("B"="blue", "C"="darkblue", "A"="lightblue"))


  # Need to manually open x11 window because we're in a script
  x11()

  ## >0breakpoints color not what I specified in scale_fill_manual!
  print(p2)

  # User must visually inspect and mark good/bad/skip
  bisect_return_interactive()
}

# If error, mark SKIP
bisect_load_and_test(testRunInteractive, pkgdir=".", on_run_error = NA)

The criteria (you need to enter manually):

• BAD: any of the three bars is missing
• GOOD: all three bars visible

To run this script:

git bisect reset
git bisect start master remotes/origin/ggplot-0.8.9
git bisect run test_scale_fill_manual.r

# When finished:
git bisect reset