Use both Remote* and Github* fields for GitHub remotes (#746)

* prioritize RemoteSubDir; fall back to GithubSubDir

* add test

* fall back to Remote* fields in getRemoteInfo()

* Add NEWS.md bullet

Author: karawoo

NEWS.md

@@ -1,5 +1,8 @@
 # packrat (development version)
 
+- When restoring GitHub-hosted packages, packrat will now look for both
+  `Github*` and `Remote*` fields to determine where to install from. (#740)
+
 # packrat 0.9.3
 
 - Update vendored `renv` with support for additional Linux distributions when

R/remote-info.R

@@ -13,11 +13,11 @@ getRemoteInfo <- function(pkgRecord) {
       as.data.frame(
         as.list(c(
           RemoteType = pkgRecord$source,
-          GithubRepo = pkgRecord$gh_repo,
-          GithubUsername = pkgRecord$gh_username,
-          GithubRef = pkgRecord$gh_ref,
-          GithubSHA1 = pkgRecord$gh_sha1,
-          GithubSubdir = pkgRecord$gh_subdir
+          GithubRepo = pkgRecord$gh_repo %||% pkgRecord$remote_repo,
+          GithubUsername = pkgRecord$gh_username %||% pkgRecord$remote_username,
+          GithubRef = pkgRecord$gh_ref %||% pkgRecord$remote_ref,
+          GithubSHA1 = pkgRecord$gh_sha1 %||% pkgRecord$remote_sha,
+          GithubSubdir = pkgRecord$gh_subdir %||% pkgRecord$remote_subdir
         )),
         stringsAsFactors = FALSE
       )

R/restore.R

@@ -1152,12 +1152,15 @@ appendRemoteInfoToDescription <- function(src, dest, remote_info) {
     basedir <- scratchDir
   }
 
-  # Determine the true package root
-  if (remote_info$RemoteType == "github") {
-    remote_subdir <- remote_info$GithubSubdir
-  } else {
+  # Determine the true package root. RemoteSubDir is the more modern way of
+  # recording this info, but in some cases GithubSubDir may be used instead (or
+  # in addition). If package isn't in a subdirectory, then both should be NULL.
+  if (!is.null(remote_info$RemoteSubdir)) {
     remote_subdir <- remote_info$RemoteSubdir
+  } else {
+    remote_subdir <- remote_info$GithubSubdir
   }
+
   if (length(remote_subdir) > 0) {
     basedir <- file.path(basedir, remote_subdir)
   }

R/utils.R

@@ -812,3 +812,7 @@ verboseLogger <- function(verbose) {
     function(...) {}
   }
 }
+
+`%||%` <- function(x, y) {
+  if (is.null(x)) y else x
+}

tests/testthat/test-remote-info.R

@@ -90,3 +90,27 @@ test_that("remote_info is correctly generated from a GitLab pkgRecord with a sub
   )
   expect_identical(getRemoteInfo(pkgRecordGitlabSubdir), expected)
 })
+
+test_that("remote_info for a GitHub source falls back to Remote* fields if GIthub* ones are missing (but prioritize Github* ones)", {
+  pkgRecordGithubSubdir <- list(
+    name = "subadder",
+    source = "github",
+    version = "0.9.3.1",
+    gh_repo = "sub_adder",
+    remote_repo = "something_else",
+    remote_username = "my-username",
+    remote_ref = "HEAD",
+    remote_sha1 = "abc123",
+    remote_subdir = "subadder"
+  )
+  expected <- data.frame(
+    RemoteType = "github",
+    GithubRepo = "sub_adder",
+    GithubUsername = "my-username",
+    GithubRef = "HEAD",
+    GithubSHA1 = "abc123",
+    GithubSubdir = "subadder",
+    stringsAsFactors = FALSE
+  )
+  expect_identical(getRemoteInfo(pkgRecordGithubSubdir), expected)
+})

tests/testthat/test-restore.R

@@ -103,3 +103,50 @@ test_that("annotatePkgDesc annotates a package description", {
   expect_equal(result$InstallAgent, paste('packrat', packageVersion('packrat')))
   expect_equal(result$InstallSource, "CRAN")
 })
+
+test_that("appendRemoteInfoToDescription uses RemoteSubdir", {
+  parent_dir <- withr::local_tempdir()
+  dest_dir <- withr::local_tempdir()
+  # create package dir with subdirectory
+  src_dir <- file.path(parent_dir, "bread", "toast")
+  dir.create(src_dir, recursive = TRUE)
+
+  writeLines(
+    readLines(test_path("packages/toast/DESCRIPTION")),
+    file.path(src_dir, "DESCRIPTION")
+  )
+
+  parent_tarball <- paste0(parent_dir, ".tar.gz")
+  dest_tarball <- paste0(dest_dir, ".tar.gz")
+
+  in_dir(
+    parent_dir,
+    tar(
+      tarfile = parent_tarball,
+      files = "bread",
+      compression = "gzip",
+      tar = tar_binary()
+    )
+  )
+
+  remote_info <- data.frame(
+    RemoteType = "github",
+    RemoteHost = "github.com",
+    RemoteRepo = "bread",
+    RemoteUsername = "breakfaster",
+    RemoteRef = "HEAD",
+    RemoteSha = "abc123",
+    RemoteSubdir = "toast",
+    stringsAsFactors = FALSE
+  )
+
+  appendRemoteInfoToDescription(
+    src = parent_tarball,
+    dest = dest_tarball,
+    remote_info = remote_info
+  )
+
+  untar(dest_tarball, exdir = dest_dir, tar = tar_binary())
+  desc <- readLines(file.path(dest_dir, "toast", "DESCRIPTION"))
+  expect_true("RemoteSubdir: toast" %in% desc)
+})