git bisect functions for R

bisect-tools.r

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))
}