Skip to content

Commit

Permalink
Merge pull request #117 from PredictiveEcology/patch1
Browse files Browse the repository at this point in the history 
bugfix minor
  • Loading branch information
@eliotmcintire
eliotmcintire authored Sep 27, 2024
2 parents 3940f06 + cf636e8 commit 3795dd7
Show file tree
Hide file tree
Showing 7 changed files with 165 additions and 82 deletions.
4 changes: 2 additions & 2 deletions DESCRIPTION
View file
Original file line number Diff line number Diff line change
Expand Up @@ -15,8 +15,8 @@ Description: A single key function, 'Require' that makes rerun-tolerant
URL:
https://Require.predictiveecology.org,
https://github.com/PredictiveEcology/Require
Date: 2024-08-06
Version: 1.0.1
Date: 2024-09-27
Version: 1.0.1.9001
Authors@R: c(
person(given = "Eliot J B",
family = "McIntire",
Expand Down
7 changes: 7 additions & 0 deletions NEWS.md
View file
Original file line number Diff line number Diff line change
@@ -1,5 +1,12 @@
# Require

version 1.0.2
=============

## Bugfixes
* minor
* `updatePackages` had 2 minor bugs that prevented some mixtures of necessary updates from being correctly identified.

version 1.0.1
=============

Expand Down
82 changes: 63 additions & 19 deletions R/Require-helpers.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -89,15 +89,24 @@ DESCRIPTIONFileVersionV <- function(file, purge = getOption("Require.purge", FAL
} else {
NULL
}
if (length(f) == 1) {
lines <- try(readLines(f), silent = TRUE)
if (is(lines, "try-error")) {
warning(lines)
lines <- character()
}
} else {
lines <- f
}

lines <- readLinesWithHandlers(f)
# if (length(f) == 1) {
# withCallingHandlers(
# lines <- try(readLines(f), silent = TRUE),
# warning = function(w)
# if (grepl('incomplete final line found on', w$message))
# invokeRestart("muffleWarning")
# )
# if (is(lines, "try-error")) {
# warning(lines)
# lines <- character()
# }
# if (isTRUE(any(grepl("404: Not Found", lines))))
# lines <- character()
# } else {
# lines <- f
# }
suppressWarnings({
vers_line <- lines[grep("^Version: *", lines)]
})
Expand All @@ -116,16 +125,27 @@ DESCRIPTIONFileVersionV <- function(file, purge = getOption("Require.purge", FAL
#' @param other Any other keyword in a `DESCRIPTION` file that precedes a ":".
#' The rest of the line will be retrieved.
DESCRIPTIONFileOtherV <- function(file, other = "RemoteSha") {
out <- lapply(file, function(f) {
if (length(f) == 1) {
lines <- try(readLines(f), silent = TRUE)
if (is(lines, "try-error")) {
warning(lines)
lines <- character()
}
} else {
lines <- f
}
out <- lapply(file, function(fff) {
lines <- readLinesWithHandlers(fff)
# if (length(fff) == 1) {
# withCallingHandlers(
# lines <- try(readLines(fff), silent = TRUE),
# warning = function(w) {
# if (grepl('incomplete final line found on', w$message))
# invokeRestart("muffleWarning")
# }
# )
#
# # lines <- try(readLines(fff), silent = TRUE)
# if (is(lines, "try-error")) {
# warning(lines)
# lines <- character()
# }
# if (isTRUE(any(grepl("404: Not Found", lines))))
# lines <- character()
# } else {
# lines <- fff
# }
suppressWarnings({
vers_line <- lines[grep(paste0("^", other, ": *"), lines)]
})
Expand Down Expand Up @@ -1780,3 +1800,27 @@ getGitCredsToken <- function() {
}
token
}


readLinesWithHandlers <- function(fff) {
if (length(fff) == 1) {
withCallingHandlers(
lines <- try(readLines(fff), silent = TRUE),
warning = function(w) {
if (grepl('incomplete final line found on', w$message))
invokeRestart("muffleWarning")
}
)

# lines <- try(readLines(fff), silent = TRUE)
if (is(lines, "try-error")) {
warning(lines)
lines <- character()
}
if (isTRUE(any(grepl("404: Not Found", lines))))
lines <- character()
} else {
lines <- fff
}
lines
}
132 changes: 81 additions & 51 deletions R/Require2.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -381,7 +381,7 @@ Require <- function(packages,
pkgDT <- dealWithStandAlone(pkgDT, libPaths, standAlone)
pkgDT <- whichToInstall(pkgDT, install, verbose)

pkgDT <- removeRequireDeps(pkgDT, verbose)
# pkgDT <- removeRequireDeps(pkgDT, verbose)

# Deal with "force" installs
set(pkgDT, NULL, "forceInstall", FALSE)
Expand Down Expand Up @@ -413,6 +413,7 @@ Require <- function(packages,
pkgDT <- pkgDTBase
}

pkgDT <- needToRestartR(pkgDT)
whRestartNeeded <- which(grepl("restart", pkgDT$installResult))
if (length(whRestartNeeded)) {
warning(.txtPleaseRestart, "; ", paste(pkgDT[whRestartNeeded]$Package, collapse = ", "),
Expand Down Expand Up @@ -452,13 +453,13 @@ Require <- function(packages,
noneAv <- pkgDT$installResult %in% .txtNoneAvailable
if (isTRUE(any(noneAv))) {
warning(messageCantInstallNoVersion(
paste(pkgDT[["packageFullName"]][which(noneAv)], collapse = ", ")))
paste(pkgDT[["packageFullName"]][which(noneAv)], collapse = ", ")), call. = FALSE)
}

noInternet <- pkgDT$installResult %in% .txtNoInternetNoLocalCantInstall
if (isTRUE(any(noInternet))) {
warning(messageCantInstallNoInternet(
paste(pkgDT[["packageFullName"]][which(noInternet)], collapse = ", ")))
paste(pkgDT[["packageFullName"]][which(noInternet)], collapse = ", ")), call. = FALSE)
}

return(invisible(out))
Expand Down Expand Up @@ -691,10 +692,12 @@ doInstalls <- function(pkgDT, repos, purge, libPaths, install.packagesArgs,
if (NROW(pkgDTList[[.txtInstall]])) {
pkgInstallList <- split(pkgInstall, by = "needInstall") # There are now ones that can't be installed b/c .txtNoneAvailable
pkgInstall <- pkgInstallList[[.txtInstall]]
if (!is.null(pkgInstallList[[.txtNoneAvailable]])) {
messageVerbose(messageCantInstallNoVersion(pkgInstallList[[.txtNoneAvailable]][["packageFullName"]]),
verbose = verbose, verboseLevel = 1)
}

# This next one is a warning at the end of installation. Removed this message Sep 27, 2024
# if (!is.null(pkgInstallList[[.txtNoneAvailable]])) {
# messageVerbose(messageCantInstallNoVersion(pkgInstallList[[.txtNoneAvailable]][["packageFullName"]]),
# verbose = verbose, verboseLevel = 1)
# }
if (!is.null(pkgInstallList[[.txtShaUnchangedNoInstall]])) {
messageVerbose(.txtShaUnchangedNoInstall, ": ", pkgInstallList[[.txtShaUnchangedNoInstall]][["packageFullName"]],
verbose = verbose, verboseLevel = 1)
Expand Down Expand Up @@ -2573,10 +2576,11 @@ updatePackages <- function(libPaths = .libPaths()[1], purge = FALSE,
ref <- ip$GithubRef
ineq <- "HEAD"
head <- paste0(" (", ineq, ")")
gsf <- !is.na(ip$GithubSubFolder) | nzchar(ip$GithubSubFolder) | ip$GithubSubFolder != "NA"
pkgs <- paste0(ifelse(
!is.na(ip$GithubRepo),
paste0(ip$GithubUsername, "/", ip$GithubRepo,
ifelse(is.na(ip$GithubSubFolder), "", paste0("/", ip$GithubSubFolder)),
ifelse(gsf, "", paste0("/", ip$GithubSubFolder)),
"@", ref, head),
# github
paste0(ip[["Package"]], head) # cran
Expand Down Expand Up @@ -3321,49 +3325,50 @@ colsOfDeps <- c("Depends", "Imports", "LinkingTo", "Remotes", "Suggests")


# Get Require dependencies to omit them: it has to exist locally unless this is first install
removeRequireDeps <- function(pkgDT, verbose) {
if (!is.data.table(pkgDT))
pkgDT <- toPkgDT(pkgDT)

# localRequireDir <- file.path(.libPaths(), "Require")
# de <- dir.exists(localRequireDir)
# if (any(de)) {
# localRequireDir <- localRequireDir[de][1]
# RequireDeps <- DESCRIPTIONFileDeps(file.path(localRequireDir, "DESCRIPTION"))
# } else {
# # if the package is loaded to memory from a different .libPaths() that is no longer on the current .libPaths()
# # then the next line will work to find it
# deps <- packageDescription("Require", lib.loc = NULL, fields = "Imports")
# if (nzchar(deps)) {
# RequireDeps <- depsWithCommasToVector("Require", depsWithCommas = deps)
# } else {
# RequireDeps <- pkgDep("Require", simplify = TRUE, verbose = 0)
# }
#
# }

whNeedInstall <- pkgDT[["needInstall"]] %in% .txtInstall
toRm <- pkgDT[["Package"]][whNeedInstall] %in% extractPkgName(unlist(.RequireDependencies))
if (any(toRm)) {
NeedRestart <- if (getOption("Require.installPackagesSys") > 0) {
# Can install when in a different process
pkgDT[["Package"]][whNeedInstall][toRm] %in% "Require"
} else {
FALSE
}

whRm <- which(whNeedInstall)[toRm]

# Try to install them anyway, but it will fail and report error
# set(pkgDT, whRm, "needInstall", .txtDontInstall)

set(pkgDT, whRm, "installed", TRUE)
set(pkgDT, whRm, "installResult", "Can't install Require dependency")
if (any(NeedRestart))
set(pkgDT, whRm, "installResult", "Need to restart R")
}
pkgDT
}
# removeRequireDeps <- function(pkgDT, verbose) {
# if (!is.data.table(pkgDT))
# pkgDT <- toPkgDT(pkgDT)
#
# # localRequireDir <- file.path(.libPaths(), "Require")
# # de <- dir.exists(localRequireDir)
# # if (any(de)) {
# # localRequireDir <- localRequireDir[de][1]
# # RequireDeps <- DESCRIPTIONFileDeps(file.path(localRequireDir, "DESCRIPTION"))
# # } else {
# # # if the package is loaded to memory from a different .libPaths() that is no longer on the current .libPaths()
# # # then the next line will work to find it
# # deps <- packageDescription("Require", lib.loc = NULL, fields = "Imports")
# # if (nzchar(deps)) {
# # RequireDeps <- depsWithCommasToVector("Require", depsWithCommas = deps)
# # } else {
# # RequireDeps <- pkgDep("Require", simplify = TRUE, verbose = 0)
# # }
# #
# # }
#
# # whNeedInstall <- pkgDT[["needInstall"]] %in% .txtInstall
# # toRm <- pkgDT[["Package"]][whNeedInstall] %in% extractPkgName(unlist(.RequireDependencies))
# # if (any(toRm)) {
# # NeedRestart <- if (getOption("Require.installPackagesSys") > 0) {
# # # Can install when in a different process
# # pkgDT[["Package"]][whNeedInstall][toRm] %in% "Require"
# # } else {
# # FALSE
# # }
# #
# # whRm <- which(whNeedInstall)[toRm]
# #
# # # Try to install them anyway, but it will fail and report error
# # # set(pkgDT, whRm, "needInstall", .txtDontInstall)
# #
# # set(pkgDT, whRm, "installed", TRUE)
# # set(pkgDT, whRm, "installResult", "Can't install Require dependency")
# # browser()
# # if (any(NeedRestart))
# # set(pkgDT, whRm, "installResult", "Need to restart R")
# # }
# pkgDT
# }


matchWithOriginalPackages <- function(pkgDT, packages) {
Expand Down Expand Up @@ -3964,3 +3969,28 @@ clearErrorReadRDSFile <- function(mess, libPath = .libPaths()[1]) {
}
}
}


needToRestartR <- function(pkgDT) {
whNeedInstall <- pkgDT[["needInstall"]] %in% .txtInstall
toRm <- pkgDT[["Package"]][whNeedInstall] %in% extractPkgName(unlist(.RequireDependencies))
if (any(toRm)) {
NeedRestart <- if (getOption("Require.installPackagesSys") > 0) {
# Can install when in a different process
pkgDT[["Package"]][whNeedInstall][toRm] %in% "Require"
} else {
FALSE
}

whRm <- which(whNeedInstall)[toRm]

# Try to install them anyway, but it will fail and report error
# set(pkgDT, whRm, "needInstall", .txtDontInstall)

set(pkgDT, whRm, "installed", TRUE)
set(pkgDT, whRm, "installResult", "Can't install Require dependency")
if (any(NeedRestart))
set(pkgDT, whRm, "installResult", "Need to restart R")
}
pkgDT
}
3 changes: 2 additions & 1 deletion R/pkgDep.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -348,9 +348,10 @@ DESCRIPTIONFileDeps <-
if (is.null(desc_path)) {
needed <- NULL
} else {

lines <- if (length(desc_path) == 1) {
# linesAll <- lapply(desc_path, read.dcf)
try(readLines(desc_path))
try(readLines(desc_path), silent = TRUE)
} else {
lines <- desc_path
}
Expand Down
17 changes: 9 additions & 8 deletions R/pkgDep3.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -749,13 +749,13 @@ updateWithRemotesNamespaceAddRepos2 <- function(pkgDT, which, purge, includeBase

out <- pkgDT[fe, list(# packageFullName = packageFullName,
lis = {
allDeps <- DESCRIPTIONFileDeps(DESCFile, which = c("Depends", "Imports", "Suggests", "LinkingTo"),
purge = purge, keepSeparate = TRUE)
needed <- allDeps[which]
notNeeded <- allDeps[setdiff(names(allDeps), which)]
neededAdditionalRepos <- DESCRIPTIONFileOtherV(DESCFile, other = "Additional_repositories")
neededRemotes <- DESCRIPTIONFileDeps(DESCFile, which = "Remotes", purge = purge)
pfn <- gsub("(@).+( *)", paste0("\\1", shas, "\\2"), packageFullName)
allDeps <- DESCRIPTIONFileDeps(DESCFile, which = c("Depends", "Imports", "Suggests", "LinkingTo"),
purge = purge, keepSeparate = TRUE)
needed <- allDeps[which]
notNeeded <- allDeps[setdiff(names(allDeps), which)]
neededAdditionalRepos <- DESCRIPTIONFileOtherV(DESCFile, other = "Additional_repositories")
neededRemotes <- DESCRIPTIONFileDeps(DESCFile, which = "Remotes", purge = purge)
pfn <- gsub("(@).+( *)", paste0("\\1", shas, "\\2"), packageFullName)
# Change branch to use sha
uwrnar(needed = needed, notNeeded = notNeeded, neededRemotes, installedVersionOK, Package,
pfn, neededAdditionalRepos, shas = shas, includeBase, localFiles = localFiles, verbose)
Expand Down Expand Up @@ -877,7 +877,8 @@ uwrnar <- function(needed, notNeeded, neededRemotes, installedVersionOK, Package

if (exists("Packages", inherits = FALSE)) {
whOverride <- match(names(Packages)[RepoNotPkgName], pkgDepDT$packageFullName)
set(pkgDepDT, whOverride, "Package", unname(unlist(Packages[RepoNotPkgName])))
if (length(whOverride))
set(pkgDepDT, whOverride, "Package", unname(unlist(Packages[RepoNotPkgName])))
}
if (!is.na(neededAdditionalRepos))
pkgDepDT[, Additional_repositories := neededAdditionalRepos]
Expand Down
2 changes: 1 addition & 1 deletion tests/testthat/test-01packages_testthat.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -256,7 +256,7 @@ test_that("test 1", {
testthat::expect_true({
length(mess) > 0
})
expect_match(paste(mess, collapse = " "), .txtCouldNotBeInstalled)
expect_match(paste(warns, collapse = " "), .txtCouldNotBeInstalled)
# testthat::expect_true({
# sum(grepl("could not be installed", mess)) == 1
# })
Expand Down

0 comments on commit 3795dd7

Please sign in to comment.