#=============================================================================== # Test: Package Management Functions # File: tests/testthat/test-pkg.R # Description: Comprehensive unit tests for all pkg.R functions # # Functions tested: # - set_mirror() : Configure CRAN/Bioconductor mirrors # - inst_pkg() : Install packages from multiple sources # - check_pkg() : Check package installation status # - update_pkg() : Update installed packages # - pkg_version() : Query package versions # - pkg_functions() : List exported package functions # # Dependencies: testthat, cli, tibble #=============================================================================== # ============================================================================== # Section 1: set_mirror() Tests # ============================================================================== #------------------------------------------------------------------------------ # Basic functionality - CRAN mirrors #------------------------------------------------------------------------------ test_that("CRAN mirror switches correctly", { # Test tuna mirror set_mirror("cran", "tuna") expect_equal( getOption("repos")[["CRAN"]], "https://mirrors.tuna.tsinghua.edu.cn/CRAN" ) # Test ustc mirror set_mirror("cran", "ustc") expect_equal( getOption("repos")[["CRAN"]], "https://mirrors.ustc.edu.cn/CRAN" ) # Test westlake mirror set_mirror("cran", "westlake") expect_equal( getOption("repos")[["CRAN"]], "https://mirrors.westlake.edu.cn/CRAN" ) }) #------------------------------------------------------------------------------ # Basic functionality - Bioconductor mirrors #------------------------------------------------------------------------------ test_that("Bioconductor mirror switches correctly", { # Test tuna mirror set_mirror("bioc", "tuna") expect_equal( getOption("BioC_mirror"), "https://mirrors.tuna.tsinghua.edu.cn/bioconductor" ) # Test ustc mirror set_mirror("bioc", "ustc") expect_equal( getOption("BioC_mirror"), "https://mirrors.ustc.edu.cn/bioconductor" ) # Test westlake mirror set_mirror("bioc", "westlake") expect_equal( getOption("BioC_mirror"), "https://mirrors.westlake.edu.cn/bioconductor" ) }) #------------------------------------------------------------------------------ # Combined functionality - Setting both repos #------------------------------------------------------------------------------ test_that("setting both CRAN and Bioconductor works with 'all'", { # Test with tuna set_mirror("all", "tuna") expect_equal( getOption("repos")[["CRAN"]], "https://mirrors.tuna.tsinghua.edu.cn/CRAN" ) expect_equal( getOption("BioC_mirror"), "https://mirrors.tuna.tsinghua.edu.cn/bioconductor" ) # Test with ustc set_mirror("all", "ustc") expect_equal( getOption("repos")[["CRAN"]], "https://mirrors.ustc.edu.cn/CRAN" ) expect_equal( getOption("BioC_mirror"), "https://mirrors.ustc.edu.cn/bioconductor" ) }) #------------------------------------------------------------------------------ # Parameter validation #------------------------------------------------------------------------------ test_that("set_mirror() invalid parameters are handled correctly", { # Invalid repo type expect_error( set_mirror("invalid", "tuna"), regexp = "should be one of" ) # Invalid CRAN mirror name expect_error( set_mirror("cran", "nonexistent"), regexp = "Unknown CRAN mirror" ) # Invalid Bioconductor mirror name expect_error( set_mirror("bioc", "nonexistent"), regexp = "Unknown Bioconductor mirror" ) }) #------------------------------------------------------------------------------ # Default parameters #------------------------------------------------------------------------------ test_that("set_mirror() default parameters work as expected", { # Default repo should be "all" messages <- capture_messages(set_mirror(mirror = "tuna")) expect_true(any(grepl("CRAN mirror set to", messages))) expect_true(any(grepl("Bioconductor mirror set to", messages))) # Default mirror should be "tuna" set_mirror("cran") expect_equal( getOption("repos")[["CRAN"]], "https://mirrors.tuna.tsinghua.edu.cn/CRAN" ) }) #------------------------------------------------------------------------------ # Return values #------------------------------------------------------------------------------ test_that("set_mirror() returns previous settings correctly", { # Set known initial state options(repos = c(CRAN = "https://cloud.r-project.org")) options(BioC_mirror = "https://bioconductor.org") # Capture old settings old <- set_mirror("all", "tuna") # Verify old settings structure expect_type(old, "list") expect_named(old, c("repos", "BioC_mirror")) # Verify old settings values expect_equal(old$repos[["CRAN"]], "https://cloud.r-project.org") expect_equal(old$BioC_mirror, "https://bioconductor.org") # Test restoration options(old) expect_equal(getOption("repos")[["CRAN"]], "https://cloud.r-project.org") expect_equal(getOption("BioC_mirror"), "https://bioconductor.org") }) #------------------------------------------------------------------------------ # CLI output messages #------------------------------------------------------------------------------ test_that("set_mirror() CLI messages are displayed correctly", { # Test CRAN message expect_message( set_mirror("cran", "tuna"), regexp = "CRAN mirror set to" ) # Test Bioconductor message expect_message( set_mirror("bioc", "ustc"), regexp = "Bioconductor mirror set to" ) # Test info message about available mirrors expect_message( set_mirror("cran", "tuna"), regexp = "Available" ) # Test settings check message expect_message( set_mirror("cran", "tuna"), regexp = "View current settings" ) }) #------------------------------------------------------------------------------ # Edge cases #------------------------------------------------------------------------------ test_that("set_mirror() edge cases are handled properly", { # Partial matching for repo parameter set_mirror("cr", "tuna") # Should match "cran" expect_equal( getOption("repos")[["CRAN"]], "https://mirrors.tuna.tsinghua.edu.cn/CRAN" ) # CRAN-only mirror cannot be used for Bioconductor expect_error( set_mirror("bioc", "rstudio"), regexp = "Unknown Bioconductor mirror" ) # Using 'all' with CRAN-only mirror should fail expect_error( set_mirror("all", "rstudio"), regexp = "Unknown Bioconductor mirror" ) }) #------------------------------------------------------------------------------ # Official mirrors #------------------------------------------------------------------------------ test_that("set_mirror() official mirrors work correctly", { # Test official CRAN mirror set_mirror("cran", "official") expect_equal( getOption("repos")[["CRAN"]], "https://cloud.r-project.org" ) # Test official Bioconductor mirror set_mirror("bioc", "official") expect_equal( getOption("BioC_mirror"), "https://bioconductor.org" ) }) # ============================================================================== # Section 2: inst_pkg() Tests # ============================================================================== #------------------------------------------------------------------------------ # Parameter Validation Tests #------------------------------------------------------------------------------ test_that("inst_pkg() validates source parameter correctly", { expect_error( inst_pkg(pkg = "dplyr", source = "invalid"), "'arg' should be one of" ) expect_error( inst_pkg(pkg = "dplyr", source = "unknown"), "'arg' should be one of" ) }) test_that("inst_pkg() validates pkg parameter correctly", { expect_error( inst_pkg(pkg = c("dplyr", NA), source = "CRAN"), "must be a character vector without NA" ) expect_error( inst_pkg(pkg = 123, source = "CRAN"), "must be a character vector without NA" ) expect_error( inst_pkg(pkg = character(0), source = "CRAN"), "must be a character vector without NA" ) }) test_that("inst_pkg() validates pkg and source relationship", { expect_error( inst_pkg(source = "CRAN"), "Must provide.*pkg.*for non-local installation" ) expect_error( inst_pkg(source = "GitHub"), "Must provide.*pkg.*for non-local installation" ) expect_error( inst_pkg(source = "Bioconductor"), "Must provide.*pkg.*for non-local installation" ) }) test_that("inst_pkg() validates GitHub package format", { expect_error( inst_pkg(pkg = "invalidformat", source = "GitHub"), "must be in.*user/repo.*format" ) expect_error( inst_pkg(pkg = c("validuser/repo", "invalid"), source = "GitHub"), "must be in.*user/repo.*format" ) }) test_that("inst_pkg() validates local installation parameters", { expect_error( inst_pkg(source = "Local"), "Must provide.*path.*for local installation" ) }) #------------------------------------------------------------------------------ # Basic Function Acceptance (No Network Operations) #------------------------------------------------------------------------------ test_that("inst_pkg() accepts valid parameters without execution", { # Only test that the function doesn't immediately error on valid input expect_true(is.function(inst_pkg)) # Test parameter parsing without execution expect_silent({ formals_check <- formals(inst_pkg) expect_true("pkg" %in% names(formals_check)) expect_true("source" %in% names(formals_check)) expect_true("path" %in% names(formals_check)) }) }) # ============================================================================== # Section 3: check_pkg() Tests # ============================================================================== #------------------------------------------------------------------------------ # Basic functionality tests #------------------------------------------------------------------------------ test_that("check_pkg() detects installed packages", { res <- check_pkg("stats", source = "CRAN", auto_install = FALSE) expect_true(res$installed) }) test_that("check_pkg() handles GitHub input format", { res <- check_pkg("r-lib/cli", source = "GitHub", auto_install = FALSE) expect_true(res$name == "cli") }) #------------------------------------------------------------------------------ # Error handling tests #------------------------------------------------------------------------------ test_that("check_pkg() errors on invalid source", { expect_error(check_pkg("dplyr", source = "unknown")) }) #------------------------------------------------------------------------------ # Output structure tests #------------------------------------------------------------------------------ test_that("check_pkg() returns a tibble", { res <- check_pkg("ggplot2", source = "CRAN", auto_install = FALSE) expect_s3_class(res, "tbl_df") }) #------------------------------------------------------------------------------ # Multiple packages test #------------------------------------------------------------------------------ test_that("check_pkg() handles multiple packages", { res <- check_pkg(c("stats", "utils"), source = "CRAN", auto_install = FALSE) expect_equal(nrow(res), 2) expect_true(all(res$installed)) }) #------------------------------------------------------------------------------ # Bioconductor source test (if available) #------------------------------------------------------------------------------ test_that("check_pkg() handles Bioconductor source", { skip_on_cran() skip_if_offline() skip("Network-heavy Bioconductor package check skipped.") # This test assumes Bioconductor is set up; adjust as needed res <- check_pkg("Biobase", source = "Bioconductor", auto_install = FALSE) expect_s3_class(res, "tbl_df") }) # ============================================================================== # Section 4: update_pkg() Tests # ============================================================================== #------------------------------------------------------------------------------ # Parameter Validation Tests #------------------------------------------------------------------------------ test_that("update_pkg() validates source parameter correctly", { expect_error( update_pkg(pkg = "dplyr", source = "unknown"), "'arg' should be one of" ) expect_error( update_pkg(pkg = "dplyr", source = "invalid"), "'arg' should be one of" ) }) test_that("update_pkg() validates pkg parameter correctly", { expect_error( update_pkg(pkg = c("dplyr", NA), source = "CRAN"), "must be a character vector without NA" ) expect_error( update_pkg(pkg = 123, source = "CRAN"), "must be a character vector without NA" ) expect_error( update_pkg(pkg = character(0), source = "CRAN"), "must be a character vector without NA" ) }) test_that("update_pkg() validates pkg and source relationship", { expect_error( update_pkg(pkg = "dplyr"), "Must specify.*source.*when providing.*pkg" ) expect_error( update_pkg(source = "GitHub"), "Must provide.*pkg.*when updating GitHub" ) }) test_that("update_pkg() validates GitHub package format", { expect_error( update_pkg(pkg = "invalid-format", source = "GitHub"), "must be in.*user/repo.*format" ) expect_error( update_pkg(pkg = c("user/repo", "invalid"), source = "GitHub"), "must be in.*user/repo.*format" ) }) #------------------------------------------------------------------------------ # Basic Function Acceptance (No Network Operations) #------------------------------------------------------------------------------ test_that("update_pkg() accepts valid single package parameters", { # Only test that the function doesn't immediately error on valid input # Skip actual execution to avoid network operations expect_true(is.function(update_pkg)) # Test parameter parsing without execution expect_silent({ formals_check <- formals(update_pkg) expect_true("pkg" %in% names(formals_check)) expect_true("source" %in% names(formals_check)) }) }) #------------------------------------------------------------------------------ # Edge Cases and Error Handling #------------------------------------------------------------------------------ test_that("update_pkg() handles empty package vector", { expect_error( update_pkg(pkg = character(0), source = "CRAN"), "must be a character vector without NA" ) }) test_that("update_pkg() case sensitivity for source parameter", { expect_error( update_pkg(pkg = "test", source = "cran"), "'arg' should be one of" ) expect_error( update_pkg(pkg = "test", source = "github"), "'arg' should be one of" ) expect_error( update_pkg(pkg = "test", source = "bioconductor"), "'arg' should be one of" ) }) # ============================================================================== # Section 5: pkg_version() Tests # ============================================================================== #------------------------------------------------------------------------------ # Input validation #------------------------------------------------------------------------------ test_that("pkg_version() validates input parameters", { expect_error(pkg_version(NULL), "`pkg` must be a non-empty character vector") expect_error(pkg_version(character(0)), "`pkg` must be a non-empty character vector") expect_error(pkg_version(123), "`pkg` must be a non-empty character vector") expect_error(pkg_version("cli", preview = "yes"), "`preview` must be a single logical value") expect_error(pkg_version("cli", preview = c(TRUE, FALSE)), "`preview` must be a single logical value") }) #------------------------------------------------------------------------------ # Functional tests (network-dependent, skipped on CRAN) #------------------------------------------------------------------------------ test_that("pkg_version() detects installed version", { skip_on_cran() skip_if_offline() skip("Network-heavy CRAN package database fetch skipped.") res <- suppressMessages(pkg_version("cli", preview = FALSE)) expect_true(!is.na(res$version[1])) }) test_that("pkg_version() detects CRAN source", { skip_on_cran() skip_if_offline() skip("Network-heavy CRAN package database fetch skipped.") res <- suppressMessages(pkg_version("ggplot2", preview = FALSE)) expect_equal(res$source[1], "CRAN") expect_true(!is.na(res$latest[1])) }) test_that("pkg_version() handles nonexistent packages gracefully", { skip_on_cran() skip_if_offline() skip("Network-heavy CRAN package database fetch skipped.") res <- suppressMessages(pkg_version("nonexistentpackage123456", preview = FALSE)) expect_true(is.na(res$version[1])) expect_true(is.na(res$latest[1])) expect_equal(res$source[1], "Not Found") }) #------------------------------------------------------------------------------ # GitHub-related test (optional, skipped on CRAN) #------------------------------------------------------------------------------ test_that("pkg_version() detects GitHub package (if installed locally)", { skip_on_cran() skip_if_offline() skip("Network-heavy CRAN package database fetch skipped.") # This test only works if MRPRESSO (or another GitHub package) is installed. # It will pass silently if not installed. if (length(find.package("MRPRESSO", quiet = TRUE)) > 0) { res <- suppressMessages(pkg_version("MRPRESSO", preview = FALSE)) expect_true(grepl("^GitHub", res$source[1])) } else { succeed("GitHub package not installed locally; skipping test.") } }) # ============================================================================== # Section 6: pkg_functions() Tests # ============================================================================== #------------------------------------------------------------------------------ # Basic functionality #------------------------------------------------------------------------------ test_that("pkg_functions() returns exported names from a package", { funcs <- pkg_functions("stats") expect_true(is.character(funcs)) expect_true(length(funcs) > 0) expect_true("lm" %in% funcs) # stats::lm is exported }) #------------------------------------------------------------------------------ # Sorting #------------------------------------------------------------------------------ test_that("pkg_functions() returned names are sorted alphabetically", { funcs <- pkg_functions("stats") expect_equal(funcs, sort(funcs)) }) #------------------------------------------------------------------------------ # Keyword filtering (case-insensitive, partial) #------------------------------------------------------------------------------ test_that("pkg_functions() filters by keyword", { funcs <- pkg_functions("stats", key = "lm") expect_true(all(grepl("lm", funcs, ignore.case = TRUE))) }) test_that("pkg_functions() filtering is case-insensitive", { funcs <- pkg_functions("stats", key = "LM") expect_true(all(grepl("lm", funcs, ignore.case = TRUE))) }) #------------------------------------------------------------------------------ # No matches #------------------------------------------------------------------------------ test_that("pkg_functions() returns empty vector when no match", { funcs <- pkg_functions("stats", key = "zzzzzz") expect_type(funcs, "character") expect_equal(length(funcs), 0L) }) #------------------------------------------------------------------------------ # Error handling #------------------------------------------------------------------------------ test_that("pkg_functions() errors for non-installed package", { expect_error(pkg_functions("somefakepkgnotinstalled"), regexp = "not installed") }) test_that("pkg_functions() errors for non-character `pkg`", { expect_error(pkg_functions(123)) expect_error(pkg_functions(TRUE)) expect_error(pkg_functions(NA_character_), regexp = "non-empty") }) test_that("pkg_functions() errors for invalid `key` input", { expect_error(pkg_functions("stats", key = c("a", "b"))) expect_error(pkg_functions("stats", key = NA_character_)) }) #=============================================================================== # End: test-pkg.R