diff --git a/DESCRIPTION b/DESCRIPTION index 3f3fc46..9cc4502 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: pacta.workflow.utils Title: Utility functions for PACTA workflows -Version: 0.0.0.9002 +Version: 0.0.0.9003 Authors@R: c(person(given = "Alex", family = "Axthelm", @@ -17,13 +17,13 @@ Roxygen: list(markdown = TRUE) RoxygenNote: 7.3.1 Imports: digest, + gert, jsonlite, logger, pkgdepends, pkgload Suggests: devtools, - gert, pak, testthat (>= 3.0.0), withr diff --git a/R/get_package_info.R b/R/get_package_info.R index 7da8aa5..70a74da 100644 --- a/R/get_package_info.R +++ b/R/get_package_info.R @@ -80,6 +80,7 @@ get_individual_package_info <- function(packagename) { package_dev_dir <- pkgload::pkg_path( path = dirname(system.file("DESCRIPTION", package = packagename)) ) + git_info <- get_git_info(repo = package_dev_dir) pkg_details <- list( package = pkgload::pkg_name(package_dev_dir), version = paste("DEV", pkgload::pkg_version(package_dev_dir)), @@ -91,7 +92,8 @@ get_individual_package_info <- function(packagename) { remotetype = "pkgload", remotepkgref = normalizePath(package_dev_dir), remoteref = NA_character_, - remotesha = NA_character_ + remotesha = NA_character_, + git = git_info ) } else { if (packagename %in% utils::installed.packages()[, "Package"]) { @@ -122,6 +124,25 @@ get_individual_package_info <- function(packagename) { ) ) pkg_details[["library_index"]] <- lib_index + if (is.null(pkg_details[["remotepkgref"]])) { + is_local_pkg <- FALSE + } else { + is_local_pkg <- grepl( + x = pkg_details[["remotepkgref"]], + pattern = "^local::" + ) + } + if (is_local_pkg) { + git_info <- get_git_info( + repo = gsub( + x = pkg_details[["remotepkgref"]], + pattern = "local::", + replacement = "", + fixed = TRUE + ) + ) + pkg_details[["git"]] <- git_info + } } details_list <- list( package = pkg_details[["package"]], @@ -135,12 +156,17 @@ get_individual_package_info <- function(packagename) { remotetype = pkg_details[["remotetype"]], remotepkgref = pkg_details[["remotepkgref"]], remoteref = pkg_details[["remoteref"]], - remotesha = pkg_details[["remotesha"]] + remotesha = pkg_details[["remotesha"]], + git = pkg_details[["git"]] ) clean_details_list <- lapply( X = details_list, FUN = function(x) { - ifelse(is.null(x), NA_character_, x) + if (is.null(x)) { + NA_character_ + } else { + x + } } ) return(clean_details_list) diff --git a/R/git.R b/R/git.R new file mode 100644 index 0000000..f4a42cc --- /dev/null +++ b/R/git.R @@ -0,0 +1,157 @@ +get_git_info <- function(repo) { + log_trace("checking that directory \"{repo}\"exists.") + if (is_git_path(repo)) { + git_repo <- gert::git_find(path = repo) + info <- gert::git_info(repo = git_repo) + latest_commit <- info[["commit"]] + if (is.na(latest_commit)) { + log_debug("No commits found in repo.") + latest_commit <- NULL + } + changed_files <- git_changed_files(repo = git_repo) + # cleaning path for older versions of R on windows + repo_path <- gsub( + x = normalizePath(info[["path"]]), + pattern = "[\\]+$", # nolint: nonportable_path_linter + replacement = "" + ) + out <- list( + repo = repo_path, + is_git = TRUE, + commit = latest_commit, + clean = (length(changed_files) == 0L), + branch = git_branch_info(repo = git_repo), + changed_files = changed_files, + tags = git_tag_info(repo = git_repo) + ) + } else { + log_warn("Directory \"{repo}\" is not a git repository.") + warning("Specified path is not in a git repository.") + out <- NULL + } + return(out) +} + +is_git_path <- function(path) { + log_trace("checking that path \"{path}\" is in a git repository.") + if (file.exists(path)) { + log_trace("path \"{path}\" exists.") + git_path <- tryCatch({ + gert::git_find(path = path) + }, error = function(e) { + log_trace("error while finding git repo in parent tree for \"{path}\".") + NULL + }) + if (is.null(git_path)) { + log_trace("no git repo found in parent tree for \"{path}\".") + is_git_path <- FALSE + } else { + log_trace("git repo found in parent tree for \"{path}\".") + is_git_path <- dir.exists(git_path) + } + } else { + # dir does not exist + log_error("path \"{path}\" does not exist.") + stop("Cannot find git information for path which does not exist.") + } + return(is_git_path) +} + +git_branch_info <- function(repo) { + log_trace("checking branch information for repo \"{repo}\".") + if (is_git_path(repo)) { + git_repo <- gert::git_find(path = repo) + active_branch <- gert::git_branch(repo = git_repo) + if (is.null(active_branch)) { + log_debug("No active branch found.") + return(NULL) + } + log_debug("active branch: \"{active_branch}\".") + branch_list <- gert::git_branch_list(repo = git_repo) + active_index <- which(branch_list[["name"]] == active_branch) + active_commit <- branch_list[[active_index, "commit"]] + active_upstream <- branch_list[[active_index, "upstream"]] + if (is.na(active_upstream)) { + log_debug("Branch \"{active_branch}\" has no upstream.") + active_upstream <- NULL + up_to_date <- NULL + upstream_commit <- NULL + remote_url <- NULL + } else { + log_trace( + "Branch \"{active_branch}\" has an upstream: \"{active_upstream}\"." + ) + active_upstream <- gsub( + pattern = "refs/heads/", # nolint: nonportable_path_linter + replacement = "", + x = active_upstream + ) + upstream_index <- which(branch_list[["ref"]] == active_upstream) + upstream_commit <- branch_list[[upstream_index, "commit"]] + up_to_date <- active_commit == upstream_commit + # format of remote ref: refs/remotes/origin/branch + remote_name <- strsplit( + x = active_upstream, + split = "/", + fixed = TRUE + )[[1L]][[3L]] + remote_info <- gert::git_remote_info( + repo = git_repo, + remote = remote_name + ) + remote_url <- remote_info[["url"]] + } + out <- list( + name = active_branch, + commit = active_commit, + upstream = active_upstream, + remote_url = remote_url, + up_to_date = up_to_date, + upstream_commit = upstream_commit + ) + } else { + log_warn("Directory \"{repo}\" is not a git repository.") + warning("Specified path is not in a git repository.") + out <- NULL + } + return(out) +} + +git_changed_files <- function(repo) { + log_trace("checking for changed files in repo \"{repo}\".") + if (is_git_path(repo)) { + git_repo <- gert::git_find(path = repo) + status <- gert::git_status(repo = git_repo) + changed_files <- list() + for (f in status[["file"]]) { + changed_files[[f]] <- status[["status"]][status[["file"]] == f] + } + return(changed_files) + } else { + log_debug("Specified path is not in a git repository.") + return(NULL) + } +} + +git_tag_info <- function(repo) { + log_trace("checking for tags in repo \"{repo}\".") + if (is_git_path(repo)) { + git_repo <- gert::git_find(path = repo) + tags_df <- gert::git_tag_list(repo = git_repo) + tags <- list() + for (i in seq_along(tags_df[["name"]])) { + tag_name <- tags_df[["name"]][i] + tag_commit <- tags_df[["commit"]][i] + tag_pointer <- gert::git_commit_info(repo = git_repo, ref = tag_commit) + tags[[tag_name]] <- list( + name = tag_name, + commit = tag_commit, + points_to = tag_pointer[["id"]] + ) + } + return(tags) + } else { + log_debug("Specified path is not in a git repository.") + return(NULL) + } +} diff --git a/tests/testthat/helper-git_config.R b/tests/testthat/helper-git_config.R new file mode 100644 index 0000000..022caed --- /dev/null +++ b/tests/testthat/helper-git_config.R @@ -0,0 +1,8 @@ +testing_git_config <- function(repo) { + gert::git_config_set(repo = repo, name = "user.name", value = "testthat") + gert::git_config_set( + repo = repo, + name = "user.email", + value = "PACTATesting@rmi.org" + ) +} diff --git a/tests/testthat/helper-remote_package.R b/tests/testthat/helper-remote_package.R new file mode 100644 index 0000000..c188eae --- /dev/null +++ b/tests/testthat/helper-remote_package.R @@ -0,0 +1,12 @@ +remote_package <- list( + name = "minimal.r.package", + version = "0.0.0.9001", + old_version = "0.0.0.9000", + gh_repo = "RMI-PACTA/minimal.r.package", #nolint: nonportable_path_linter + gh_repo_old = "RMI-PACTA/minimal.r.package@28c716f", #nolint: nonportable_path_linter + branch = "main", + upstream = "refs/remotes/origin/main", #nolint: nonportable_path_linter + url = "https://github.com/RMI-PACTA/minimal.r.package.git", + sha = "f31fa0e5675b675fb778e15fcf1501aecec8cf94", + old_sha = "28c716face8bbf8787c32ae392f246177f111c00" +) diff --git a/tests/testthat/test-get_git_info.R b/tests/testthat/test-get_git_info.R new file mode 100644 index 0000000..639d37e --- /dev/null +++ b/tests/testthat/test-get_git_info.R @@ -0,0 +1,332 @@ +## save current settings so that we can reset later +threshold <- logger::log_threshold() +appender <- logger::log_appender() +layout <- logger::log_layout() +on.exit({ + ## reset logger settings + logger::log_threshold(threshold) + logger::log_layout(layout) + logger::log_appender(appender) +}) + +logger::log_appender(logger::appender_stdout) +logger::log_threshold(logger::FATAL) +logger::log_layout(logger::layout_simple) + +# TESTS BEGIN +test_that("get_git_info processes non-git-repo correctly", { + test_dir <- withr::local_tempdir() + expect_warning( + object = { + metadata <- get_git_info(repo = test_dir) + }, + regexp = "^Specified path is not in a git repository.$" + ) + expect_null(metadata) +}) + +test_that("get_git_info processes fresh git repo correctly", { + test_dir <- withr::local_tempdir() + gert::git_init(path = test_dir) + metadata <- get_git_info(repo = test_dir) + expect_identical( + metadata, + list( + repo = normalizePath(test_dir), + is_git = TRUE, + commit = NULL, + clean = TRUE, + branch = NULL, + changed_files = list(), + tags = list() + ) + ) +}) + +test_that("get_git_info processes fresh git repo with new file correctly", { + test_dir <- withr::local_tempdir() + gert::git_init(path = test_dir) + test_file <- file.path(test_dir, "foo.txt") + writeLines("Hello, world!", con = test_file) + metadata <- get_git_info(repo = test_dir) + expect_identical( + metadata, + list( + repo = normalizePath(test_dir), + is_git = TRUE, + commit = NULL, + clean = FALSE, + branch = NULL, + changed_files = list( + foo.txt = "new" + ), + tags = list() + ) + ) +}) + +test_that("get_git_info processes git repo with a single commit correctly", { + test_dir <- withr::local_tempdir() + test_file <- file.path(test_dir, "foo.txt") + writeLines("Hello, world!", con = test_file) + gert::git_init(path = test_dir) + testing_git_config(repo = test_dir) + gert::git_add(files = basename(test_file), repo = normalizePath(test_dir)) + commit_sha <- gert::git_commit(repo = test_dir, message = "Initial commit") + metadata <- get_git_info(repo = test_dir) + expect_identical( + metadata, + list( + repo = normalizePath(test_dir), + is_git = TRUE, + commit = commit_sha, + clean = TRUE, + branch = list( + name = "master", + commit = commit_sha, + upstream = NULL, + remote_url = NULL, + up_to_date = NULL, + upstream_commit = NULL + ), + changed_files = list(), + tags = list() + ) + ) +}) + +test_that("get_git_info processes git repo with dirty index correctly", { + test_dir <- withr::local_tempdir() + test_file <- file.path(test_dir, "foo.txt") + writeLines("Hello, world!", con = test_file) + gert::git_init(path = test_dir) + testing_git_config(repo = test_dir) + gert::git_add(files = basename(test_file), repo = normalizePath(test_dir)) + commit_sha <- gert::git_commit(repo = test_dir, message = "Initial commit") + writeLines("Hello, Testing!", con = test_file) + metadata <- get_git_info(repo = test_dir) + expect_identical( + metadata, + list( + repo = normalizePath(test_dir), + is_git = TRUE, + commit = commit_sha, + clean = FALSE, + branch = list( + name = "master", + commit = commit_sha, + upstream = NULL, + remote_url = NULL, + up_to_date = NULL, + upstream_commit = NULL + ), + changed_files = list( + foo.txt = "modified" + ), + tags = list() + ) + ) +}) + +test_that("get_git_info processes git repo with conflicts correctly", { + test_dir <- withr::local_tempdir() + test_file <- file.path(test_dir, "foo.txt") + writeLines("Hello, world!", con = test_file) + gert::git_init(path = test_dir) + testing_git_config(repo = test_dir) + gert::git_add(files = basename(test_file), repo = normalizePath(test_dir)) + gert::git_commit(repo = test_dir, message = "Initial commit") + + gert::git_branch_create(repo = test_dir, branch = "feature") + writeLines("Hello, feature!", con = test_file) + gert::git_add(files = basename(test_file), repo = normalizePath(test_dir)) + gert::git_commit(repo = test_dir, message = "Feature commit") + + gert::git_branch_checkout(repo = test_dir, branch = "master") + writeLines("Hello, Testing!", con = test_file) + gert::git_add(files = basename(test_file), repo = normalizePath(test_dir)) + commit_sha <- gert::git_commit(repo = test_dir, message = "Master commit") + + suppressMessages( + gert::git_merge(repo = test_dir, ref = "feature") + ) + + metadata <- get_git_info(repo = test_dir) + expect_identical( + metadata, + list( + repo = normalizePath(test_dir), + is_git = TRUE, + commit = commit_sha, + clean = FALSE, + branch = list( + name = "master", + commit = commit_sha, + upstream = NULL, + remote_url = NULL, + up_to_date = NULL, + upstream_commit = NULL + ), + changed_files = list( + foo.txt = "conflicted" + ), + tags = list() + + ) + ) +}) + +test_that("get_git_info processes git repo with tags correctly", { + test_dir <- withr::local_tempdir() + test_file <- file.path(test_dir, "foo.txt") + writeLines("Hello, world!", con = test_file) + gert::git_init(path = test_dir) + testing_git_config(repo = test_dir) + gert::git_add(files = basename(test_file), repo = normalizePath(test_dir)) + commit_sha <- gert::git_commit(repo = test_dir, message = "Initial commit") + foo_sha <- gert::git_tag_create( + repo = test_dir, + name = "foo", + message = "foo", + ref = commit_sha + ) + bar_sha <- gert::git_tag_create( + repo = test_dir, + name = "bar", + message = "bar", + ref = commit_sha + ) + metadata <- get_git_info(repo = test_dir) + expect_identical( + metadata, + list( + repo = normalizePath(test_dir), + is_git = TRUE, + commit = commit_sha, + clean = TRUE, + branch = list( + name = "master", + commit = commit_sha, + upstream = NULL, + remote_url = NULL, + up_to_date = NULL, + upstream_commit = NULL + ), + changed_files = list(), + tags = list( + bar = list( + name = "bar", + commit = bar_sha, + points_to = commit_sha + ), + foo = list( + name = "foo", + commit = foo_sha, + points_to = commit_sha + ) + ) + ) + ) +}) + +test_that("get_git_info processes cloned git repo", { + testthat::skip_on_cran() + testthat::skip_if_offline() + test_dir <- normalizePath(withr::local_tempdir()) + dl <- gert::git_clone( + url = remote_package[["url"]], #nolint: nonportable_path_linter + path = test_dir, + verbose = FALSE + ) + metadata <- get_git_info(repo = test_dir) + expect_identical( + metadata, + list( + repo = normalizePath(test_dir), + is_git = TRUE, + commit = remote_package[["sha"]], + clean = TRUE, + branch = list( + name = remote_package[["branch"]], + commit = remote_package[["sha"]], + upstream = remote_package[["upstream"]], + remote_url = remote_package[["url"]], + up_to_date = TRUE, + upstream_commit = remote_package[["sha"]] + ), + changed_files = list(), + tags = list() + ) + ) +}) + +test_that("get_git_info processes cloned git repo with local dirty", { + testthat::skip_on_cran() + testthat::skip_if_offline() + test_dir <- normalizePath(withr::local_tempdir()) + dl <- gert::git_clone( + url = remote_package[["url"]], #nolint: nonportable_path_linter + path = test_dir, + verbose = FALSE + ) + test_file <- file.path(test_dir, "foo.txt") + writeLines("Hello, world!", con = test_file) + metadata <- get_git_info(repo = test_dir) + expect_identical( + metadata, + list( + repo = normalizePath(test_dir), + is_git = TRUE, + commit = remote_package[["sha"]], + clean = FALSE, + branch = list( + name = remote_package[["branch"]], + commit = remote_package[["sha"]], + upstream = remote_package[["upstream"]], + remote_url = remote_package[["url"]], + up_to_date = TRUE, + upstream_commit = remote_package[["sha"]] + ), + changed_files = list( + foo.txt = "new" + ), + tags = list() + ) + ) +}) + +test_that("get_git_info processes cloned git repo with local commit", { + testthat::skip_on_cran() + testthat::skip_if_offline() + test_dir <- normalizePath(withr::local_tempdir()) + dl <- gert::git_clone( + url = remote_package[["url"]], #nolint: nonportable_path_linter + path = test_dir, + verbose = FALSE + ) + testing_git_config(repo = test_dir) + test_file <- file.path(test_dir, "foo.txt") + writeLines("Hello, world!", con = test_file) + gert::git_add(files = basename(test_file), repo = normalizePath(test_dir)) + commit_sha <- gert::git_commit(repo = test_dir, message = "Initial commit") + metadata <- get_git_info(repo = test_dir) + expect_identical( + metadata, + list( + repo = normalizePath(test_dir), + is_git = TRUE, + commit = commit_sha, + clean = TRUE, + branch = list( + name = remote_package[["branch"]], + commit = commit_sha, + upstream = remote_package[["upstream"]], + remote_url = remote_package[["url"]], + up_to_date = FALSE, + upstream_commit = remote_package[["sha"]] + ), + changed_files = list(), + tags = list() + ) + ) +}) diff --git a/tests/testthat/test-get_individual_package_info.R b/tests/testthat/test-get_individual_package_info.R index f25385c..ca23ffe 100644 --- a/tests/testthat/test-get_individual_package_info.R +++ b/tests/testthat/test-get_individual_package_info.R @@ -22,7 +22,8 @@ expect_package_info <- function( remotepkgref_match, remoteref_identical, remotesha_identical, - loaded_with_pkgload_identical = FALSE + loaded_with_pkgload_identical = FALSE, + git = NULL ) { testthat::expect_type(package_info, "list") testthat::expect_named( @@ -39,7 +40,8 @@ expect_package_info <- function( "remotetype", "remotepkgref", "remoteref", - "remotesha" + "remotesha", + "git" ) ) testthat::expect_identical( @@ -71,7 +73,7 @@ expect_package_info <- function( } else { testthat::expect_in( object = package_info[["library"]], - .libPaths() #nolint: undesirable_function_linter + .libPaths() # nolint: undesirable_function_linter ) testthat::expect_gt( object = package_info[["library_index"]], @@ -79,17 +81,17 @@ expect_package_info <- function( ) testthat::expect_lte( object = package_info[["library_index"]], - expected = length(.libPaths()) #nolint: undesirable_function_linter + expected = length(.libPaths()) # nolint: undesirable_function_linter ) testthat::expect_match( object = package_info[["platform"]], - regexp = R.version[["platform"]] + regexp = paste0(R.version[["platform"]], "|\\*") ) } testthat::expect_identical( object = package_info[["library"]], - expected = .libPaths()[package_info[["library_index"]]] #nolint: undesirable_function_linter + expected = .libPaths()[package_info[["library_index"]]] # nolint: undesirable_function_linter ) testthat::expect_type( object = package_info[["library_index"]], @@ -138,6 +140,17 @@ expect_package_info <- function( object = package_info[["remotesha"]], remotesha_identical ) + if (is.null(git)) { + testthat::expect_identical( + object = package_info[["git"]], + expected = NA_character_ + ) + } else { + testthat::expect_identical( + object = package_info[["git"]], + expected = git + ) + } } test_that("get_individual_package_info collects information for CRAN packages correctly", { #nolint: line_length_linter @@ -185,22 +198,38 @@ test_that("get_individual_package_info collects information for local packages c testthat::skip_if_offline() dest_dir <- normalizePath(withr::local_tempdir()) dl <- gert::git_clone( - url = "https://github.com/yihui/rmini.git", #nolint: nonportable_path_linter + url = remote_package[["url"]], path = dest_dir, verbose = FALSE ) new_lib <- normalizePath(withr::local_tempdir()) with_local_install(new_lib, paste0("local::", dest_dir), { - package_info <- get_individual_package_info("rmini") + package_info <- get_individual_package_info(remote_package[["name"]]) expect_package_info( package_info, - package_identical = "rmini", - version_identical = "0.0.4", + package_identical = remote_package[["name"]], + version_identical = remote_package[["version"]], repository_match = NA_character_, remotetype_identical = "local", remotepkgref_match = paste0("^local::", dest_dir, "$"), remoteref_identical = NA_character_, - remotesha_identical = NA_character_ + remotesha_identical = NA_character_, + git = list( + repo = normalizePath(dest_dir), + is_git = TRUE, + commit = remote_package[["sha"]], + clean = TRUE, + branch = list( + name = remote_package[["branch"]], + commit = remote_package[["sha"]], + upstream = remote_package[["upstream"]], + remote_url = remote_package[["url"]], + up_to_date = TRUE, + upstream_commit = remote_package[["sha"]] + ), + changed_files = list(), + tags = list() + ) ) expect_identical( package_info[["library"]], @@ -213,17 +242,17 @@ test_that("get_individual_package_info collects information for GitHub packages testthat::skip_on_cran() testthat::skip_if_offline() new_lib <- normalizePath(withr::local_tempdir()) - package_info <- with_local_install(new_lib, "yihui/rmini", { #nolint: nonportable_path_linter - package_info <- get_individual_package_info("rmini") + package_info <- with_local_install(new_lib, remote_package[["gh_repo"]], { + package_info <- get_individual_package_info(remote_package[["name"]]) expect_package_info( package_info, - package_identical = "rmini", - version_identical = "0.0.4", + package_identical = remote_package[["name"]], + version_identical = remote_package[["version"]], repository_match = NA_character_, remotetype_identical = "github", - remotepkgref_match = "^yihui/rmini$", #nolint: nonportable_path_linter + remotepkgref_match = paste0("^", remote_package[["gh_repo"]], "$"), remoteref_identical = "HEAD", - remotesha_identical = "f839b7327c4cb422705b9f3b7c5ffc87555d98e2" + remotesha_identical = remote_package[["sha"]] ) expect_identical( package_info[["library"]], @@ -238,27 +267,43 @@ test_that("get_individual_package_info collects information for packages loaded testthat::skip_if_not_installed("pkgload") dest_dir <- normalizePath(withr::local_tempdir()) dl <- gert::git_clone( - url = "https://github.com/yihui/rmini.git", #nolint: nonportable_path_linter + url = remote_package[["url"]], path = dest_dir, verbose = FALSE ) loaded <- pkgload::load_all(dest_dir, quiet = TRUE) withr::defer({ - pkgload::unload(package = "rmini") + pkgload::unload(package = remote_package[["name"]]) }) testthat::expect_warning( object = { - package_info <- get_individual_package_info("rmini") + package_info <- get_individual_package_info(remote_package[["name"]]) expect_package_info( package_info, - package_identical = "rmini", - version_identical = "DEV 0.0.4", + package_identical = remote_package[["name"]], + version_identical = paste("DEV", remote_package[["version"]]), loaded_with_pkgload_identical = TRUE, repository_match = NA_character_, remotetype_identical = "pkgload", remotepkgref_match = paste0("^", dest_dir, "$"), remoteref_identical = NA_character_, - remotesha_identical = NA_character_ + remotesha_identical = NA_character_, + git = list( + repo = normalizePath(dest_dir), + is_git = TRUE, + commit = remote_package[["sha"]], + clean = TRUE, + branch = list( + name = remote_package[["branch"]], + commit = remote_package[["sha"]], + upstream = remote_package[["upstream"]], + remote_url = remote_package[["url"]], + up_to_date = TRUE, + upstream_commit = remote_package[["sha"]] + ), + changed_files = list(), + tags = list() + ) ) expect_identical( package_info[["remotepkgref"]], @@ -275,27 +320,104 @@ test_that("get_individual_package_info collects information for packages loaded testthat::skip_if_not_installed("devtools") dest_dir <- normalizePath(withr::local_tempdir()) dl <- gert::git_clone( - url = "https://github.com/yihui/rmini.git", #nolint: nonportable_path_linter + url = remote_package[["url"]], path = dest_dir, verbose = FALSE ) loaded <- devtools::load_all(dest_dir, quiet = TRUE) withr::defer({ - devtools::unload(package = "rmini") + devtools::unload(package = remote_package[["name"]]) }) testthat::expect_warning( object = { - package_info <- get_individual_package_info("rmini") + package_info <- get_individual_package_info(remote_package[["name"]]) expect_package_info( package_info, - package_identical = "rmini", - version_identical = "DEV 0.0.4", + package_identical = remote_package[["name"]], + version_identical = paste("DEV", remote_package[["version"]]), loaded_with_pkgload_identical = TRUE, repository_match = NA_character_, remotetype_identical = "pkgload", remotepkgref_match = paste0("^", dest_dir, "$"), remoteref_identical = NA_character_, - remotesha_identical = NA_character_ + remotesha_identical = NA_character_, + git = list( + repo = normalizePath(dest_dir), + is_git = TRUE, + commit = remote_package[["sha"]], + clean = TRUE, + branch = list( + name = remote_package[["branch"]], + commit = remote_package[["sha"]], + upstream = remote_package[["upstream"]], + remote_url = remote_package[["url"]], + up_to_date = TRUE, + upstream_commit = remote_package[["sha"]] + ), + changed_files = list(), + tags = list() + ) + ) + expect_identical( + package_info[["remotepkgref"]], + normalizePath(dest_dir) + ) + }, + "^Identifying development packages may not be accurate.$" + ) +}) + +test_that("get_individual_package_info collects information for altered packages loaded with devtools correctly", { #nolint: line_length_linter + testthat::skip_on_cran() + testthat::skip_if_offline() + testthat::skip_if_not_installed("devtools") + dest_dir <- normalizePath(withr::local_tempdir()) + dl <- gert::git_clone( + url = remote_package[["url"]], + path = dest_dir, + verbose = FALSE + ) + testing_git_config(repo = dest_dir) + test_file <- file.path(dest_dir, "foo.txt") + writeLines("Hello, world!", con = test_file) + gert::git_add(files = basename(test_file), repo = normalizePath(dest_dir)) + commit_sha <- gert::git_commit(repo = dest_dir, message = "Initial commit") + writeLines("Hello, testing!", con = test_file) + loaded <- devtools::load_all(dest_dir, quiet = TRUE) + withr::defer({ + devtools::unload(package = remote_package[["name"]]) + }) + testthat::expect_warning( + object = { + package_info <- get_individual_package_info(remote_package[["name"]]) + expect_package_info( + package_info, + package_identical = remote_package[["name"]], + version_identical = paste("DEV", remote_package[["version"]]), + loaded_with_pkgload_identical = TRUE, + repository_match = NA_character_, + remotetype_identical = "pkgload", + remotepkgref_match = paste0("^", dest_dir, "$"), + remoteref_identical = NA_character_, + remotesha_identical = NA_character_, + git = list( + repo = normalizePath(dest_dir), + is_git = TRUE, + commit = commit_sha, + clean = FALSE, + branch = list( + name = remote_package[["branch"]], + commit = commit_sha, + upstream = remote_package[["upstream"]], + remote_url = remote_package[["url"]], + up_to_date = FALSE, + upstream_commit = remote_package[["sha"]] + ), + changed_files = list( + foo.txt = "modified" + ), + tags = list() + ) ) expect_identical( package_info[["remotepkgref"]], @@ -337,18 +459,20 @@ test_that("get_individual_package_info gets correct libpath and version of multi new_lib <- normalizePath(withr::local_tempdir()) newer_lib <- normalizePath(withr::local_tempdir()) expect_warning( - with_local_install(new_lib, "yihui/rmini", { #nolint: nonportable_path_linter - with_local_install(newer_lib, "yihui/rmini@308d27d", { #nolint: nonportable_path_linter - package_info <- get_individual_package_info("rmini") + with_local_install(new_lib, remote_package[["gh_repo"]], { + with_local_install(newer_lib, remote_package[["gh_repo_old"]], { + package_info <- get_individual_package_info(remote_package[["name"]]) expect_package_info( package_info, - package_identical = "rmini", - version_identical = "0.0.3", # Note: not latest version + package_identical = remote_package[["name"]], + version_identical = remote_package[["old_version"]], repository_match = NA_character_, remotetype_identical = "github", - remotepkgref_match = "^yihui/rmini@308d27d$", #nolint: nonportable_path_linter - remoteref_identical = "308d27d", - remotesha_identical = "308d27ddb0b45fda34fc259492145834d72849a9" + remotepkgref_match = paste0( + "^", remote_package[["gh_repo_old"]], "$" + ), + remoteref_identical = "28c716f", + remotesha_identical = remote_package[["old_sha"]] ) expect_identical( package_info[["library"]], @@ -368,18 +492,18 @@ test_that("get_individual_package_info gets correct libpath for lower search pri testthat::skip_if_offline() new_lib <- normalizePath(withr::local_tempdir()) newer_lib <- normalizePath(withr::local_tempdir()) - with_local_install(new_lib, "yihui/rmini", { #nolint: nonportable_path_linter + with_local_install(new_lib, remote_package[["gh_repo"]], { with_local_install(newer_lib, "digest", { - package_info <- get_individual_package_info("rmini") + package_info <- get_individual_package_info(remote_package[["name"]]) expect_package_info( package_info, - package_identical = "rmini", - version_identical = "0.0.4", + package_identical = remote_package[["name"]], + version_identical = remote_package[["version"]], repository_match = NA_character_, remotetype_identical = "github", - remotepkgref_match = "^yihui/rmini$", #nolint: nonportable_path_linter + remotepkgref_match = paste0("^", remote_package[["gh_repo"]], "$"), remoteref_identical = "HEAD", - remotesha_identical = "f839b7327c4cb422705b9f3b7c5ffc87555d98e2" + remotesha_identical = remote_package[["sha"]] ) expect_identical( package_info[["library"]], diff --git a/tests/testthat/test-get_package_info.R b/tests/testthat/test-get_package_info.R index 2368272..01e9eb2 100644 --- a/tests/testthat/test-get_package_info.R +++ b/tests/testthat/test-get_package_info.R @@ -75,7 +75,8 @@ test_that("get_package_info outputs correct structure for defaults", { "remotetype", "remotepkgref", "remoteref", - "remotesha" + "remotesha", + "git" ) ) }, diff --git a/tests/testthat/test-is_git_path.R b/tests/testthat/test-is_git_path.R new file mode 100644 index 0000000..eabff57 --- /dev/null +++ b/tests/testthat/test-is_git_path.R @@ -0,0 +1,59 @@ +## save current settings so that we can reset later +threshold <- logger::log_threshold() +appender <- logger::log_appender() +layout <- logger::log_layout() +on.exit({ + ## reset logger settings + logger::log_threshold(threshold) + logger::log_layout(layout) + logger::log_appender(appender) +}) + +logger::log_appender(logger::appender_stdout) +logger::log_threshold(logger::FATAL) +logger::log_layout(logger::layout_simple) + +# # TESTS BEGIN +test_that("is_git_path processes non-existing directory correctly", { + test_dir <- withr::local_tempdir() + test_dir_child <- file.path(test_dir, "child") + expect_error( + object = is_git_path(path = test_dir_child), + regexp = "^Cannot find git information for path which does not exist.$" + ) +}) + +test_that("is_git_path processes non-existing file correctly", { + test_dir <- withr::local_tempdir() + test_file <- withr::local_tempfile(tmpdir = test_dir, fileext = ".rds") + expect_error( + object = is_git_path(path = test_file), + regexp = "^Cannot find git information for path which does not exist.$" + ) +}) + +test_that("is_git_path processes non-git-repo correctly", { + test_dir <- withr::local_tempdir() + expect_false(is_git_path(path = test_dir)) +}) + +test_that("is_git_path processes file in non-git-repo correctly", { + test_dir <- withr::local_tempdir() + test_file <- withr::local_tempfile(tmpdir = test_dir, fileext = ".rds") + saveRDS(mtcars, test_file) + expect_false(is_git_path(path = test_file)) +}) + +test_that("is_git_path processes git-repo correctly", { + test_dir <- withr::local_tempdir() + gert::git_init(path = test_dir) + expect_true(is_git_path(path = test_dir)) +}) + +test_that("is_git_path processes file in git-repo correctly", { + test_dir <- withr::local_tempdir() + gert::git_init(path = test_dir) + test_file <- withr::local_tempfile(tmpdir = test_dir, fileext = ".rds") + saveRDS(mtcars, test_file) + expect_true(is_git_path(path = test_file)) +})