From 99a9b4927570d5630e78a7aa454b6446a921666a Mon Sep 17 00:00:00 2001 From: Maciej Nasinski Date: Fri, 27 Sep 2024 22:17:19 +0200 Subject: [PATCH] make a fix of pac_deps_timemachine and checked_packages (#36) * make a fix for pac_deps_timemachine * fix checked_packages --- NEWS.md | 4 +++- R/check.R | 26 +++++++++++++++++++++----- R/deps_timemachine.R | 6 ++++-- tests/testthat/test-check.R | 6 +++--- tests/testthat/test-deps.R | 6 ++++-- 5 files changed, 35 insertions(+), 13 deletions(-) diff --git a/NEWS.md b/NEWS.md index a716517..c98fb27 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,8 +1,10 @@ # pacs 0.5.1.9000 +* fix `checked_packages` as there is a new DOM structure. +* fix `pac_deps_timemachine` which not works in some cases. +* fix a problem with app_deps on R 3.6. * add new functions: pac_news and pac_compare_news. Functions are NEWS file related. * update the tinyverse vignette with a new badge url. -* fix a problem with app_deps on R 3.6. * improve code base. # pacs 0.5.1 diff --git a/R/check.R b/R/check.R index 95c32b8..ad859fb 100644 --- a/R/check.R +++ b/R/check.R @@ -137,11 +137,27 @@ read_checkred_packages_raw <- function(url = "https://cran.r-project.org/web/che header_machines <- trimws(gsub("check_flavors.html#", "", xml_attr(xml_find_all(header_raw, "//a"), "href"))) which_machines <- grep("r-", header) header[which_machines] <- header_machines - result_raw <- matrix(trimws(xml_text(xml_find_all(read_html(paste0(rrr[2:length_rrr], collapse = "\n")), "/html/body//tr/td"))), - ncol = length(header), - byrow = TRUE - ) - result_raw <- as.data.frame(result_raw) + + nmachines <- length(header_machines) + nmachines_empty <- rep("", nmachines) + checks_text <- lapply(rrr[2:length_rrr], function(e) { + res_true <- trimws(xml_text(xml_find_all(read_html(paste0(e, collapse = "\n")), "/html/body//tr/td[@class]"))) + if (length(res_true) == nmachines) { + res_true + } else { + nmachines_empty + } + }) + checks_text_bind <- do.call(rbind, checks_text) + + html_base <- suppressWarnings(read_html(paste0(rrr[2:length_rrr], collapse = "\n"))) + xml_base <- xml_find_all(html_base, "/html/body//tr") + package_names <- trimws(xml_text(xml_find_all(xml_base, "td[1]"))) + package_versions <- trimws(xml_text(xml_find_all(xml_base, "td[2]"))) + package_maintainer <- trimws(xml_text(xml_find_all(xml_base, "td[last()-1]"))) + package_priority <- trimws(xml_text(xml_find_all(xml_base, "td[last()]"))) + + result_raw <- as.data.frame(cbind(package_names, package_versions, checks_text_bind, package_maintainer, package_priority)) colnames(result_raw) <- header } else { result_raw <- NA diff --git a/R/deps_timemachine.R b/R/deps_timemachine.R index 94d3fa3..62fd73b 100644 --- a/R/deps_timemachine.R +++ b/R/deps_timemachine.R @@ -69,8 +69,10 @@ pac_deps_timemachine <- function(pac, # not care about many versions for certain apckage as we taking the newset version if (isTRUE(r != "R" && r != pac && (!r %in% paks_global))) { pks <- pac_description(r, at = at, local = FALSE) - paks_global <<- c(stats::setNames(r, pks$Version), paks_global[paks_global != r]) - if (recursive) deps(r, at, pks[fields]) + if (is.list(pks)) { + paks_global <<- c(stats::setNames(r, pks$Version), paks_global[paks_global != r]) + if (recursive) deps(r, at, pks[fields]) + } } } } diff --git a/tests/testthat/test-check.R b/tests/testthat/test-check.R index a3778f6..2f63d90 100644 --- a/tests/testthat/test-check.R +++ b/tests/testthat/test-check.R @@ -16,12 +16,12 @@ test_that("pac_isin", { test_that("pacs::pac_checkred online", { skip_if_offline() - + skip_on_cran() expect_error(pac_checkred("dplyr", scope = ""), "") skip_if(isNA(checked_packages())) - expect_true(is.logical(pac_checkred("dplyr"))) + expect_true(is.logical(pac_checkred("dplyr")) || isNA(pac_checkred("dplyr"))) expect_message(pac_checkred("WRONG"), "WRONG package is not on CRAN") - expect_true(is.na(suppressMessages(pac_checkred("WRONG")))) + expect_true(isNA(suppressMessages(pac_checkred("WRONG")))) expect_true(isNA(loc <- pac_checkred("dplyr", scope = c("ERROR", "FAIL", "WARN"), flavors = c( diff --git a/tests/testthat/test-deps.R b/tests/testthat/test-deps.R index 23ea308..a37c602 100644 --- a/tests/testthat/test-deps.R +++ b/tests/testthat/test-deps.R @@ -86,8 +86,9 @@ test_that("pacs::pac_deps_timemachine", { skip_if_offline() expect_message(pac_deps_timemachine("WRONG", "0.8.0"), "WRONG package is not on CRAN") expect_identical(suppressMessages(pac_deps_timemachine("WRONG", "0.8.0")), NA) - expect_true(length(pac_deps_timemachine("memoise", "0.2.1")) == 1) - expect_true(length(pac_deps_timemachine("memoise", at = as.Date("2019-01-01"))) == 1) + expect_length(pac_deps_timemachine("memoise", "0.2.1"), 1) + expect_length(pac_deps_timemachine("memoise", at = as.Date("2019-01-01")), 1) + expect_true(length(pac_deps_timemachine("ggplot2", at = as.Date("2020-10-10"))) > 0) }) test_that("pacs::pac_deps_timemachine offline", { @@ -188,6 +189,7 @@ test_that("pac_deps_heavy with base", { }) test_that("pac_deps_heavy 0 deps pac", { + skip_on_cran() expect_identical( pac_deps_heavy("base", local = TRUE), structure(list(Package = character(0), NrDeps = integer(0), NrUniqueDeps = integer(0)), class = "data.frame", row.names = integer(0))