Skip to content

Commit

Permalink
add shQuote; more robust status check
Browse files Browse the repository at this point in the history
  • Loading branch information
kevinushey committed Aug 12, 2024
1 parent af66733 commit 5540543
Show file tree
Hide file tree
Showing 2 changed files with 2 additions and 2 deletions.
2 changes: 1 addition & 1 deletion R/covr.R
Original file line number Diff line number Diff line change
Expand Up @@ -453,7 +453,7 @@ package_coverage <- function(path = ".",
"--with-keep.parse.data",
"--no-staged-install",
"--no-multiarch",
pkg$path
shQuote(pkg$path)
)

name <- if (.Platform$OS.type == "windows") "R.exe" else "R"
Expand Down
2 changes: 1 addition & 1 deletion tests/testthat/test-record_tests.R
Original file line number Diff line number Diff line change
Expand Up @@ -194,7 +194,7 @@ test_that("covr.record_tests: safely handles extremely large calls", {
res <- system2(file.path(R.home("bin"), "R"), list("-q", "-s", "--vanilla", "-f", r_script), stdout = TRUE, stderr = TRUE)
})

if (attr(res, "status") == 0L) {
if (identical(attr(res, "status"), 0L)) {
warning(paste0(collapse = "\n", strwrap(paste0(
"Looks like R was updated and the work-around for Rds ",
"deserialization segfaults can now be made to apply conditionally to only ",
Expand Down

0 comments on commit 5540543

Please sign in to comment.