Skip to content

Commit

Permalink
Merge 2a6d2c9 into b96a62a
Browse files Browse the repository at this point in the history
  • Loading branch information
andrjohns authored Mar 23, 2023
2 parents b96a62a + 2a6d2c9 commit baadb05
Show file tree
Hide file tree
Showing 2 changed files with 85 additions and 35 deletions.
70 changes: 37 additions & 33 deletions R/install.R
Original file line number Diff line number Diff line change
Expand Up @@ -141,7 +141,7 @@ install_cmdstan <- function(dir = NULL,
dir_cmdstan <- file.path(dir, cmdstan_ver)
dest_file <- file.path(dir, tar_gz_file)
} else {
ver <- latest_released_version()
ver <- latest_released_version(quiet = quiet)
message("* Latest CmdStan release is v", ver)
cmdstan_ver <- paste0("cmdstan-", ver, cmdstan_arch_suffix(ver))
tar_gz_file <- paste0(cmdstan_ver, ".tar.gz")
Expand All @@ -154,15 +154,16 @@ install_cmdstan <- function(dir = NULL,
if (!check_install_dir(dir_cmdstan, overwrite)) {
return(invisible(NULL))
}
tar_downloaded <- download_with_retries(download_url, dest_file)
if (!tar_downloaded) {
tar_downloaded <- download_with_retries(download_url, dest_file, quiet = quiet)
if (inherits(tar_downloaded, "try-error")) {
error_msg <- paste("Download of CmdStan failed with error:",
attr(tar_downloaded, "condition")$message)
if (!is.null(version)) {
stop("Download of CmdStan failed. Please check if the supplied version number is valid.", call. = FALSE)
error_msg <- paste0(error_msg, "\nPlease check if the supplied version number is valid.")
} else if (!is.null(release_url)) {
error_msg <- paste0(error_msg, "\nPlease check if the supplied release URL is valid.")
}
if (!is.null(release_url)) {
stop("Download of CmdStan failed. Please check if the supplied release URL is valid.", call. = FALSE)
}
stop("Download of CmdStan failed. Please try again.", call. = FALSE)
stop(error_msg, call. = FALSE)
}
message("* Download complete")
message("* Unpacking archive...")
Expand Down Expand Up @@ -360,45 +361,48 @@ github_download_url <- function(version_number) {
}

# get version number of latest release
latest_released_version <- function() {
latest_released_version <- function(quiet=TRUE) {
dest_file <- tempfile(pattern = "releases-", fileext = ".json")
download_url <- "https://api.github.com/repos/stan-dev/cmdstan/releases/latest"
release_list_downloaded <- download_with_retries(download_url, dest_file)
if (!release_list_downloaded) {
stop("GitHub download of release list failed.", call. = FALSE)
release_list_downloaded <- download_with_retries(download_url, dest_file, quiet = quiet)
if (inherits(release_list_downloaded, "try-error")) {
stop("GitHub download of release list failed with error: ",
attr(release_list_downloaded, "condition")$message,
call. = FALSE)
}
release <- jsonlite::read_json(dest_file)
sub("v", "", release$tag_name)
}

try_download <- function(download_url, destination_file,
quiet = TRUE) {
download_status <- try(
suppressWarnings(
utils::download.file(url = download_url,
destfile = destination_file,
quiet = quiet,
headers = github_auth_token())
),
silent = TRUE
)
download_status
}

# download with retries and pauses
download_with_retries <- function(download_url,
destination_file,
retries = 5,
pause_sec = 5,
quiet = TRUE) {

download_rc <- 1
while (retries > 0 && download_rc != 0) {
try(
suppressWarnings(
download_rc <- utils::download.file(url = download_url,
destfile = destination_file,
quiet = quiet,
headers = github_auth_token())
),
silent = TRUE
)
if (download_rc != 0) {
Sys.sleep(pause_sec)
}
retries <- retries - 1
}
if (download_rc == 0) {
TRUE
} else {
FALSE
download_rc <- try_download(download_url, destination_file,
quiet = quiet)
num_retries <- 0
while (num_retries < retries && inherits(download_rc, "try-error")) {
Sys.sleep(pause_sec)
num_retries <- num_retries + 1
download_rc <- try_download(download_url, destination_file, quiet = quiet)
}
download_rc
}

build_cmdstan <- function(dir,
Expand Down
50 changes: 48 additions & 2 deletions tests/testthat/test-install.R
Original file line number Diff line number Diff line change
Expand Up @@ -75,12 +75,12 @@ test_that("install_cmdstan() errors if it times out", {
test_that("install_cmdstan() errors if invalid version or URL", {
expect_error(
install_cmdstan(version = "2.23.2", wsl = os_is_wsl()),
"Download of CmdStan failed. Please check if the supplied version number is valid."
"Download of CmdStan failed with error: cannot open URL 'https://github.com/stan-dev/cmdstan/releases/download/v2.23.2/cmdstan-2.23.2.tar.gz'\nPlease check if the supplied version number is valid."
)
expect_error(
install_cmdstan(release_url = "https://github.com/stan-dev/cmdstan/releases/download/v2.23.2/cmdstan-2.23.2.tar.gz",
wsl = os_is_wsl()),
"Download of CmdStan failed. Please check if the supplied release URL is valid."
"Download of CmdStan failed with error: cannot open URL 'https://github.com/stan-dev/cmdstan/releases/download/v2.23.2/cmdstan-2.23.2.tar.gz'\nPlease check if the supplied release URL is valid."
)
expect_error(
install_cmdstan(release_url = "https://github.com/stan-dev/cmdstan/releases/tag/v2.24.0", wsl = os_is_wsl()),
Expand Down Expand Up @@ -198,3 +198,49 @@ test_that("github_download_url constructs correct url", {
)
})

test_that("Downloads respect quiet argument", {
if (getRversion() < '3.5.0') {
dir <- tempdir()
} else {
dir <- tempdir(check = TRUE)
}
version <- latest_released_version()

ver_msg <- "trying URL 'https://api.github.com/repos/stan-dev/cmdstan/releases/latest'"
download_msg <- paste0("trying URL 'https://github.com/stan-dev/cmdstan/releases/download/v",
version, "/cmdstan-", version, ".tar.gz'")

# expect_message has trouble capturing the messages from download.file
# so handle manually
install_normal <- suppressWarnings(
capture.output(install_cmdstan(dir = dir, overwrite = TRUE, quiet = FALSE),
type = "message")
)
install_quiet <- suppressWarnings(
capture.output(install_cmdstan(dir = dir, overwrite = TRUE, quiet = TRUE),
type = "message")
)

expect_true(any(grepl(ver_msg, install_normal, fixed = TRUE)))
expect_true(any(grepl(download_msg, install_normal, fixed = TRUE)))

expect_false(any(grepl(ver_msg, install_quiet, fixed = TRUE)))
expect_false(any(grepl(download_msg, install_quiet, fixed = TRUE)))
})

test_that("Download failures return error message", {
if (getRversion() < '3.5.0') {
dir <- tempdir()
} else {
dir <- tempdir(check = TRUE)
}

expect_error({
# Use an invalid proxy address to force a download failure
withr::with_envvar(
c("http_proxy"="invalid","https_proxy"="invalid"),
install_cmdstan(dir = dir, overwrite = TRUE)
)},
"GitHub download of release list failed with error: cannot open URL 'https://api.github.com/repos/stan-dev/cmdstan/releases/latest'")
})

0 comments on commit baadb05

Please sign in to comment.