don't throw error when installing a pull request from GitHub using the format user/repo#pull

NEWS.md

@@ -20,6 +20,9 @@
 
 * `check_cran()` records check times for each package tested.
 
+* Fixed bug in `install_github()` that prevented installing a pull request by
+  supplying `repo = "username/repo#pull"`. (#388)
+
 * explicitly specify user agent when querying user name and ref for pull request
   in `install_github`. (Thanks to Kirill Müller, #405)
 

R/install-github.r

@@ -45,7 +45,7 @@ install_github <- function(repo, username = getOption("github.user"),
 }
 
 
-install_github_single <- function(repo, username = getOption("github.user"),
+github_get_conn <- function(repo, username = getOption("github.user"),
   ref = "master", pull = NULL, subdir = NULL, branch = NULL, auth_user = NULL,
   password = NULL, ...) {
 
@@ -57,8 +57,10 @@ install_github_single <- function(repo, username = getOption("github.user"),
   params <- github_parse_path(repo)
   username <- params$username %||% username
   repo <- params$repo
-  ref <- params$ref %||% ref
-  pull <- params$pull %||% pull
+  if (!is.null(params$ref %||% params$pull)) {
+    ref <- params$ref
+    pull <- params$pull
+  }
   subdir <- params$subdir %||% subdir
 
   if (!xor(is.null(pull), is.null(ref))) {
@@ -80,15 +82,26 @@ install_github_single <- function(repo, username = getOption("github.user"),
     auth <- list()
   }
 
-  message("Installing github repo ",
+  msg <- paste0("Installing github repo ",
     paste(repo, ref, sep = "/", collapse = ", "),
     " from ",
     paste(username, collapse = ", "))
-  name <- paste(username, "-", repo, sep = "")
 
   url <- paste("https://github.com/", username, "/", repo,
     "/archive/", ref, ".zip", sep = "")
 
+  list(url=url, auth=auth, msg=msg, repo=repo, username=username, ref=ref,
+       pull=pull, subdir=subdir, branch=branch, auth_user=auth_user,
+       password=password)
+}
+
+install_github_single <- function(repo, username = getOption("github.user"),
+                                  ref = "master", pull = NULL, subdir = NULL, branch = NULL, auth_user = NULL,
+                                  password = NULL, ...) {
+  conn <- github_get_conn(repo, username, ref, pull, subdir, branch, auth_user, password, ...)
+
+  message(conn$msg)
+
   # define before_install function that captures the arguments to 
   # install_github and appends the to the description file
   github_before_install <- function(bundle, pkg_path) {
@@ -106,25 +119,25 @@ install_github_single <- function(repo, username = getOption("github.user"),
     }
 
     # Append fields
-    append_field("Repo", repo)
-    append_field("Username", username)
-    append_field("Ref", ref)
+    append_field("Repo", conn$repo)
+    append_field("Username", conn$username)
+    append_field("Ref", conn$ref)
     append_field("SHA1", github_extract_sha1(bundle))
-    append_field("Pull", pull)
-    append_field("Subdir", subdir)
-    append_field("Branch", branch)
-    append_field("AuthUser", auth_user)
+    append_field("Pull", conn$pull)
+    append_field("Subdir", conn$subdir)
+    append_field("Branch", conn$branch)
+    append_field("AuthUser", conn$auth_user)
     # Don't record password for security reasons
-    #append_field("Password" password)
+    #append_field("Password", conn$password)
   }
 
   # If there are slashes in the ref, the URL will have extra slashes, but the
   # downloaded file shouldn't have them.
   # install_github("shiny", "rstudio", "v/0/2/1")
   #  URL: https://github.com/rstudio/shiny/archive/v/0/2/1.zip
   #  Output file: shiny.zip
-  install_url(url, name = paste(repo, ".zip", sep=""), subdir = subdir,
-    config = auth, before_install = github_before_install, ...)
+  install_url(conn$url, subdir = conn$subdir,
+    config = conn$auth, before_install = github_before_install, ...)
 }
 
 # Retrieve the username and ref for a pull request

tests/testthat/test-github.r

@@ -10,3 +10,32 @@ test_that("GitHub repo paths are parsed correctly", {
   expect_equal(github_parse_path("my/test/pkg#1"), list(username="my", repo="test", subdir="pkg", pull="1"))
   expect_error(github_parse_path("test#6@123"), "Invalid GitHub path")
 })
+
+test_that("GitHub URL is constructed correctly", {
+  # Mock github_pull_info() in a copy of github_get_conn() so that GitHub API is not queried for this test
+  github_pull_info <- function(repo, username, pull) { list(username=sprintf("user-%s", pull), ref=sprintf("pull-%s", pull)) }
+  github_get_conn <- devtools:::github_get_conn
+  formals(github_get_conn) <- c(formals(github_get_conn), list(github_pull_info=github_pull_info))
+
+  expect_equal(github_get_conn("devtools")$url, "https://github.com/hadley/devtools/archive/master.zip")
+  expect_equal(github_get_conn("krlmlr/kimisc")$url, "https://github.com/krlmlr/kimisc/archive/master.zip")
+  expect_equal(github_get_conn("my/test/pkg")$url, "https://github.com/my/test/archive/master.zip")
+  expect_equal(github_get_conn("devtools@devtools-1.4")$url, "https://github.com/hadley/devtools/archive/devtools-1.4.zip")
+  expect_equal(github_get_conn("yihui/tikzDevice#23", github_pull_info=github_pull_info)$url, "https://github.com/user-23/tikzDevice/archive/pull-23.zip")
+  expect_equal(github_get_conn("my/test/pkg@ref")$url, "https://github.com/my/test/archive/ref.zip")
+  expect_equal(github_get_conn("my/test/pkg#1", github_pull_info=github_pull_info)$url, "https://github.com/user-1/test/archive/pull-1.zip")
+  expect_error(github_get_conn("test#6@123")$url, "Invalid GitHub path")
+})
+
+test_that("GitHub parameters are returned correctly", {
+  # Mock github_pull_info() in a copy of github_get_conn() so that GitHub API is not queried for this test
+  github_pull_info <- function(repo, username, pull) { list(username=sprintf("user-%s", pull), ref=sprintf("pull-%s", pull)) }
+  github_get_conn <- devtools:::github_get_conn
+  formals(github_get_conn) <- c(formals(github_get_conn), list(github_pull_info=github_pull_info))
+
+  expect_equal(github_get_conn("devtools")$repo, "devtools")
+  expect_equal(github_get_conn("krlmlr/kimisc")$username, "krlmlr")
+  expect_equal(github_get_conn("my/test/pkg")$subdir, "pkg")
+  expect_equal(github_get_conn("devtools@devtools-1.4")$ref, "devtools-1.4")
+  expect_equal(github_get_conn("yihui/tikzDevice#23", github_pull_info=github_pull_info)$pull, "23")
+})