installPkg: do no work when using cached package and annotate safely

R/restore.R

@@ -391,16 +391,10 @@ annotatePkgDesc <- function(pkgRecord, project, lib = libDir(project)) {
     content[name] <- records[name]
   }
 
-  # Write it out
-  write_dcf(content, descFile)
-}
-
-# Annotate a set of packages by name.
-annotatePkgs <- function(pkgNames, project, lib = libDir(project)) {
-  records <- searchPackages(lockInfo(project), pkgNames)
-  lapply(records, function(record) {
-    annotatePkgDesc(record, project, lib)
-  })
+  # Write it out using a temporary file so DESCRIPTION is never partial.
+  tmpf <- tempfile(tmpdir = dirname(descFile))
+  write_dcf(content, tmpf)
+  file.rename(tmpf, descFile)
 }
 
 # Takes a vector of package names, and returns a logical vector that indicates
@@ -433,10 +427,6 @@ installPkg <- function(pkgRecord,
                        repos,
                        lib = libDir(project))
 {
-  pkgSrc <- NULL
-  type <- "built source"
-  needsInstall <- TRUE
-
   # If we're trying to install a package that overwrites a symlink, e.g. for a
   # cached package, we need to move that symlink out of the way (otherwise
   # `install.packages()` or `R CMD INSTALL` will fail with surprising errors,
@@ -451,7 +441,6 @@ installPkg <- function(pkgRecord,
   # NOTE: a symlink that points to a path that doesn't exist
   # will return FALSE when queried by `file.exists()`!
   if (file.exists(pkgInstallPath) || is.symlink(pkgInstallPath)) {
-
     temp <- tempfile(tmpdir = lib)
     file.rename(pkgInstallPath, temp)
     on.exit({
@@ -467,23 +456,21 @@ installPkg <- function(pkgRecord,
   cacheCopyStatus <- new.env(parent = emptyenv())
   copiedFromCache <- restoreWithCopyFromCache(project, pkgRecord, cacheCopyStatus)
   if (copiedFromCache) {
-    type <- cacheCopyStatus$type
-    needsInstall <- FALSE
+    return(cacheCopyStatus$type)
   }
 
   # Try restoring the package from the 'unsafe' cache, if applicable.
   copiedFromUntrustedCache <- restoreWithCopyFromUntrustedCache(project, pkgRecord, cacheCopyStatus)
   if (copiedFromUntrustedCache) {
-    type <- cacheCopyStatus$type
-    needsInstall <- FALSE
+    return(cacheCopyStatus$type)
   }
 
-  # if we still need to attempt an installation at this point,
-  # remove a prior installation / file from library (if necessary).
-  # we move the old directory out of the way temporarily, and then
+  # The package was not in a cache and needs to be installed.
+  # Remove a prior installation / file from library (if necessary).
+  # We move the old directory out of the way temporarily, and then
   # delete if if all went well, or restore it if installation failed
-  # for some reason
-  if (needsInstall && file.exists(pkgInstallPath)) {
+  # for some reason.
+  if (file.exists(pkgInstallPath)) {
     pkgRenamePath <- tempfile(tmpdir = lib)
     file.rename(pkgInstallPath, pkgRenamePath)
     on.exit({
@@ -494,9 +481,11 @@ installPkg <- function(pkgRecord,
     }, add = TRUE)
   }
 
+  type <- "built source"
+  needsInstall <- TRUE
+
   # Try downloading a binary (when appropriate).
-  if (!(copiedFromCache || copiedFromUntrustedCache) &&
-      hasBinaryRepositories() &&
+  if (hasBinaryRepositories() &&
       binaryRepositoriesEnabled() &&
       isFromCranlikeRepo(pkgRecord, repos) &&
       pkgRecord$name %in% availablePackagesBinary(repos = repos)[, "Package"] &&
@@ -531,14 +520,11 @@ installPkg <- function(pkgRecord,
     })
   }
 
-  if (is.null(pkgSrc)) {
+  if (needsInstall) {
     # When installing from github/bitbucket/gitlab or an older version, use the cached source
     # tarball or zip created in snapshotSources
     pkgSrc <- file.path(srcDir(project), pkgRecord$name,
                         pkgSrcFilename(pkgRecord))
-  }
-
-  if (needsInstall) {
 
     if (!file.exists(pkgSrc)) {
       # If the source file is missing, try to download it. (Could happen in the

tests/testthat/test-restore.R

@@ -67,3 +67,32 @@ test_that("appendRemoteInfoToDescription modifies DESCRIPTION file", {
   expect_identical(tail(desc, 6), expected_desc_tail)
   getwd()
 })
+
+test_that("annotatePkgDesc annotates a package description", {
+  project <- tempfile()
+  dir.create(project)
+  lib <- libDir(project)
+  package <- file.path(lib, "fake")
+  dir.create(package, recursive = TRUE)
+  desc <- file.path(package, "DESCRIPTION")
+  write_dcf(
+    list(
+      Package = "fake",
+      Version = "1.2.3",
+      InstallAgent = "testthat"
+    ),
+    desc
+  )
+  pkgRecord <- list(
+    name = "fake",
+    source = "CRAN",
+    version = "1.2.3"
+  )
+
+  annotatePkgDesc(pkgRecord, project)
+  result <- as.data.frame(readDcf(desc))
+  expect_equal(result$Package, "fake")
+  expect_equal(result$Version, "1.2.3")
+  expect_equal(result$InstallAgent, paste('packrat', packageVersion('packrat')))
+  expect_equal(result$InstallSource, "CRAN")
+})