forked from r-lib/usethis
-
Notifications
You must be signed in to change notification settings - Fork 0
/
helper.R
133 lines (116 loc) · 4.27 KB
/
helper.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
## If session temp directory appears to be, or be within, a project, there
## will be large scale, spurious test failures.
## The IDE sometimes leaves .Rproj files behind in session temp directory or
## one of its parents.
## Delete such files manually.
session_temp_proj <- proj_find(path_temp())
if (!is.null(session_temp_proj)) {
Rproj_files <- fs::dir_ls(session_temp_proj, glob = "*.Rproj")
ui_bullets(c(
"x" = "Rproj {cli::qty(length(Rproj_files))} file{?s} found at or above session temp dir:",
bulletize(usethis_map_cli(Rproj_files)),
"!" = "Expect this to cause spurious test failures."
))
}
create_local_package <- function(dir = file_temp(pattern = "testpkg"),
env = parent.frame(),
rstudio = FALSE) {
create_local_thing(dir, env, rstudio, "package")
}
create_local_project <- function(dir = file_temp(pattern = "testproj"),
env = parent.frame(),
rstudio = FALSE) {
create_local_thing(dir, env, rstudio, "project")
}
create_local_thing <- function(dir = file_temp(pattern = pattern),
env = parent.frame(),
rstudio = FALSE,
thing = c("package", "project")) {
thing <- match.arg(thing)
if (fs::dir_exists(dir)) {
ui_abort("Target {.arg dir} {.path {pth(dir)}} already exists.")
}
old_project <- proj_get_() # this could be `NULL`, i.e. no active project
old_wd <- getwd() # not necessarily same as `old_project`
withr::defer(
{
ui_bullets(c("Deleting temporary project: {.path {dir}}"))
fs::dir_delete(dir)
},
envir = env
)
ui_silence(
switch(
thing,
package = create_package(
dir,
# This is for the sake of interactive development of snapshot tests.
# When the active usethis project is a package created with this
# function, testthat learns its edition from *that* package, not from
# usethis. So, by default, opt in to testthat 3e in these ephemeral test
# packages.
fields = list("Config/testthat/edition" = "3"),
rstudio = rstudio,
open = FALSE,
check_name = FALSE
),
project = create_project(dir, rstudio = rstudio, open = FALSE)
)
)
withr::defer(proj_set(old_project, force = TRUE), envir = env)
proj_set(dir)
withr::defer(
{
ui_bullets(c("Restoring original working directory: {.path {old_wd}}"))
setwd(old_wd)
},
envir = env
)
setwd(proj_get())
invisible(proj_get())
}
scrub_testpkg <- function(message) {
gsub("testpkg[a-zA-Z0-9]+", "{TESTPKG}", message, perl = TRUE)
}
scrub_testproj <- function(message) {
gsub("testproj[a-zA-Z0-9]+", "{TESTPROJ}", message, perl = TRUE)
}
skip_if_not_ci <- function() {
ci_providers <- c("GITHUB_ACTIONS", "TRAVIS", "APPVEYOR")
ci <- any(toupper(Sys.getenv(ci_providers)) == "TRUE")
if (ci) {
return(invisible(TRUE))
}
skip("Not on GitHub Actions, Travis, or Appveyor")
}
skip_if_no_git_user <- function() {
user_name <- git_cfg_get("user.name")
user_email <- git_cfg_get("user.email")
user_name_exists <- !is.null(user_name)
user_email_exists <- !is.null(user_email)
if (user_name_exists && user_email_exists) {
return(invisible(TRUE))
}
skip("No Git user configured")
}
# CRAN's mac builder sets $HOME to a read-only ram disk, so tests can fail if
# you even tickle something that might try to lock its own config file during
# the operation (e.g. git) or if you simply test for writeability
skip_on_cran_macos <- function() {
sysname <- tolower(Sys.info()[["sysname"]])
on_cran <- !identical(Sys.getenv("NOT_CRAN"), "true")
if (on_cran && sysname == "darwin") {
skip("On CRAN and on macOS")
}
invisible(TRUE)
}
expect_usethis_error <- function(...) {
expect_error(..., class = "usethis_error")
}
is_build_ignored <- function(pattern, ..., base_path = proj_get()) {
lines <- read_utf8(path(base_path, ".Rbuildignore"))
length(grep(pattern, x = lines, fixed = TRUE, ...)) > 0
}
test_file <- function(fname) testthat::test_path("ref", fname)
expect_proj_file <- function(...) expect_true(file_exists(proj_path(...)))
expect_proj_dir <- function(...) expect_true(dir_exists(proj_path(...)))