Last active
November 16, 2025 02:48
-
-
Save MichaelChirico/6828df3d28cad163313ab198b591c83d to your computer and use it in GitHub Desktop.
Check load/unload loop for methods downstreams
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| cran_repo = "https://cloud.r-project.org" | |
| bioc_repo = BiocManager::repositories()["BioCsoft"] | |
| cran_db <- data.frame(available.packages(repos = cran_repo)) | |
| bioc_db <- data.frame(available.packages(repos = bioc_repo)) | |
| methods_importers <- function(db, skip) db |> | |
| subset( | |
| grepl("(^|[^\\w.])methods($|[^\\w.])", Imports, perl=TRUE), | |
| "Package", | |
| drop = TRUE | |
| ) |> | |
| setdiff(skip) | |
| # packages that are just too painful to install: | |
| skip_installation <- c( | |
| off_cran = c( | |
| "DMwR2", "GPGame", "Nozzle.R1", "SmoothWin", "conclust", | |
| "gggenomes", "ggtern", "ggtree", "hrbrthemes", "linkcomm", | |
| "praznik", "survivalAnalysis", "tidyjson" | |
| ), | |
| # I didn't run this in r-devel :\ | |
| r_version = c("arules", "bnlearn", "coneproj", "fclust"), | |
| # or other compilation issue I can't make sense of | |
| cpp_version = c( | |
| "OpenMx", "Rcplex", "Rsolnp", "Waypoint", "bandle", "ddModel", | |
| "epiregulon", "fastcpd", "graper", "iso8601", "lbaModel", | |
| "lefko3", "mlpack", "rswipl", "scrapper", "shide", "sommer", "tEDM" | |
| ), | |
| other = c( | |
| "ASRgenomics", # 'failed to lock directory' (?) | |
| "MPCR", # issue with linking gfortran | |
| "RcppPlanc", # requires bleeding-edge CMake | |
| "SEQTaRget", # S4 mismatch issue (?) | |
| "V8", # javascript toolchain version mismatch issue | |
| "chromstaR" # OpenMP macro redefinition | |
| ), | |
| use.names = FALSE | |
| ) | |
| # ~700 packages, ~200 of which would have been included below | |
| skip_downstreams <- unique(c(skip_installation, tools::dependsOnPkgs( | |
| skip_installation, | |
| installed = rbind(cran_db, bioc_db) | |
| ))) | |
| cran_methods_loads <- methods_importers(cran_db, skip_downstreams) | |
| bioc_methods_loads <- methods_importers(bioc_db, skip_downstreams) | |
| test_lib <- "/media/michael/69913553-793b-4435-ac82-0e7df8e34b9f/tmpCRAN" | |
| system(paste("sudo mkdir", test_lib)) | |
| system(sprintf("sudo chown %1$s:%1$s %2$s", Sys.getenv("USER"), test_lib)) | |
| # some other requirements I needed to install: | |
| # libavfilter-dev libglpk-dev libhiredis-dev libomp-dev | |
| # libpoppler-cpp-dev libquantlib0-dev librdf0-dev | |
| # and other BioConductor strong dependencies only required from CRAN: | |
| # ComplexHeatmap Mfuzz QSutils graph | |
| # Bioconductor first, which is better self-contained | |
| # I think force=TRUE is needed because it failed for packages | |
| # installed elsewhere? Seems like a bug. | |
| BiocManager::install(bioc_methods_loads, lib=test_lib, force=TRUE) | |
| # install everything up-front and iterate on SystemRequirements. | |
| # NB: takes, e.g., O(days) to do in a fresh library | |
| install.packages(cran_methods_loads, lib=test_lib) | |
| # ** The actual test loop once the library is set up ** | |
| results <- rbind( | |
| data.frame(src = "CRAN", pkg = cran_methods_loads), | |
| data.frame(src = "BIOC", pkg = bioc_methods_loads) | |
| ) | |
| results$success_load <- | |
| results$success_unload <- NA | |
| no_warning <- \(x) !inherits(x, "warning") | |
| cmd_succeeds_in_minimal_session <- function(cmd, lib) { | |
| # R_LIBS, not through lib.loc, because '::' automatically uses | |
| # .libPaths() --> any package with '::' in .onLoad() needs | |
| # to see other upstream installations in test_lib implicitly. | |
| env = c("R_DEFAULT_PACKAGES=NULL", sprintf("R_LIBS='%s'", lib)) | |
| no_warning(tryCatch( | |
| system2("Rscript", c("-e", cmd), env=env, stderr=TRUE, stdout=TRUE), | |
| warning = identity | |
| )) | |
| } | |
| for (ii in seq_len(nrow(results))) { | |
| pkg <- results$pkg[ii] | |
| cmd_load <- shQuote(sprintf("loadNamespace('%s')", pkg)) | |
| cmd_unload <- shQuote(sprintf("loadNamespace('%1$s'); unloadNamespace('%1$s')", pkg)) | |
| results$success_load[ii] <- cmd_succeeds_in_minimal_session(cmd_load, test_lib) | |
| if (!isTRUE(results$success_load[ii])) next | |
| results$success_unload[ii] <- cmd_succeeds_in_minimal_session(cmd_unload, test_lib) | |
| } | |
| table(results$success_unload) | |
| # FALSE TRUE | |
| # 32 4565 | |
| failed_pkg <- results$pkg[!results$success_unload] | |
| for (pkg in failed_pkg) { | |
| cmd_unload <- shQuote(sprintf( | |
| "suppressPackageStartupMessages(invisible(loadNamespace('%1$s'))); unloadNamespace('%1$s')", | |
| pkg | |
| )) | |
| env <- c("R_DEFAULT_PACKAGES=NULL", sprintf("R_LIBS='%s'", test_lib)) | |
| msg <- sprintf("Load/unload loop for %s", pkg) | |
| cat(sprintf( | |
| "\n\n%1$s %2$s %1$s\n", | |
| strrep("-", (getOption("width") - nchar(msg) - 2) / 2), msg | |
| )) | |
| system2("Rscript", c("-e", cmd_unload), env=env) | |
| } | |
| # some package NAMESPACE use packageVersion() which assumes lib.loc | |
| in_file <- tempfile() | |
| out_file <- tempfile() | |
| dput(failed_pkg, file=in_file) | |
| system2("Rscript", | |
| c("-e", shQuote(sprintf( | |
| "dput(lapply(dget('%s'), parseNamespaceFile, '%s'), file='%s')", | |
| in_file, test_lib, out_file | |
| ))), | |
| env = sprintf("R_LIBS='%s'", test_lib) | |
| ) | |
| failed_ns <- dget(out_file) | |
| names(failed_ns) = failed_pkg | |
| failed_export_methods <- lapply(failed_ns, `[[`, "exportMethods") | |
| # didn't see a way to get this programmatically, though | |
| # @group in methods:::.BasicFunsList gets us close | |
| # NB: excluded 'matrixOps', only added since 4.5.0 | |
| group_generics <- c( | |
| "Arith", "Compare", "Logic", "Ops", "Math", "Math2", "Summary", "Complex" | |
| ) | |
| group_generic_members <- unique(unlist(lapply(group_generics, getGroupMembers))) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment