Skip to content

Commit 284e149

Browse files
bschilderclaude
bschilder
and
claude
committed
Expand test coverage for low-coverage files, 68% -> 70%
Added tests for get_os, args2vars, set_permissions, source_all, and setup_gcc path detection logic. Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
1 parent a703102 commit 284e149

5 files changed

Lines changed: 498 additions & 33 deletions

File tree

‎tests/testthat/test-args2vars.R‎

Lines changed: 137 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -1,8 +1,8 @@
11
test_that("args2vars works", {
2-
2+
33
fn <- utils::packageDate
44
args <- rlang::fn_fmls(fn = fn)
5-
5+
66
run_tests <- function(args, args_return){
77
testthat::expect_equal(names(args_return), names(args))
88
testthat::expect_equal(
@@ -12,37 +12,164 @@ test_that("args2vars works", {
1212
testthat::expect_null(args_return$lib.loc)
1313
testthat::expect_error(args_return$pkg())
1414
}
15-
15+
1616
args_return <- args2vars(fn = fn)
1717
#### Check list output ####
18-
run_tests(args = args,
18+
run_tests(args = args,
1919
args_return = args_return)
2020
#### Check globals ####
2121
#### Check that each argument also exists are a variable in the namespace
2222
for(arg in names(args_return)){
2323
message(arg)
2424
testthat::expect_true(exists(arg, envir = .GlobalEnv))
2525
}
26-
26+
2727
#### Reverse / remove globals ####
28-
args_return2 <- args2vars(fn = fn,
28+
args_return2 <- args2vars(fn = fn,
2929
remove = TRUE)
3030
#### Check list output ####
31-
run_tests(args = args,
31+
run_tests(args = args,
3232
args_return = args_return2)
3333
#### Check globals ####
3434
#### Check that each argument also exists are a variable in the namespace
3535
for(arg in names(args_return)){
3636
message(arg)
3737
testthat::expect_false(exists(arg, envir = .GlobalEnv))
3838
}
39-
39+
4040
#### Test "parent" function ####
4141
testfun <- function(x=1,y=2){
42-
devoptera::args2vars(fn="parent", run_source_all = FALSE)
42+
devoptera::args2vars(fn="parent", run_source_all = FALSE)
4343
}
4444
args_parent <- testfun()
4545
testthat::expect_equal(names(args_parent), c("x","y"))
4646
testthat::expect_equal(args_parent$x, 1)
47-
testthat::expect_equal(args_parent$y, 2)
47+
testthat::expect_equal(args_parent$y, 2)
48+
})
49+
50+
test_that("args2vars extracts defaults from a simple function", {
51+
52+
my_fn <- function(a = 10, b = "hello", c = TRUE) NULL
53+
env <- new.env(parent = .GlobalEnv)
54+
res <- args2vars(fn = my_fn, envir = env, run_source_all = FALSE)
55+
56+
testthat::expect_type(res, "list")
57+
testthat::expect_equal(names(res), c("a", "b", "c"))
58+
testthat::expect_equal(res$a, 10)
59+
testthat::expect_equal(res$b, "hello")
60+
testthat::expect_equal(res$c, TRUE)
61+
62+
## Check variables were assigned in the target environment
63+
testthat::expect_true(exists("a", envir = env))
64+
testthat::expect_true(exists("b", envir = env))
65+
testthat::expect_true(exists("c", envir = env))
66+
testthat::expect_equal(get("a", envir = env), 10)
67+
testthat::expect_equal(get("b", envir = env), "hello")
68+
testthat::expect_equal(get("c", envir = env), TRUE)
69+
})
70+
71+
test_that("args2vars handles function with no defaults", {
72+
73+
no_defaults_fn <- function(aa_no_def, bb_no_def, cc_no_def) NULL
74+
env <- new.env(parent = emptyenv())
75+
res <- args2vars(fn = no_defaults_fn, envir = env, run_source_all = FALSE)
76+
77+
testthat::expect_type(res, "list")
78+
testthat::expect_equal(names(res), c("aa_no_def", "bb_no_def", "cc_no_def"))
79+
## Arguments without defaults should not be assigned in the target env
80+
testthat::expect_false(exists("aa_no_def", envir = env, inherits = FALSE))
81+
testthat::expect_false(exists("bb_no_def", envir = env, inherits = FALSE))
82+
testthat::expect_false(exists("cc_no_def", envir = env, inherits = FALSE))
83+
})
84+
85+
test_that("args2vars handles mixed defaults and no-defaults", {
86+
87+
mixed_fn <- function(aa_mixed, yy_mixed = 42, zz_mixed) NULL
88+
env <- new.env(parent = emptyenv())
89+
res <- args2vars(fn = mixed_fn, envir = env, run_source_all = FALSE)
90+
91+
testthat::expect_equal(names(res), c("aa_mixed", "yy_mixed", "zz_mixed"))
92+
## yy_mixed has a default, aa_mixed and zz_mixed do not
93+
testthat::expect_true(exists("yy_mixed", envir = env, inherits = FALSE))
94+
testthat::expect_equal(get("yy_mixed", envir = env), 42)
95+
testthat::expect_false(exists("aa_mixed", envir = env, inherits = FALSE))
96+
testthat::expect_false(exists("zz_mixed", envir = env, inherits = FALSE))
97+
})
98+
99+
test_that("args2vars reassign=FALSE preserves existing globals", {
100+
101+
env <- new.env(parent = .GlobalEnv)
102+
assign("a", 999, envir = env)
103+
104+
my_fn <- function(a = 10, b = 20) NULL
105+
res <- args2vars(fn = my_fn, envir = env,
106+
run_source_all = FALSE, reassign = FALSE)
107+
108+
## a should remain 999 because reassign=FALSE
109+
110+
testthat::expect_equal(get("a", envir = env), 999)
111+
## b should be assigned since it didn't exist
112+
testthat::expect_equal(get("b", envir = env), 20)
113+
})
114+
115+
test_that("args2vars reassign=TRUE overwrites existing globals", {
116+
117+
env <- new.env(parent = .GlobalEnv)
118+
assign("a", 999, envir = env)
119+
120+
my_fn <- function(a = 10, b = 20) NULL
121+
res <- args2vars(fn = my_fn, envir = env,
122+
run_source_all = FALSE, reassign = TRUE)
123+
124+
## a should be overwritten to 10
125+
testthat::expect_equal(get("a", envir = env), 10)
126+
testthat::expect_equal(get("b", envir = env), 20)
127+
})
128+
129+
test_that("args2vars with remove=TRUE cleans up globals", {
130+
131+
env <- new.env(parent = .GlobalEnv)
132+
my_fn <- function(a = 10, b = 20) NULL
133+
134+
## First assign
135+
args2vars(fn = my_fn, envir = env, run_source_all = FALSE)
136+
testthat::expect_true(exists("a", envir = env))
137+
testthat::expect_true(exists("b", envir = env))
138+
139+
## Then remove
140+
args2vars(fn = my_fn, envir = env,
141+
run_source_all = FALSE, remove = TRUE)
142+
testthat::expect_false(exists("a", envir = env))
143+
testthat::expect_false(exists("b", envir = env))
144+
})
145+
146+
test_that("args2vars handles expression defaults", {
147+
148+
expr_fn <- function(x = 1 + 2, y = paste0("a", "b")) NULL
149+
env <- new.env(parent = .GlobalEnv)
150+
res <- args2vars(fn = expr_fn, envir = env, run_source_all = FALSE)
151+
152+
testthat::expect_equal(get("x", envir = env), 3)
153+
testthat::expect_equal(get("y", envir = env), "ab")
154+
})
155+
156+
test_that("args2vars handles NULL default", {
157+
158+
null_fn <- function(x = NULL) NULL
159+
env <- new.env(parent = .GlobalEnv)
160+
res <- args2vars(fn = null_fn, envir = env, run_source_all = FALSE)
161+
162+
testthat::expect_true(exists("x", envir = env))
163+
testthat::expect_null(get("x", envir = env))
164+
})
165+
166+
test_that("args2vars returns named list matching formals", {
167+
168+
my_fn <- function(alpha = 1, beta = 2, gamma = 3) NULL
169+
env <- new.env(parent = .GlobalEnv)
170+
res <- args2vars(fn = my_fn, envir = env, run_source_all = FALSE)
171+
172+
testthat::expect_type(res, "list")
173+
testthat::expect_length(res, 3)
174+
testthat::expect_named(res, c("alpha", "beta", "gamma"))
48175
})

‎tests/testthat/test-get_os.R‎

Lines changed: 33 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,37 @@
11
test_that("get_os works", {
2-
2+
33
os <- get_os()
44
testthat::expect_true(tolower(os) %in% c("windows","mac","linux"))
55
})
6+
7+
test_that("get_os returns lowercase by default", {
8+
9+
os <- get_os()
10+
testthat::expect_identical(os, tolower(os))
11+
})
12+
13+
test_that("get_os lower=FALSE returns title case", {
14+
15+
os <- get_os(lower = FALSE)
16+
testthat::expect_true(os %in% c("Windows", "Mac", "Linux"))
17+
## First letter should be uppercase
18+
testthat::expect_identical(
19+
substr(os, 1, 1),
20+
toupper(substr(os, 1, 1))
21+
)
22+
})
23+
24+
test_that("get_os returns a single character string", {
25+
26+
os <- get_os()
27+
testthat::expect_type(os, "character")
28+
testthat::expect_length(os, 1)
29+
testthat::expect_gt(nchar(os), 0)
30+
})
31+
32+
test_that("get_os lower=TRUE and lower=FALSE are consistent", {
33+
34+
os_lower <- get_os(lower = TRUE)
35+
os_upper <- get_os(lower = FALSE)
36+
testthat::expect_identical(tolower(os_upper), os_lower)
37+
})

‎tests/testthat/test-set_permissions.R‎

Lines changed: 86 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -1,16 +1,96 @@
11
test_that("set_permissions works", {
2-
2+
33
f <- tempfile()
44
writeLines(text = letters, con = f)
55
set_permissions(f)
6-
7-
testthat::expect_true(as.character(file.info(f)$mode) %in% c("777","666"))
8-
6+
7+
testthat::expect_true(as.character(file.info(f)$mode) %in% c("777","666"))
8+
99
testthat::expect_error(
1010
set_permissions(f, sudo = TRUE)
1111
)
12-
12+
1313
testthat::expect_no_error(
1414
set_permissions(f, sudo = TRUE, pass = "password")
15-
)
15+
)
16+
})
17+
18+
test_that("set_permissions sets permissions on a temp file", {
19+
20+
f <- tempfile(fileext = ".txt")
21+
writeLines("test content", con = f)
22+
on.exit(unlink(f), add = TRUE)
23+
24+
## Start with restrictive permissions
25+
Sys.chmod(f, mode = "400")
26+
info_before <- file.info(f)
27+
28+
set_permissions(f, verbose = FALSE)
29+
30+
info_after <- file.info(f)
31+
## After set_permissions the file should have 777
32+
testthat::expect_equal(as.character(info_after$mode), "777")
33+
})
34+
35+
test_that("set_permissions works with is_folder=TRUE on a temp directory", {
36+
testthat::skip_on_cran()
37+
38+
d <- tempfile()
39+
dir.create(d)
40+
f1 <- file.path(d, "a.txt")
41+
f2 <- file.path(d, "b.txt")
42+
writeLines("a", f1)
43+
writeLines("b", f2)
44+
on.exit(unlink(d, recursive = TRUE), add = TRUE)
45+
46+
testthat::expect_no_error(
47+
set_permissions(d, is_folder = TRUE, verbose = FALSE)
48+
)
49+
50+
## Check that the files inside are accessible
51+
testthat::expect_true(file.exists(f1))
52+
testthat::expect_true(file.exists(f2))
53+
})
54+
55+
test_that("set_permissions with custom permissions list", {
56+
testthat::skip_on_cran()
57+
58+
f <- tempfile(fileext = ".sh")
59+
writeLines("#!/bin/bash\necho hello", con = f)
60+
on.exit(unlink(f), add = TRUE)
61+
62+
custom_perms <- list(
63+
"Windows" = "Everyone:(OI)(CI)RX",
64+
"Mac" = "u=rwx,go=rx",
65+
"Linux" = "u=rwx,go=rx",
66+
"default" = "u=rwx,go=rx"
67+
)
68+
69+
testthat::expect_no_error(
70+
set_permissions(f, permissions = custom_perms, verbose = FALSE)
71+
)
72+
})
73+
74+
test_that("set_permissions verbose=FALSE suppresses messages", {
75+
76+
f <- tempfile(fileext = ".txt")
77+
writeLines("test", con = f)
78+
on.exit(unlink(f), add = TRUE)
79+
80+
## verbose=FALSE should not produce messages from messager
81+
testthat::expect_no_error(
82+
set_permissions(f, verbose = FALSE)
83+
)
84+
})
85+
86+
test_that("set_permissions errors when sudo=TRUE and pass is empty", {
87+
88+
f <- tempfile(fileext = ".txt")
89+
writeLines("test", con = f)
90+
on.exit(unlink(f), add = TRUE)
91+
92+
testthat::expect_error(
93+
set_permissions(f, sudo = TRUE, pass = ""),
94+
"pass"
95+
)
1696
})

0 commit comments

Comments
 (0)