diff --git a/.Rbuildignore b/.Rbuildignore
index 7f111acd..8e8efe0b 100644
--- a/.Rbuildignore
+++ b/.Rbuildignore
@@ -11,6 +11,8 @@
^src/processx\.dll$
^src/client\.so$
^src/client\.dll$
+^src/test/sigtermignore\.so$
+^src/test/sigtermignore\.dll$
^src/.*\.o$
^src/tools/px$
^src/tools/px.exe$
@@ -30,3 +32,5 @@
^src/.*[.]gcno$
^dev-lib$
^vignettes$
+^[\.]?air\.toml$
+^\.vscode$
diff --git a/.github/CODE_OF_CONDUCT.md b/.github/CODE_OF_CONDUCT.md
index df4ca2ec..3ac34c82 100644
--- a/.github/CODE_OF_CONDUCT.md
+++ b/.github/CODE_OF_CONDUCT.md
@@ -59,7 +59,7 @@ representative at an online or offline event.
## Enforcement
Instances of abusive, harassing, or otherwise unacceptable behavior may be
-reported to the community leaders responsible for enforcement at codeofconduct@rstudio.com.
+reported to the community leaders responsible for enforcement at codeofconduct@posit.co.
All complaints will be reviewed and investigated promptly and fairly.
All community leaders are obligated to respect the privacy and security of the
diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml
index ee65ccb5..9ce0693c 100644
--- a/.github/workflows/R-CMD-check.yaml
+++ b/.github/workflows/R-CMD-check.yaml
@@ -8,9 +8,10 @@ on:
push:
branches: [main, master]
pull_request:
- branches: [main, master]
-name: R-CMD-check
+name: R-CMD-check.yaml
+
+permissions: read-all
jobs:
R-CMD-check:
@@ -24,25 +25,25 @@ jobs:
config:
- {os: macos-latest, r: 'release'}
+ - {os: windows-latest, r: 'devel'}
+ - {os: windows-latest, r: 'next'}
- {os: windows-latest, r: 'release'}
- # Use 3.6 to trigger usage of RTools35
- - {os: windows-latest, r: '3.6'}
- # use 4.1 to check with rtools40's older compiler
- - {os: windows-latest, r: '4.1'}
-
- - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'}
- - {os: ubuntu-latest, r: 'release'}
- - {os: ubuntu-latest, r: 'oldrel-1'}
- - {os: ubuntu-latest, r: 'oldrel-2'}
- - {os: ubuntu-latest, r: 'oldrel-3'}
- - {os: ubuntu-latest, r: 'oldrel-4'}
+ # use 4.0 or 4.1 to check with rtools40's older compiler
+ - {os: windows-latest, r: 'oldrel-4'}
+
+ - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'}
+ - {os: ubuntu-latest, r: 'release'}
+ - {os: ubuntu-latest, r: 'oldrel-1'}
+ - {os: ubuntu-latest, r: 'oldrel-2'}
+ - {os: ubuntu-latest, r: 'oldrel-3'}
+ - {os: ubuntu-latest, r: 'oldrel-4'}
env:
GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
R_KEEP_PKG_SOURCE: yes
steps:
- - uses: actions/checkout@v3
+ - uses: actions/checkout@v4
- uses: r-lib/actions/setup-pandoc@v2
@@ -57,6 +58,9 @@ jobs:
extra-packages: any::rcmdcheck
needs: check
+ - uses: r-hub/actions/debug-shell@v1
+
- uses: r-lib/actions/check-r-package@v2
with:
upload-snapshots: true
+ build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")'
diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml
index 087f0b05..bfc9f4db 100644
--- a/.github/workflows/pkgdown.yaml
+++ b/.github/workflows/pkgdown.yaml
@@ -4,12 +4,13 @@ on:
push:
branches: [main, master]
pull_request:
- branches: [main, master]
release:
types: [published]
workflow_dispatch:
-name: pkgdown
+name: pkgdown.yaml
+
+permissions: read-all
jobs:
pkgdown:
@@ -19,8 +20,10 @@ jobs:
group: pkgdown-${{ github.event_name != 'pull_request' || github.run_id }}
env:
GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+ permissions:
+ contents: write
steps:
- - uses: actions/checkout@v3
+ - uses: actions/checkout@v4
- uses: r-lib/actions/setup-pandoc@v2
@@ -39,7 +42,7 @@ jobs:
- name: Deploy to GitHub pages 🚀
if: github.event_name != 'pull_request'
- uses: JamesIves/github-pages-deploy-action@v4.4.1
+ uses: JamesIves/github-pages-deploy-action@v4.5.0
with:
clean: false
branch: gh-pages
diff --git a/.github/workflows/pr-commands.yaml b/.github/workflows/pr-commands.yaml
index 71f335b3..2edd93f2 100644
--- a/.github/workflows/pr-commands.yaml
+++ b/.github/workflows/pr-commands.yaml
@@ -4,7 +4,9 @@ on:
issue_comment:
types: [created]
-name: Commands
+name: pr-commands.yaml
+
+permissions: read-all
jobs:
document:
@@ -13,8 +15,10 @@ jobs:
runs-on: ubuntu-latest
env:
GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+ permissions:
+ contents: write
steps:
- - uses: actions/checkout@v3
+ - uses: actions/checkout@v4
- uses: r-lib/actions/pr-fetch@v2
with:
@@ -50,8 +54,10 @@ jobs:
runs-on: ubuntu-latest
env:
GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+ permissions:
+ contents: write
steps:
- - uses: actions/checkout@v3
+ - uses: actions/checkout@v4
- uses: r-lib/actions/pr-fetch@v2
with:
diff --git a/.github/workflows/rhub-ci.yaml b/.github/workflows/rhub-ci.yaml
new file mode 100644
index 00000000..b5551493
--- /dev/null
+++ b/.github/workflows/rhub-ci.yaml
@@ -0,0 +1,80 @@
+name: rhub-ci.yaml
+
+on:
+ push:
+ branches: [main, master]
+ pull_request:
+ workflow_dispatch:
+
+permissions: read-all
+
+jobs:
+
+ setup:
+ runs-on: ubuntu-latest
+ outputs:
+ containers: ${{ steps.rhub-setup.outputs.containers }}
+ platforms: ${{ steps.rhub-setup.outputs.platforms }}
+
+ steps:
+ # NO NEED TO CHECKOUT HERE
+ - uses: r-hub/actions/setup@main
+ with:
+ config: clang-asan,clang-ubsan,rchk,valgrind
+ id: rhub-setup
+
+ linux-containers:
+ needs: setup
+ if: ${{ needs.setup.outputs.containers != '[]' }}
+ runs-on: ubuntu-latest
+ name: ${{ matrix.config.label }}
+ strategy:
+ fail-fast: false
+ matrix:
+ config: ${{ fromJson(needs.setup.outputs.containers) }}
+ container:
+ image: ${{ matrix.config.container }}
+
+ steps:
+ - uses: r-hub/actions/checkout@main
+ - uses: r-hub/actions/platform-info@main
+ with:
+ token: ${{ secrets.RHUB_TOKEN }}
+ job-config: ${{ matrix.config.job-config }}
+ - uses: r-hub/actions/setup-deps@main
+ with:
+ token: ${{ secrets.RHUB_TOKEN }}
+ job-config: ${{ matrix.config.job-config }}
+ - uses: r-hub/actions/run-check@main
+ with:
+ token: ${{ secrets.RHUB_TOKEN }}
+ job-config: ${{ matrix.config.job-config }}
+
+ other-platforms:
+ needs: setup
+ if: ${{ needs.setup.outputs.platforms != '[]' }}
+ runs-on: ${{ matrix.config.os }}
+ name: ${{ matrix.config.label }}
+ strategy:
+ fail-fast: false
+ matrix:
+ config: ${{ fromJson(needs.setup.outputs.platforms) }}
+
+ steps:
+ - uses: r-hub/actions/checkout@main
+ - uses: r-hub/actions/setup-r@main
+ with:
+ job-config: ${{ matrix.config.job-config }}
+ token: ${{ secrets.RHUB_TOKEN }}
+ - uses: r-hub/actions/platform-info@main
+ with:
+ token: ${{ secrets.RHUB_TOKEN }}
+ job-config: ${{ matrix.config.job-config }}
+ - uses: r-hub/actions/setup-deps@main
+ with:
+ job-config: ${{ matrix.config.job-config }}
+ token: ${{ secrets.RHUB_TOKEN }}
+ - uses: r-hub/actions/run-check@main
+ with:
+ job-config: ${{ matrix.config.job-config }}
+ token: ${{ secrets.RHUB_TOKEN }}
diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml
index 2c5bb502..0ab748d6 100644
--- a/.github/workflows/test-coverage.yaml
+++ b/.github/workflows/test-coverage.yaml
@@ -4,9 +4,10 @@ on:
push:
branches: [main, master]
pull_request:
- branches: [main, master]
-name: test-coverage
+name: test-coverage.yaml
+
+permissions: read-all
jobs:
test-coverage:
@@ -15,7 +16,7 @@ jobs:
GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
steps:
- - uses: actions/checkout@v3
+ - uses: actions/checkout@v4
- uses: r-lib/actions/setup-r@v2
with:
@@ -23,28 +24,39 @@ jobs:
- uses: r-lib/actions/setup-r-dependencies@v2
with:
- extra-packages: any::covr
+ extra-packages: any::covr, any::xml2
needs: coverage
- name: Test coverage
run: |
- covr::codecov(
+ cov <- covr::package_coverage(
quiet = FALSE,
clean = FALSE,
- install_path = file.path(Sys.getenv("RUNNER_TEMP"), "package")
+ install_path = file.path(normalizePath(Sys.getenv("RUNNER_TEMP"), winslash = "/"), "package")
)
+ print(cov)
+ covr::to_cobertura(cov)
shell: Rscript {0}
+ - uses: codecov/codecov-action@v5
+ with:
+ # Fail if error if not on PR, or if on PR and token is given
+ fail_ci_if_error: ${{ github.event_name != 'pull_request' || secrets.CODECOV_TOKEN }}
+ files: ./cobertura.xml
+ plugins: noop
+ disable_search: true
+ token: ${{ secrets.CODECOV_TOKEN }}
+
- name: Show testthat output
if: always()
run: |
## --------------------------------------------------------------------
- find ${{ runner.temp }}/package -name 'testthat.Rout*' -exec cat '{}' \; || true
+ find '${{ runner.temp }}/package' -name 'testthat.Rout*' -exec cat '{}' \; || true
shell: bash
- name: Upload test results
if: failure()
- uses: actions/upload-artifact@v3
+ uses: actions/upload-artifact@v4
with:
name: coverage-test-failures
path: ${{ runner.temp }}/package
diff --git a/.vscode/extensions.json b/.vscode/extensions.json
new file mode 100644
index 00000000..344f76eb
--- /dev/null
+++ b/.vscode/extensions.json
@@ -0,0 +1,5 @@
+{
+ "recommendations": [
+ "Posit.air-vscode"
+ ]
+}
diff --git a/.vscode/settings.json b/.vscode/settings.json
new file mode 100644
index 00000000..f2d0b79d
--- /dev/null
+++ b/.vscode/settings.json
@@ -0,0 +1,6 @@
+{
+ "[r]": {
+ "editor.formatOnSave": true,
+ "editor.defaultFormatter": "Posit.air-vscode"
+ }
+}
diff --git a/CODE_OF_CONDUCT.md b/CODE_OF_CONDUCT.md
deleted file mode 100644
index 24aa0a3c..00000000
--- a/CODE_OF_CONDUCT.md
+++ /dev/null
@@ -1,25 +0,0 @@
-# Contributor Code of Conduct
-
-As contributors and maintainers of this project, we pledge to respect all people who
-contribute through reporting issues, posting feature requests, updating documentation,
-submitting pull requests or patches, and other activities.
-
-We are committed to making participation in this project a harassment-free experience for
-everyone, regardless of level of experience, gender, gender identity and expression,
-sexual orientation, disability, personal appearance, body size, race, ethnicity, age, or religion.
-
-Examples of unacceptable behavior by participants include the use of sexual language or
-imagery, derogatory comments or personal attacks, trolling, public or private harassment,
-insults, or other unprofessional conduct.
-
-Project maintainers have the right and responsibility to remove, edit, or reject comments,
-commits, code, wiki edits, issues, and other contributions that are not aligned to this
-Code of Conduct. Project maintainers who do not follow the Code of Conduct may be removed
-from the project team.
-
-Instances of abusive, harassing, or otherwise unacceptable behavior may be reported by
-opening an issue or contacting one or more of the project maintainers.
-
-This Code of Conduct is adapted from the Contributor Covenant
-(http://contributor-covenant.org), version 1.0.0, available at
-http://contributor-covenant.org/version/1/0/0/
diff --git a/DESCRIPTION b/DESCRIPTION
index 507aa4ac..d4dc4f5a 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,12 +1,13 @@
Package: processx
Title: Execute and Control System Processes
-Version: 3.8.1.9000
+Version: 3.8.6.9000
Authors@R: c(
person("Gábor", "Csárdi", , "csardi.gabor@gmail.com", role = c("aut", "cre", "cph"),
comment = c(ORCID = "0000-0001-7098-9676")),
person("Winston", "Chang", role = "aut"),
- person("RStudio", role = c("cph", "fnd")),
- person("Mango Solutions", role = c("cph", "fnd"))
+ person("Posit Software, PBC", role = c("cph", "fnd"),
+ comment = c(ROR = "03wc8by49")),
+ person("Ascent Digital Services", role = c("cph", "fnd"))
)
Description: Tools to run system processes in the background. It can
check if a background process is running; wait on a background process
@@ -16,9 +17,10 @@ Description: Tools to run system processes in the background. It can
standard output or error, with a timeout. It can also poll several
processes at once.
License: MIT + file LICENSE
-URL: https://processx.r-lib.org, https://github.com/r-lib/processx#readme
+URL: https://processx.r-lib.org, https://github.com/r-lib/processx
BugReports: https://github.com/r-lib/processx/issues
-Depends: R (>= 3.4.0)
+Depends:
+ R (>= 3.4.0)
Imports:
ps (>= 1.2.0),
R6,
@@ -31,12 +33,14 @@ Suggests:
curl,
debugme,
parallel,
+ pkgload,
rlang (>= 1.0.2),
testthat (>= 3.0.0),
webfakes,
withr
+Config/Needs/website: tidyverse/tidytemplate
+Config/testthat/edition: 3
+Config/usethis/last-upkeep: 2025-04-25
Encoding: UTF-8
-RoxygenNote: 7.2.0
Roxygen: list(markdown = TRUE)
-Config/testthat/edition: 3
-Config/Needs/website: tidyverse/tidytemplate
+RoxygenNote: 7.3.2
diff --git a/LICENSE b/LICENSE
index c748ae04..649f164c 100644
--- a/LICENSE
+++ b/LICENSE
@@ -1,2 +1,2 @@
-YEAR: 2016-2019
-COPYRIGHT HOLDER: Mango Solutions, RStudio, Gábor Csárdi
+YEAR: 2025
+COPYRIGHT HOLDER: processx core team, see COPYRIGHTS file
diff --git a/LICENSE.md b/LICENSE.md
index eb224c72..84d1d54a 100644
--- a/LICENSE.md
+++ b/LICENSE.md
@@ -1,6 +1,6 @@
# MIT License
-Copyright (c) 2016-2019 Mango Solutions, RStudio, Gábor Csárdi
+Copyright (c) 2025 processx authors
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
diff --git a/NEWS.md b/NEWS.md
index 4dc1f5a2..af422b00 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,5 +1,38 @@
# processx (development version)
+* The `grace` argument of the `kill()` method is now active on Unix
+ platforms. processx first tries to kill with `SIGTERM` with a
+ timeout of `grace` seconds. After the timeout, `SIGKILL` is sent as
+ before.
+
+# processx 3.8.6
+
+* `processx::process` objects are cloneable again, temporarily,
+ to avoid warning-like messages from R6 2.6.0 and later.
+
+* processx now does not change the state of the RNG (#390).
+
+# processx 3.8.5
+
+* No changes.
+
+# processx 3.8.4
+
+* No changes.
+
+# processx 3.8.3
+
+* `*printf()` format strings are now safer (#379).
+
+# processx 3.8.2
+
+* The client library, used by callr, now ignores `SIGPIPE` when writing
+ to a file descriptor, on unix. This avoid possible freezes when a
+ `callr::r_session` subprocess is trying to report its result after the
+ main process was terminated. In particular, this happened with parallel
+ testthat: https://github.com/r-lib/testthat/issues/1819
+>>>>>>> df0579681e7953e52174614fba8836b9a9c0afbc
+
# processx 3.8.1
* On Unixes, R processes created by callr now feature a `SIGTERM`
diff --git a/R/aaa-import-standalone-rstudio-detect.R b/R/aaa-import-standalone-rstudio-detect.R
index 262f7580..623105ba 100644
--- a/R/aaa-import-standalone-rstudio-detect.R
+++ b/R/aaa-import-standalone-rstudio-detect.R
@@ -10,7 +10,6 @@
# ---
rstudio <- local({
-
standalone_env <- environment()
parent.env(standalone_env) <- baseenv()
@@ -28,7 +27,8 @@ rstudio <- local({
"RSTUDIO_CONSOLE_COLOR",
"RSTUDIOAPI_IPC_REQUESTS_FILE",
"XPC_SERVICE_NAME",
- "ASCIICAST")
+ "ASCIICAST"
+ )
d <- list(
pid = Sys.getpid(),
@@ -65,8 +65,10 @@ rstudio <- local({
if (clear_cache) data <<- NULL
if (!is.null(data)) return(get_caps(data))
- if ((rspid <- Sys.getenv("RSTUDIO_SESSION_PID")) != "" &&
- any(c("ps", "cli") %in% loadedNamespaces())) {
+ if (
+ (rspid <- Sys.getenv("RSTUDIO_SESSION_PID")) != "" &&
+ any(c("ps", "cli") %in% loadedNamespaces())
+ ) {
detect_new(rspid, clear_cache)
} else {
detect_old(clear_cache)
@@ -99,31 +101,26 @@ rstudio <- local({
# direct subprocess
new$type <- if (rspid == parentpid) {
-
if (pane == "job") {
"rstudio_job"
-
} else if (pane == "build") {
"rstudio_build_pane"
-
} else if (pane == "render") {
"rstudio_render_pane"
-
- } else if (pane == "terminal" && new$tty &&
- new$envs["ASCIICAST"] != "true") {
+ } else if (
+ pane == "terminal" && new$tty && new$envs["ASCIICAST"] != "true"
+ ) {
# not possible, because there is a shell in between, just in case
"rstudio_terminal"
-
} else {
# don't know what kind of direct subprocess
"rstudio_subprocess"
}
-
- } else if (pane == "terminal" && new$tty &&
- new$envs[["ASCIICAST"]] != "true") {
+ } else if (
+ pane == "terminal" && new$tty && new$envs[["ASCIICAST"]] != "true"
+ ) {
# not a direct subproces, so check other criteria as well
"rstudio_terminal"
-
} else {
# don't know what kind of subprocess
"rstudio_subprocess"
@@ -133,7 +130,6 @@ rstudio <- local({
}
detect_old <- function(clear_cache = FALSE) {
-
# Cache unless told otherwise
cache <- TRUE
new <- get_data()
@@ -141,20 +137,16 @@ rstudio <- local({
new$type <- if (new$envs[["RSTUDIO"]] != "1") {
# 1. Not RStudio at all
"not_rstudio"
-
} else if (new$gui == "RStudio" && new$api) {
# 2. RStudio console, properly initialized
"rstudio_console"
-
- } else if (! new$api && basename(new$args[1]) == "RStudio") {
+ } else if (!new$api && basename(new$args[1]) == "RStudio") {
# 3. RStudio console, initializing
cache <- FALSE
"rstudio_console_starting"
-
} else if (new$gui == "Rgui") {
# Still not RStudio, but Rgui that was started from RStudio
"not_rstudio"
-
} else if (new$tty && new$envs[["ASCIICAST"]] != "true") {
# 4. R in the RStudio terminal
# This could also be a subprocess of the console or build pane
@@ -162,29 +154,31 @@ rstudio <- local({
# out, without inspecting some process data with ps::ps_*().
# At least we rule out asciicast
"rstudio_terminal"
-
- } else if (! new$tty &&
- new$envs[["RSTUDIO_TERM"]] == "" &&
- new$envs[["R_BROWSER"]] == "false" &&
- new$envs[["R_PDFVIEWER"]] == "false" &&
- is_build_pane_command(new$args)) {
+ } else if (
+ !new$tty &&
+ new$envs[["RSTUDIO_TERM"]] == "" &&
+ new$envs[["R_BROWSER"]] == "false" &&
+ new$envs[["R_PDFVIEWER"]] == "false" &&
+ is_build_pane_command(new$args)
+ ) {
# 5. R in the RStudio build pane
# https://github.com/rstudio/rstudio/blob/master/src/cpp/session/
# modules/build/SessionBuild.cpp#L231-L240
"rstudio_build_pane"
-
- } else if (new$envs[["RSTUDIOAPI_IPC_REQUESTS_FILE"]] != "" &&
- grepl("rstudio", new$envs[["XPC_SERVICE_NAME"]])) {
+ } else if (
+ new$envs[["RSTUDIOAPI_IPC_REQUESTS_FILE"]] != "" &&
+ grepl("rstudio", new$envs[["XPC_SERVICE_NAME"]])
+ ) {
# RStudio job, XPC_SERVICE_NAME=0 in the subprocess of a job
# process. Hopefully this is reliable.
"rstudio_job"
-
- } else if (new$envs[["RSTUDIOAPI_IPC_REQUESTS_FILE"]] != "" &&
- any(grepl("SourceWithProgress.R", new$args))) {
+ } else if (
+ new$envs[["RSTUDIOAPI_IPC_REQUESTS_FILE"]] != "" &&
+ any(grepl("SourceWithProgress.R", new$args))
+ ) {
# Or we can check SourceWithProgress.R in the command line, see
# https://github.com/r-lib/cli/issues/367
"rstudio_job"
-
} else {
# Otherwise it is a subprocess of the console, terminal or
# build pane, and it is hard to say which, so we do not try.
diff --git a/R/aaassertthat.R b/R/aaassertthat.R
index 70f49404..88644097 100644
--- a/R/aaassertthat.R
+++ b/R/aaassertthat.R
@@ -1,4 +1,3 @@
-
assert_that <- function(..., env = parent.frame(), msg = NULL) {
res <- see_if(..., env = env, msg = msg)
if (res) return(TRUE)
@@ -6,7 +5,7 @@ assert_that <- function(..., env = parent.frame(), msg = NULL) {
throw(new_assert_error(attr(res, "msg")))
}
-new_assert_error <- function (message, call = NULL) {
+new_assert_error <- function(message, call = NULL) {
cond <- new_error(message, call. = call)
class(cond) <- c("assert_error", class(cond))
cond
@@ -16,17 +15,19 @@ see_if <- function(..., env = parent.frame(), msg = NULL) {
asserts <- eval(substitute(alist(...)))
for (assertion in asserts) {
- res <- tryCatch({
- eval(assertion, env)
- }, new_assert_error = function(e) {
- structure(FALSE, msg = e$message)
- })
+ res <- tryCatch(
+ {
+ eval(assertion, env)
+ },
+ new_assert_error = function(e) {
+ structure(FALSE, msg = e$message)
+ }
+ )
check_result(res)
# Failed, so figure out message to produce
if (!res) {
- if (is.null(msg))
- msg <- get_message(res, assertion, env)
+ if (is.null(msg)) msg <- get_message(res, assertion, env)
return(structure(FALSE, msg = msg))
}
}
@@ -36,7 +37,9 @@ see_if <- function(..., env = parent.frame(), msg = NULL) {
check_result <- function(x) {
if (!is.logical(x))
- throw(new_assert_error("assert_that: assertion must return a logical value"))
+ throw(new_assert_error(
+ "assert_that: assertion must return a logical value"
+ ))
if (any(is.na(x)))
throw(new_assert_error("assert_that: missing values present in assertion"))
if (length(x) != 1) {
@@ -68,7 +71,7 @@ get_message <- function(res, call, env = parent.frame()) {
fail_default <- function(call, env) {
call_string <- deparse(call, width.cutoff = 60L)
if (length(call_string) > 1L) {
- call_string <- paste0(call_string[1L], "...")
+ call_string <- paste0(call_string[1L], "...")
}
paste0(call_string, " is not TRUE")
diff --git a/R/assertions.R b/R/assertions.R
index c1f3d078..9fef42ed 100644
--- a/R/assertions.R
+++ b/R/assertions.R
@@ -1,8 +1,7 @@
-
is_string <- function(x) {
is.character(x) &&
- length(x) == 1 &&
- !is.na(x)
+ length(x) == 1 &&
+ !is.na(x)
}
on_failure(is_string) <- function(call, env) {
@@ -19,14 +18,22 @@ on_failure(is_string_or_null) <- function(call, env) {
is_flag <- function(x) {
is.logical(x) &&
- length(x) == 1 &&
- !is.na(x)
+ length(x) == 1 &&
+ !is.na(x)
}
on_failure(is_flag) <- function(call, env) {
paste0(deparse(call$x), " is not a flag (length 1 logical)")
}
+is_numeric_scalar <- function(x) {
+ is.numeric(x) && length(x) == 1 && !is.na(x)
+}
+
+on_failure(is_numeric_scalar) <- function(call, env) {
+ paste0(deparse(call$x), " is not a length 1 number")
+}
+
is_integerish_scalar <- function(x) {
is.numeric(x) && length(x) == 1 && !is.na(x) && round(x) == x
}
diff --git a/R/base64.R b/R/base64.R
index a55b7b4c..f1f71081 100644
--- a/R/base64.R
+++ b/R/base64.R
@@ -1,4 +1,3 @@
-
#' Base64 Encoding and Decoding
#'
#' @param x Raw vector to encode / decode.
diff --git a/R/cleancall.R b/R/cleancall.R
index 8023d6dc..11e4d246 100644
--- a/R/cleancall.R
+++ b/R/cleancall.R
@@ -1,4 +1,3 @@
-
call_with_cleanup <- function(ptr, ...) {
.Call(c_cleancall_call, pairlist(ptr, ...), parent.frame())
}
diff --git a/R/client-lib.R b/R/client-lib.R
index ab77dfa6..cdc8c51c 100644
--- a/R/client-lib.R
+++ b/R/client-lib.R
@@ -1,4 +1,3 @@
-
client <- new.env(parent = emptyenv())
local({
@@ -27,7 +26,6 @@ local({
# devtools
single <- system.file("src", paste0("client", ext), package = "processx")
client[[paste0("arch-", arch)]] <- read_all(single)
-
} else {
# not devtools
single <- file.path(libs, paste0("client", ext))
@@ -35,7 +33,6 @@ local({
# not multiarch
bts <- file.size(single)
client[[paste0("arch-", arch)]] <- read_all(single)
-
} else {
# multiarch
multi <- dir(libs)
@@ -62,7 +59,7 @@ load_client_lib <- function(client) {
sym_encode <- getNativeSymbolInfo("processx_base64_encode", lib)
sym_decode <- getNativeSymbolInfo("processx_base64_decode", lib)
sym_disinh <- getNativeSymbolInfo("processx_disable_inheritance", lib)
- sym_write <- getNativeSymbolInfo("processx_write", lib)
+ sym_write <- getNativeSymbolInfo("processx_write", lib)
sym_setout <- getNativeSymbolInfo("processx_set_stdout", lib)
sym_seterr <- getNativeSymbolInfo("processx_set_stderr", lib)
sym_setoutf <- getNativeSymbolInfo("processx_set_stdout_to_file", lib)
@@ -122,7 +119,8 @@ load_client_lib <- function(client) {
reg.finalizer(
env,
function(e) if (".finalize" %in% names(e)) e$.finalize(),
- onexit = TRUE)
+ onexit = TRUE
+ )
## Clear the cleanup method
on.exit(NULL)
diff --git a/R/connections.R b/R/connections.R
index fddd84a6..f2cb4f99 100644
--- a/R/connections.R
+++ b/R/connections.R
@@ -1,4 +1,3 @@
-
#' Processx connections
#'
#' These functions are currently experimental and will change
@@ -22,7 +21,8 @@ conn_create_fd <- function(fd, encoding = "", close = TRUE) {
assert_that(
is_integerish_scalar(fd),
is_string(encoding),
- is_flag(close))
+ is_flag(close)
+ )
fd <- as.integer(fd)
chain_call(c_processx_connection_create_fd, fd, encoding, close)
}
@@ -92,9 +92,17 @@ conn_create_fd <- function(fd, encoding = "", close = TRUE) {
#' @rdname processx_fifos
#' @export
-conn_create_fifo <- function(filename = NULL, read = NULL, write = NULL,
- encoding = "", nonblocking = TRUE) {
- if (is.null(read) && is.null(write)) { read <- TRUE; write <- FALSE }
+conn_create_fifo <- function(
+ filename = NULL,
+ read = NULL,
+ write = NULL,
+ encoding = "",
+ nonblocking = TRUE
+) {
+ if (is.null(read) && is.null(write)) {
+ read <- TRUE
+ write <- FALSE
+ }
if (is.null(read)) read <- !write
if (is.null(write)) write <- !read
@@ -107,7 +115,7 @@ conn_create_fifo <- function(filename = NULL, read = NULL, write = NULL,
is_flag(read),
is_flag(write),
read || write,
- ! (read && write),
+ !(read && write),
is_string(encoding),
is_flag(nonblocking)
)
@@ -178,9 +186,17 @@ make_pipe_file_name <- function(filename) {
#'
#' close(reader)
-conn_connect_fifo <- function(filename, read = NULL, write = NULL,
- encoding = "", nonblocking = TRUE) {
- if (is.null(read) && is.null(write)) { read <- TRUE; write <- FALSE }
+conn_connect_fifo <- function(
+ filename,
+ read = NULL,
+ write = NULL,
+ encoding = "",
+ nonblocking = TRUE
+) {
+ if (is.null(read) && is.null(write)) {
+ read <- TRUE
+ write <- FALSE
+ }
if (is.null(read)) read <- !write
if (is.null(write)) write <- !read
@@ -193,7 +209,7 @@ conn_connect_fifo <- function(filename, read = NULL, write = NULL,
is_flag(read),
is_flag(write),
read || write,
- ! (read && write),
+ !(read && write),
is_string(encoding),
is_flag(nonblocking)
)
@@ -240,12 +256,13 @@ conn_file_name <- function(con) {
#' @rdname processx_connections
#' @export
-conn_create_pipepair <- function(encoding = "",
- nonblocking = c(TRUE, FALSE)) {
+conn_create_pipepair <- function(encoding = "", nonblocking = c(TRUE, FALSE)) {
assert_that(
is_string(encoding),
- is.logical(nonblocking), length(nonblocking) == 2,
- !any(is.na(nonblocking)))
+ is.logical(nonblocking),
+ length(nonblocking) == 2,
+ !any(is.na(nonblocking))
+ )
chain_call(c_processx_connection_create_pipepair, encoding, nonblocking)
}
@@ -260,8 +277,7 @@ conn_create_pipepair <- function(encoding = "",
#' @rdname processx_connections
#' @export
-conn_read_chars <- function(con, n = -1)
- UseMethod("conn_read_chars", con)
+conn_read_chars <- function(con, n = -1) UseMethod("conn_read_chars", con)
#' @rdname processx_connections
#' @export
@@ -284,8 +300,7 @@ processx_conn_read_chars <- function(con, n = -1) {
#' @rdname processx_connections
#' @export
-conn_read_lines <- function(con, n = -1)
- UseMethod("conn_read_lines", con)
+conn_read_lines <- function(con, n = -1) UseMethod("conn_read_lines", con)
#' @rdname processx_connections
#' @export
@@ -309,8 +324,7 @@ processx_conn_read_lines <- function(con, n = -1) {
#' @rdname processx_connections
#' @export
-conn_is_incomplete <- function(con)
- UseMethod("conn_is_incomplete", con)
+conn_is_incomplete <- function(con) UseMethod("conn_is_incomplete", con)
#' @rdname processx_connections
#' @export
@@ -324,7 +338,7 @@ conn_is_incomplete.processx_connection <- function(con) {
processx_conn_is_incomplete <- function(con) {
assert_that(is_connection(con))
- ! chain_call(c_processx_connection_is_eof, con)
+ !chain_call(c_processx_connection_is_eof, con)
}
#' @details
@@ -346,8 +360,12 @@ conn_write <- function(con, str, sep = "\n", encoding = "")
#' @rdname processx_connections
#' @export
-conn_write.processx_connection <- function(con, str, sep = "\n",
- encoding = "") {
+conn_write.processx_connection <- function(
+ con,
+ str,
+ sep = "\n",
+ encoding = ""
+) {
processx_conn_write(con, str, sep, encoding)
}
@@ -357,9 +375,10 @@ conn_write.processx_connection <- function(con, str, sep = "\n",
processx_conn_write <- function(con, str, sep = "\n", encoding = "") {
assert_that(
is_connection(con),
- (is.character(str) && all(! is.na(str))) || is.raw(str),
+ (is.character(str) && all(!is.na(str))) || is.raw(str),
is_string(sep),
- is_string(encoding))
+ is_string(encoding)
+ )
if (is.character(str)) {
pstr <- paste(str, collapse = sep)
@@ -382,7 +401,10 @@ processx_conn_write <- function(con, str, sep = "\n", encoding = "") {
#' @export
conn_create_file <- function(filename, read = NULL, write = NULL) {
- if (is.null(read) && is.null(write)) { read <- TRUE; write <- FALSE }
+ if (is.null(read) && is.null(write)) {
+ read <- TRUE
+ write <- FALSE
+ }
if (is.null(read)) read <- !write
if (is.null(write)) write <- !read
@@ -390,7 +412,8 @@ conn_create_file <- function(filename, read = NULL, write = NULL) {
is_string(filename),
is_flag(read),
is_flag(write),
- read || write)
+ read || write
+ )
chain_call(c_processx_connection_create_file, filename, read, write)
}
@@ -408,7 +431,8 @@ conn_create_file <- function(filename, read = NULL, write = NULL) {
conn_set_stdout <- function(con, drop = TRUE) {
assert_that(
is_connection(con),
- is_flag(drop))
+ is_flag(drop)
+ )
flush(stdout())
invisible(chain_call(c_processx_connection_set_stdout, con, drop))
@@ -424,7 +448,8 @@ conn_set_stdout <- function(con, drop = TRUE) {
conn_set_stderr <- function(con, drop = TRUE) {
assert_that(
is_connection(con),
- is_flag(drop))
+ is_flag(drop)
+ )
flush(stderr())
invisible(chain_call(c_processx_connection_set_stderr, con, drop))
@@ -542,7 +567,6 @@ is_valid_fd <- function(fd) {
#' @export
conn_create_unix_socket <- function(filename = NULL, encoding = "") {
-
assert_that(
is_string_or_null(filename),
is_string(encoding)
@@ -561,7 +585,6 @@ conn_create_unix_socket <- function(filename = NULL, encoding = "") {
#' @export
conn_connect_unix_socket <- function(filename, encoding = "") {
-
assert_that(
is_string_or_null(filename),
is_string(encoding)
diff --git a/R/initialize.R b/R/initialize.R
index 3d7b6d4a..5ff8b717 100644
--- a/R/initialize.R
+++ b/R/initialize.R
@@ -1,4 +1,3 @@
-
#' Start a process
#'
#' @param self this
@@ -22,14 +21,31 @@
#'
#' @keywords internal
-process_initialize <- function(self, private, command, args,
- stdin, stdout, stderr, pty, pty_options,
- connections, poll_connection, env, cleanup,
- cleanup_tree, wd, echo_cmd, supervise,
- windows_verbatim_args, windows_hide_window,
- windows_detached_process, encoding,
- post_process) {
-
+process_initialize <- function(
+ self,
+ private,
+ command,
+ args,
+ stdin,
+ stdout,
+ stderr,
+ pty,
+ pty_options,
+ connections,
+ poll_connection,
+ env,
+ cleanup,
+ cleanup_tree,
+ cleanup_grace,
+ wd,
+ echo_cmd,
+ supervise,
+ windows_verbatim_args,
+ windows_hide_window,
+ windows_detached_process,
+ encoding,
+ post_process
+) {
"!DEBUG process_initialize `command`"
assert_that(
@@ -39,23 +55,28 @@ process_initialize <- function(self, private, command, args,
is_std_conn(stdout),
is_std_conn(stderr),
is_flag(pty),
- is.list(pty_options), is_named(pty_options),
+ is.list(pty_options),
+ is_named(pty_options),
is_connection_list(connections),
is.null(poll_connection) || is_flag(poll_connection),
is.null(env) || is_env_vector(env),
is_flag(cleanup),
is_flag(cleanup_tree),
+ is_numeric_scalar(cleanup_grace),
is_string_or_null(wd),
is_flag(echo_cmd),
is_flag(windows_verbatim_args),
is_flag(windows_hide_window),
is_flag(windows_detached_process),
is_string(encoding),
- is.function(post_process) || is.null(post_process))
+ is.function(post_process) || is.null(post_process)
+ )
if (cleanup_tree && !cleanup) {
- warning("`cleanup_tree` overrides `cleanup`, and process will be ",
- "killed on GC")
+ warning(
+ "`cleanup_tree` overrides `cleanup`, and process will be ",
+ "killed on GC"
+ )
cleanup <- TRUE
}
@@ -78,8 +99,10 @@ process_initialize <- function(self, private, command, args,
def <- default_pty_options()
pty_options <- utils::modifyList(def, pty_options)
if (length(bad <- setdiff(names(def), names(pty_options)))) {
- throw(new_error("Uknown pty option(s): ",
- paste(paste0("`", bad, "`"), collapse = ", ")))
+ throw(new_error(
+ "Uknown pty option(s): ",
+ paste(paste0("`", bad, "`"), collapse = ", ")
+ ))
}
pty_options$rows <- as.integer(pty_options$rows)
pty_options$cols <- as.integer(pty_options$cols)
@@ -99,6 +122,7 @@ process_initialize <- function(self, private, command, args,
private$args <- args
private$cleanup <- cleanup
private$cleanup_tree <- cleanup_tree
+ private$cleanup_grace <- cleanup_grace
private$wd <- wd
private$pstdin <- stdin
private$pstdout <- stdout
@@ -114,8 +138,7 @@ process_initialize <- function(self, private, command, args,
private$post_process <- post_process
poll_connection <- poll_connection %||%
- (!identical(stdout, "|") && !identical(stderr, "|") &&
- !length(connections))
+ (!identical(stdout, "|") && !identical(stderr, "|") && !length(connections))
if (poll_connection) {
pipe <- conn_create_pipepair()
connections <- c(connections, list(pipe[[2]]))
@@ -137,9 +160,20 @@ process_initialize <- function(self, private, command, args,
"!DEBUG process_initialize exec()"
private$status <- chain_call(
c_processx_exec,
- command, c(command, args), pty, pty_options,
- connections, env, windows_verbatim_args, windows_hide_window,
- windows_detached_process, private, cleanup, wd, encoding,
+ command,
+ c(command, args),
+ pty,
+ pty_options,
+ connections,
+ env,
+ windows_verbatim_args,
+ windows_hide_window,
+ windows_detached_process,
+ private,
+ cleanup,
+ cleanup_grace,
+ wd,
+ encoding,
paste0("PROCESSX_", private$tree_id, "=YES")
)
@@ -166,7 +200,7 @@ process_initialize <- function(self, private, command, args,
stderr <- full_path(stderr)
## Store the output and error files, we'll open them later if needed
- private$stdin <- stdin
+ private$stdin <- stdin
private$stdout <- stdout
private$stderr <- stderr
diff --git a/R/io.R b/R/io.R
index d805d161..13569621 100644
--- a/R/io.R
+++ b/R/io.R
@@ -1,4 +1,3 @@
-
process_has_input_connection <- function(self, private) {
"!DEBUG process_has_input_connection `private$get_short_name()`"
!is.null(private$stdin_pipe)
@@ -21,22 +20,19 @@ process_has_poll_connection <- function(self, private) {
process_get_input_connection <- function(self, private) {
"!DEBUG process_get_input_connection `private$get_short_name()`"
- if (!self$has_input_connection())
- throw(new_error("stdin is not a pipe."))
+ if (!self$has_input_connection()) throw(new_error("stdin is not a pipe."))
private$stdin_pipe
}
process_get_output_connection <- function(self, private) {
"!DEBUG process_get_output_connection `private$get_short_name()`"
- if (!self$has_output_connection())
- throw(new_error("stdout is not a pipe."))
+ if (!self$has_output_connection()) throw(new_error("stdout is not a pipe."))
private$stdout_pipe
}
process_get_error_connection <- function(self, private) {
"!DEBUG process_get_error_connection `private$get_short_name()`"
- if (!self$has_error_connection())
- throw(new_error("stderr is not a pipe."))
+ if (!self$has_error_connection()) throw(new_error("stderr is not a pipe."))
private$stderr_pipe
}
@@ -57,7 +53,6 @@ process_read_error <- function(self, private, n) {
"!DEBUG process_read_error `private$get_short_name()`"
con <- process_get_error_connection(self, private)
chain_call(c_processx_connection_read_chars, con, n)
-
}
process_read_output_lines <- function(self, private, n) {
@@ -77,12 +72,12 @@ process_read_error_lines <- function(self, private, n) {
process_is_incompelete_output <- function(self, private) {
con <- process_get_output_connection(self, private)
- ! chain_call(c_processx_connection_is_eof, con)
+ !chain_call(c_processx_connection_is_eof, con)
}
process_is_incompelete_error <- function(self, private) {
con <- process_get_error_connection(self, private)
- ! chain_call(c_processx_connection_is_eof, con)
+ !chain_call(c_processx_connection_is_eof, con)
}
process_read_all_output <- function(self, private) {
@@ -145,13 +140,13 @@ process_get_error_file <- function(self, private) {
# Corresponds to processx.h, update there as well
poll_codes <- c(
- "nopipe", # PXNOPIPE
- "ready", # PXREADY
- "timeout", # PXTIMEOUT
- "closed", # PXCLOSED
- "silent", # PXSILENT
- "event", # PXEVENT
- "connect" # PXCONNECT
+ "nopipe", # PXNOPIPE
+ "ready", # PXREADY
+ "timeout", # PXTIMEOUT
+ "closed", # PXCLOSED
+ "silent", # PXSILENT
+ "event", # PXEVENT
+ "connect" # PXCONNECT
)
process_poll_io <- function(self, private, ms) {
diff --git a/R/named_pipe.R b/R/named_pipe.R
index 4a23915f..e55789de 100644
--- a/R/named_pipe.R
+++ b/R/named_pipe.R
@@ -7,7 +7,6 @@ named_pipe_tempfile <- function(prefix = "pipe") {
# several seconds the first time it's called in an R session. So we'll do it
# manually with paste0.
paste0("\\\\.\\pipe", tempfile(prefix, ""))
-
} else {
tempfile(prefix)
}
@@ -33,7 +32,9 @@ is_pipe_open.unix_named_pipe <- function(pipe) {
is_open <- NA
tryCatch(
is_open <- isOpen(pipe$handle),
- error = function(e) { is_open <<- FALSE }
+ error = function(e) {
+ is_open <<- FALSE
+ }
)
is_open
@@ -48,7 +49,6 @@ create_named_pipe <- function(name) {
),
class = c("windows_named_pipe", "named_pipe")
)
-
} else {
structure(
list(
@@ -84,8 +84,7 @@ write_lines_named_pipe.windows_named_pipe <- function(pipe, text) {
# Make sure it ends with \n
len <- nchar(text)
- if (substr(text, len, len) != "\n")
- text <- paste0(text, "\n")
+ if (substr(text, len, len) != "\n") text <- paste0(text, "\n")
chain_call(c_processx_write_named_pipe, pipe$handle, text)
}
diff --git a/R/on-load.R b/R/on-load.R
index 6ade28dd..2799cd4e 100644
--- a/R/on-load.R
+++ b/R/on-load.R
@@ -1,4 +1,3 @@
-
## nocov start
.onLoad <- function(libname, pkgname) {
@@ -13,8 +12,10 @@
}
supervisor_reset()
- if (Sys.getenv("DEBUGME", "") != "" &&
- requireNamespace("debugme", quietly = TRUE)) {
+ if (
+ Sys.getenv("DEBUGME", "") != "" &&
+ requireNamespace("debugme", quietly = TRUE)
+ ) {
debugme::debugme()
}
diff --git a/R/poll.R b/R/poll.R
index 92bbf9b5..67f3ca02 100644
--- a/R/poll.R
+++ b/R/poll.R
@@ -1,4 +1,3 @@
-
#' Poll for process I/O or termination
#'
#' Wait until one of the specified connections or processes produce
@@ -102,5 +101,6 @@ poll <- function(processes, ms) {
curl_fds <- function(fds) {
structure(
list(fds$reads, fds$writes, fds$exceptions),
- class = "processx_curl_fds")
+ class = "processx_curl_fds"
+ )
}
diff --git a/R/print.R b/R/print.R
index 1937e82a..42039ac8 100644
--- a/R/print.R
+++ b/R/print.R
@@ -1,6 +1,4 @@
-
process_format <- function(self, private) {
-
state <- if (self$is_alive()) {
pid <- self$get_pid()
paste0("running, pid ", paste(pid, collapse = ", "), ".")
@@ -10,7 +8,9 @@ process_format <- function(self, private) {
paste0(
"PROCESS ",
- "'", private$get_short_name(), "', ",
+ "'",
+ private$get_short_name(),
+ "', ",
state,
"\n"
)
diff --git a/R/process-helpers.R b/R/process-helpers.R
index 70d1873c..d1e7e62a 100644
--- a/R/process-helpers.R
+++ b/R/process-helpers.R
@@ -1,4 +1,3 @@
-
process__exists <- function(pid) {
chain_call(c_processx__process_exists, pid)
}
diff --git a/R/process.R b/R/process.R
index f0b2b421..240a2bb7 100644
--- a/R/process.R
+++ b/R/process.R
@@ -1,4 +1,3 @@
-
#' @useDynLib processx, .registration = TRUE, .fixes = "c_"
NULL
@@ -95,9 +94,7 @@ dummy_r6 <- function() R6::R6Class
process <- R6::R6Class(
"process",
- cloneable = FALSE,
public = list(
-
#' @description
#' Start a new process in the background, and then return immediately.
#'
@@ -184,6 +181,10 @@ process <- R6::R6Class(
#' object is garbage collected.
#' @param cleanup_tree Whether to kill the process and its child
#' process tree when the `process` object is garbage collected.
+ #' @param cleanup_grace Grace period between `SIGTERM` and `SIGKILL`.
+ #' Only has an effect on Unix platforms. Set to 0 to terminate abruptly
+ #' with `SIGKILL` only. Currently defaults to 0 until we implement
+ #' a better approach on session quit.
#' @param wd Working directory of the process. It must exist.
#' If `NULL`, then the current working directory is used.
#' @param echo_cmd Whether to print the command to the screen before
@@ -209,30 +210,54 @@ process <- R6::R6Class(
#' finished. Currently it only runs if `$get_result()` is called.
#' It is only run once.
- initialize = function(command = NULL, args = character(),
- stdin = NULL, stdout = NULL, stderr = NULL, pty = FALSE,
- pty_options = list(), connections = list(), poll_connection = NULL,
- env = NULL, cleanup = TRUE, cleanup_tree = FALSE, wd = NULL,
- echo_cmd = FALSE, supervise = FALSE, windows_verbatim_args = FALSE,
- windows_hide_window = FALSE, windows_detached_process = !cleanup,
- encoding = "", post_process = NULL)
-
- process_initialize(self, private, command, args, stdin,
- stdout, stderr, pty, pty_options, connections,
- poll_connection, env, cleanup, cleanup_tree, wd,
- echo_cmd, supervise, windows_verbatim_args,
- windows_hide_window, windows_detached_process,
- encoding, post_process),
-
- #' @description
- #' Cleanup method that is called when the `process` object is garbage
- #' collected. If requested so in the process constructor, then it
- #' eliminates all processes in the process's subprocess tree.
-
- finalize = function() {
- if (!is.null(private$tree_id) && private$cleanup_tree &&
- ps::ps_is_supported()) self$kill_tree()
- },
+ initialize = function(
+ command = NULL,
+ args = character(),
+ stdin = NULL,
+ stdout = NULL,
+ stderr = NULL,
+ pty = FALSE,
+ pty_options = list(),
+ connections = list(),
+ poll_connection = NULL,
+ env = NULL,
+ cleanup = TRUE,
+ cleanup_tree = FALSE,
+ cleanup_grace = 0.0,
+ wd = NULL,
+ echo_cmd = FALSE,
+ supervise = FALSE,
+ windows_verbatim_args = FALSE,
+ windows_hide_window = FALSE,
+ windows_detached_process = !cleanup,
+ encoding = "",
+ post_process = NULL
+ )
+ process_initialize(
+ self,
+ private,
+ command,
+ args,
+ stdin,
+ stdout,
+ stderr,
+ pty,
+ pty_options,
+ connections,
+ poll_connection,
+ env,
+ cleanup,
+ cleanup_tree,
+ cleanup_grace,
+ wd,
+ echo_cmd,
+ supervise,
+ windows_verbatim_args,
+ windows_hide_window,
+ windows_detached_process,
+ encoding,
+ post_process
+ ),
#' @description
#' Terminate the process. It also terminate all of its child
@@ -270,8 +295,7 @@ process <- R6::R6Class(
#' @param signal An integer scalar, the id of the signal to send to
#' the process. See [tools::pskill()] for the list of signals.
- signal = function(signal)
- process_signal(self, private, signal),
+ signal = function(signal) process_signal(self, private, signal),
#' @description
#' Send an interrupt to the process. On Unix this is a
@@ -279,21 +303,18 @@ process <- R6::R6Class(
#' the terminal prompt. On Windows, it is a CTRL+BREAK keypress.
#' Applications may catch these events. By default they will quit.
- interrupt = function()
- process_interrupt(self, private),
+ interrupt = function() process_interrupt(self, private),
#' @description
#' Query the process id.
#' @return Integer scalar, the process id of the process.
- get_pid = function()
- process_get_pid(self, private),
+ get_pid = function() process_get_pid(self, private),
#' @description Check if the process is alive.
#' @return Logical scalar.
- is_alive = function()
- process_is_alive(self, private),
+ is_alive = function() process_is_alive(self, private),
#' @description
#' Wait until the process finishes, or a timeout happens.
@@ -306,8 +327,7 @@ process <- R6::R6Class(
#' through `parallel::mcparallel()`.
#' @return It returns the process itself, invisibly.
- wait = function(timeout = -1)
- process_wait(self, private, timeout),
+ wait = function(timeout = -1) process_wait(self, private, timeout),
#' @description
#' `$get_exit_status` returns the exit code of the process if it has
@@ -318,36 +338,31 @@ process <- R6::R6Class(
#' status of the process. One such package is parallel, if used with
#' fork clusters, e.g. through the `parallel::mcparallel()` function.
- get_exit_status = function()
- process_get_exit_status(self, private),
+ get_exit_status = function() process_get_exit_status(self, private),
#' @description
#' `format(p)` or `p$format()` creates a string representation of the
#' process, usually for printing.
- format = function()
- process_format(self, private),
+ format = function() process_format(self, private),
#' @description
#' `print(p)` or `p$print()` shows some information about the
#' process on the screen, whether it is running and it's process id, etc.
- print = function()
- process_print(self, private),
+ print = function() process_print(self, private),
#' @description
#' `$get_start_time()` returns the time when the process was
#' started.
- get_start_time = function()
- process_get_start_time(self, private),
+ get_start_time = function() process_get_start_time(self, private),
#' @description
#' `$is_supervised()` returns whether the process is being tracked by
#' supervisor process.
- is_supervised = function()
- process_is_supervised(self, private),
+ is_supervised = function() process_is_supervised(self, private),
#' @description
#' `$supervise()` if passed `TRUE`, tells the supervisor to start
@@ -358,8 +373,7 @@ process <- R6::R6Class(
#' @param status Whether to turn on of off the supervisor for this
#' process.
- supervise = function(status)
- process_supervise(self, private, status),
+ supervise = function(status) process_supervise(self, private, status),
## Output
@@ -370,15 +384,13 @@ process <- R6::R6Class(
#' will work only if `stdout="|"` was used. Otherwise, it will throw an
#' error.
- read_output = function(n = -1)
- process_read_output(self, private, n),
+ read_output = function(n = -1) process_read_output(self, private, n),
#' @description
#' `$read_error()` is similar to `$read_output`, but it reads
#' from the standard error stream.
- read_error = function(n = -1)
- process_read_error(self, private, n),
+ read_error = function(n = -1) process_read_error(self, private, n),
#' @description
#' `$read_output_lines()` reads lines from standard output connection
@@ -441,14 +453,13 @@ process <- R6::R6Class(
#' `$has_poll_connection()` return `TRUE` if there is a poll connection,
#' `FALSE` otherwise.
- has_poll_connection = function()
- process_has_poll_connection(self, private),
+ has_poll_connection = function() process_has_poll_connection(self, private),
#' @description
#' `$get_input_connection()` returns a connection object, to the
#' standard input stream of the process.
- get_input_connection = function()
+ get_input_connection = function()
process_get_input_connection(self, private),
#' @description
@@ -473,8 +484,7 @@ process <- R6::R6Class(
#' It returns a character scalar. This will return content only if
#' `stdout="|"` was used. Otherwise, it will throw an error.
- read_all_output = function()
- process_read_all_output(self, private),
+ read_all_output = function() process_read_all_output(self, private),
#' @description
#' `$read_all_error()` waits for all standard error from the process.
@@ -484,8 +494,7 @@ process <- R6::R6Class(
#' It returns a character scalar. This will return content only if
#' `stderr="|"` was used. Otherwise, it will throw an error.
- read_all_error = function()
- process_read_all_error(self, private),
+ read_all_error = function() process_read_all_error(self, private),
#' @description
#' `$read_all_output_lines()` waits for all standard output lines
@@ -534,140 +543,123 @@ process <- R6::R6Class(
#' this returns the absolute path to the file. If `stdin` was `"|"` or
#' `NULL`, this simply returns that value.
- get_input_file = function()
- process_get_input_file(self, private),
+ get_input_file = function() process_get_input_file(self, private),
#' @description
#' `$get_output_file()` if the `stdout` argument was a filename,
#' this returns the absolute path to the file. If `stdout` was `"|"` or
#' `NULL`, this simply returns that value.
- get_output_file = function()
- process_get_output_file(self, private),
+ get_output_file = function() process_get_output_file(self, private),
#' @description
#' `$get_error_file()` if the `stderr` argument was a filename,
#' this returns the absolute path to the file. If `stderr` was `"|"` or
#' `NULL`, this simply returns that value.
- get_error_file = function()
- process_get_error_file(self, private),
+ get_error_file = function() process_get_error_file(self, private),
#' @description
#' `$poll_io()` polls the process's connections for I/O. See more in
#' the _Polling_ section, and see also the [poll()] function
#' to poll on multiple processes.
- poll_io = function(timeout)
- process_poll_io(self, private, timeout),
+ poll_io = function(timeout) process_poll_io(self, private, timeout),
#' @description
#' `$get_poll_connetion()` returns the poll connection, if the process has
#' one.
- get_poll_connection = function()
- process_get_poll_connection(self, private),
+ get_poll_connection = function() process_get_poll_connection(self, private),
#' @description
#' `$get_result()` returns the result of the post processesing function.
#' It can only be called once the process has finished. If the process has
#' no post-processing function, then `NULL` is returned.
- get_result = function()
- process_get_result(self, private),
+ get_result = function() process_get_result(self, private),
#' @description
#' `$as_ps_handle()` returns a [ps::ps_handle] object, corresponding to
#' the process.
- as_ps_handle = function()
- process_as_ps_handle(self, private),
+ as_ps_handle = function() process_as_ps_handle(self, private),
#' @description
#' Calls [ps::ps_name()] to get the process name.
- get_name = function()
- ps_method(ps::ps_name, self),
+ get_name = function() ps_method(ps::ps_name, self),
#' @description
#' Calls [ps::ps_exe()] to get the path of the executable.
- get_exe = function()
- ps_method(ps::ps_exe, self),
+ get_exe = function() ps_method(ps::ps_exe, self),
#' @description
#' Calls [ps::ps_cmdline()] to get the command line.
- get_cmdline = function()
- ps_method(ps::ps_cmdline, self),
+ get_cmdline = function() ps_method(ps::ps_cmdline, self),
#' @description
#' Calls [ps::ps_status()] to get the process status.
- get_status = function()
- ps_method(ps::ps_status, self),
+ get_status = function() ps_method(ps::ps_status, self),
#' @description
#' calls [ps::ps_username()] to get the username.
- get_username = function()
- ps_method(ps::ps_username, self),
+ get_username = function() ps_method(ps::ps_username, self),
#' @description
#' Calls [ps::ps_cwd()] to get the current working directory.
- get_wd = function()
- ps_method(ps::ps_cwd, self),
+ get_wd = function() ps_method(ps::ps_cwd, self),
#' @description
#' Calls [ps::ps_cpu_times()] to get CPU usage data.
- get_cpu_times = function()
- ps_method(ps::ps_cpu_times, self),
+ get_cpu_times = function() ps_method(ps::ps_cpu_times, self),
#' @description
#' Calls [ps::ps_memory_info()] to get memory data.
- get_memory_info = function()
- ps_method(ps::ps_memory_info, self),
+ get_memory_info = function() ps_method(ps::ps_memory_info, self),
#' @description
#' Calls [ps::ps_suspend()] to suspend the process.
- suspend = function()
- ps_method(ps::ps_suspend, self),
+ suspend = function() ps_method(ps::ps_suspend, self),
#' @description
#' Calls [ps::ps_resume()] to resume a suspended process.
- resume = function()
- ps_method(ps::ps_resume, self)
+ resume = function() ps_method(ps::ps_resume, self)
),
private = list(
-
- command = NULL, # Save 'command' argument here
- args = NULL, # Save 'args' argument here
- cleanup = NULL, # cleanup argument
- cleanup_tree = NULL, # cleanup_tree argument
- stdin = NULL, # stdin argument or stream
- stdout = NULL, # stdout argument or stream
- stderr = NULL, # stderr argument or stream
- pty = NULL, # whether we should create a PTY
- pty_options = NULL, # various PTY options
- pstdin = NULL, # the original stdin argument
- pstdout = NULL, # the original stdout argument
- pstderr = NULL, # the original stderr argument
- cleanfiles = NULL, # which temp stdout/stderr file(s) to clean up
- wd = NULL, # working directory (or NULL for current)
- starttime = NULL, # timestamp of start
- echo_cmd = NULL, # whether to echo the command
+ command = NULL, # Save 'command' argument here
+ args = NULL, # Save 'args' argument here
+ cleanup = NULL, # cleanup argument
+ cleanup_tree = NULL, # cleanup_tree argument
+ cleanup_grace = NULL, # cleanup_grace argument
+ stdin = NULL, # stdin argument or stream
+ stdout = NULL, # stdout argument or stream
+ stderr = NULL, # stderr argument or stream
+ pty = NULL, # whether we should create a PTY
+ pty_options = NULL, # various PTY options
+ pstdin = NULL, # the original stdin argument
+ pstdout = NULL, # the original stdout argument
+ pstderr = NULL, # the original stderr argument
+ cleanfiles = NULL, # which temp stdout/stderr file(s) to clean up
+ wd = NULL, # working directory (or NULL for current)
+ starttime = NULL, # timestamp of start
+ echo_cmd = NULL, # whether to echo the command
windows_verbatim_args = NULL,
windows_hide_window = NULL,
- status = NULL, # C file handle
+ status = NULL, # C file handle
- supervised = FALSE, # Whether process is tracked by supervisor
+ supervised = FALSE, # Whether process is tracked by supervisor
stdin_pipe = NULL,
stdout_pipe = NULL,
@@ -686,10 +678,17 @@ process <- R6::R6Class(
tree_id = NULL,
- get_short_name = function()
- process_get_short_name(self, private),
- close_connections = function()
- process_close_connections(self, private)
+ finalize = function() {
+ if (
+ !is.null(private$tree_id) &&
+ private$cleanup_tree &&
+ ps::ps_is_supported()
+ )
+ self$kill_tree()
+ },
+
+ get_short_name = function() process_get_short_name(self, private),
+ close_connections = function() process_close_connections(self, private)
)
)
@@ -699,7 +698,8 @@ process <- R6::R6Class(
process_wait <- function(self, private, timeout) {
"!DEBUG process_wait `private$get_short_name()`"
chain_clean_call(
- c_processx_wait, private$status,
+ c_processx_wait,
+ private$status,
as.integer(timeout),
private$get_short_name()
)
@@ -713,14 +713,21 @@ process_is_alive <- function(self, private) {
process_get_exit_status <- function(self, private) {
"!DEBUG process_get_exit_status `private$get_short_name()`"
- chain_call(c_processx_get_exit_status, private$status,
- private$get_short_name())
+ chain_call(
+ c_processx_get_exit_status,
+ private$status,
+ private$get_short_name()
+ )
}
process_signal <- function(self, private, signal) {
"!DEBUG process_signal `private$get_short_name()` `signal`"
- chain_call(c_processx_signal, private$status, as.integer(signal),
- private$get_short_name())
+ chain_call(
+ c_processx_signal,
+ private$status,
+ as.integer(signal),
+ private$get_short_name()
+ )
}
process_interrupt <- function(self, private) {
@@ -730,15 +737,18 @@ process_interrupt <- function(self, private) {
st <- run(get_tool("interrupt"), c(pid, "c"), error_on_status = FALSE)
if (st$status == 0) TRUE else FALSE
} else {
- chain_call(c_processx_interrupt, private$status,
- private$get_short_name())
+ chain_call(c_processx_interrupt, private$status, private$get_short_name())
}
}
process_kill <- function(self, private, grace, close_connections) {
"!DEBUG process_kill '`private$get_short_name()`', pid `self$get_pid()`"
- ret <- chain_call(c_processx_kill, private$status, as.numeric(grace),
- private$get_short_name())
+ ret <- chain_clean_call(
+ c_processx_kill,
+ private$status,
+ as.numeric(grace),
+ private$get_short_name()
+ )
if (close_connections) private$close_connections()
ret
}
@@ -747,7 +757,8 @@ process_kill_tree <- function(self, private, grace, close_connections) {
"!DEBUG process_kill_tree '`private$get_short_name()`', pid `self$get_pid()`"
if (!ps::ps_is_supported()) {
throw(new_not_implemented_error(
- "kill_tree is not supported on this platform"))
+ "kill_tree is not supported on this platform"
+ ))
}
ret <- get("ps_kill_tree", asNamespace("ps"))(private$tree_id)
@@ -771,7 +782,6 @@ process_supervise <- function(self, private, status) {
if (status && !self$is_supervised()) {
supervisor_watch_pid(self$get_pid())
private$supervised <- TRUE
-
} else if (!status && self$is_supervised()) {
supervisor_unwatch_pid(self$get_pid())
private$supervised <- FALSE
diff --git a/R/run.R b/R/run.R
index 52eaf096..6f7ad773 100644
--- a/R/run.R
+++ b/R/run.R
@@ -123,6 +123,7 @@
#' both streams in UTF-8 currently.
#' @param cleanup_tree Whether to clean up the child process tree after
#' the process has finished.
+#' @param cleanup_grace Passed to `kill()` or `kill_tree()` on cleanup.
#' @param ... Extra arguments are passed to `process$new()`, see
#' [process]. Note that you cannot pass `stout` or `stderr` here,
#' because they are used internally by `run()`. You can use the
@@ -155,27 +156,46 @@
#' error_on_status = FALSE)
run <- function(
- command = NULL, args = character(), error_on_status = TRUE, wd = NULL,
- echo_cmd = FALSE, echo = FALSE, spinner = FALSE,
- timeout = Inf, stdout = "|", stderr = "|",
- stdout_line_callback = NULL, stdout_callback = NULL,
- stderr_line_callback = NULL, stderr_callback = NULL,
- stderr_to_stdout = FALSE, env = NULL,
- windows_verbatim_args = FALSE, windows_hide_window = FALSE,
- encoding = "", cleanup_tree = FALSE, ...) {
-
+ command = NULL,
+ args = character(),
+ error_on_status = TRUE,
+ wd = NULL,
+ echo_cmd = FALSE,
+ echo = FALSE,
+ spinner = FALSE,
+ timeout = Inf,
+ stdout = "|",
+ stderr = "|",
+ stdout_line_callback = NULL,
+ stdout_callback = NULL,
+ stderr_line_callback = NULL,
+ stderr_callback = NULL,
+ stderr_to_stdout = FALSE,
+ env = NULL,
+ windows_verbatim_args = FALSE,
+ windows_hide_window = FALSE,
+ encoding = "",
+ cleanup_tree = FALSE,
+ cleanup_grace = 0.1,
+ ...
+) {
assert_that(is_flag(error_on_status))
assert_that(is_time_interval(timeout))
assert_that(is_flag(spinner))
assert_that(is_string_or_null(stdout))
assert_that(is_string_or_null(stderr))
- assert_that(is.null(stdout_line_callback) ||
- is.function(stdout_line_callback))
- assert_that(is.null(stderr_line_callback) ||
- is.function(stderr_line_callback))
+ assert_that(
+ is.null(stdout_line_callback) ||
+ is.function(stdout_line_callback)
+ )
+ assert_that(
+ is.null(stderr_line_callback) ||
+ is.function(stderr_line_callback)
+ )
assert_that(is.null(stdout_callback) || is.function(stdout_callback))
assert_that(is.null(stderr_callback) || is.function(stderr_callback))
assert_that(is_flag(cleanup_tree))
+ assert_that(is_numeric_scalar(cleanup_grace))
assert_that(is_flag(stderr_to_stdout))
## The rest is checked by process$new()
"!DEBUG run() Checked arguments"
@@ -185,19 +205,26 @@ run <- function(
## Run the process
if (stderr_to_stdout) stderr <- "2>&1"
pr <- process$new(
- command, args, echo_cmd = echo_cmd, wd = wd,
+ command,
+ args,
+ echo_cmd = echo_cmd,
+ wd = wd,
windows_verbatim_args = windows_verbatim_args,
windows_hide_window = windows_hide_window,
- stdout = stdout, stderr = stderr, env = env, encoding = encoding,
- cleanup_tree = cleanup_tree, ...
+ stdout = stdout,
+ stderr = stderr,
+ env = env,
+ encoding = encoding,
+ cleanup_tree = cleanup_tree,
+ ...
)
"#!DEBUG run() Started the process: `pr$get_pid()`"
## We make sure that the process is eliminated
if (cleanup_tree) {
- on.exit(pr$kill_tree(), add = TRUE)
+ defer(pr$kill_tree(grace = cleanup_grace))
} else {
- on.exit(pr$kill(), add = TRUE)
+ defer(pr$kill(grace = cleanup_grace))
}
## If echo, then we need to create our own callbacks.
@@ -223,9 +250,18 @@ run <- function(
}
res <- tryCatch(
- run_manage(pr, timeout, spinner, stdout, stderr,
- stdout_line_callback, stdout_callback,
- stderr_line_callback, stderr_callback, resenv),
+ run_manage(
+ pr,
+ timeout,
+ spinner,
+ stdout,
+ stderr,
+ stdout_line_callback,
+ stdout_callback,
+ stderr_line_callback,
+ stderr_callback,
+ resenv
+ ),
interrupt = function(e) {
"!DEBUG run() process `pr$get_pid()` killed on interrupt"
out <- if (has_stdout) {
@@ -238,13 +274,18 @@ run <- function(
resenv$errbuf$push(pr$read_error())
resenv$errbuf$read()
}
- tryCatch(pr$kill(), error = function(e) NULL)
+ tryCatch(pr$kill(grace = cleanup_grace), error = function(e) NULL)
signalCondition(new_process_interrupt_cond(
list(
- interrupt = TRUE, stderr = err, stdout = out,
- command = command, args = args
+ interrupt = TRUE,
+ stderr = err,
+ stdout = out,
+ command = command,
+ args = args
),
- runcall, echo = echo, stderr_to_stdout = stderr_to_stdout
+ runcall,
+ echo = echo,
+ stderr_to_stdout = stderr_to_stdout
))
cat("\n")
invokeRestart("abort")
@@ -253,9 +294,15 @@ run <- function(
if (error_on_status && (is.na(res$status) || res$status != 0)) {
"!DEBUG run() error on status `res$status` for process `pr$get_pid()`"
- throw(new_process_error(res, call = sys.call(), echo = echo,
- stderr_to_stdout, res$status, command = command,
- args = args))
+ throw(new_process_error(
+ res,
+ call = sys.call(),
+ echo = echo,
+ stderr_to_stdout,
+ res$status,
+ command = command,
+ args = args
+ ))
}
res
@@ -271,10 +318,18 @@ echo_callback <- function(user_callback, type) {
}
}
-run_manage <- function(proc, timeout, spinner, stdout, stderr,
- stdout_line_callback, stdout_callback,
- stderr_line_callback, stderr_callback, resenv) {
-
+run_manage <- function(
+ proc,
+ timeout,
+ spinner,
+ stdout,
+ stderr,
+ stdout_line_callback,
+ stdout_callback,
+ stderr_line_callback,
+ stderr_callback,
+ resenv
+) {
timeout <- as.difftime(timeout, units = "secs")
start_time <- proc$get_start_time()
@@ -285,14 +340,16 @@ run_manage <- function(proc, timeout, spinner, stdout, stderr,
pushback_err <- ""
do_output <- function() {
-
ok <- FALSE
if (has_stdout) {
- newout <- tryCatch({
- ret <- proc$read_output(2000)
- ok <- TRUE
- ret
- }, error = function(e) NULL)
+ newout <- tryCatch(
+ {
+ ret <- proc$read_output(2000)
+ ok <- TRUE
+ ret
+ },
+ error = function(e) NULL
+ )
if (length(newout) && nzchar(newout)) {
if (!is.null(stdout_callback)) stdout_callback(newout, proc)
@@ -311,11 +368,14 @@ run_manage <- function(proc, timeout, spinner, stdout, stderr,
}
if (has_stderr) {
- newerr <- tryCatch({
- ret <- proc$read_error(2000)
- ok <- TRUE
- ret
- }, error = function(e) NULL)
+ newerr <- tryCatch(
+ {
+ ret <- proc$read_error(2000)
+ ok <- TRUE
+ ret
+ },
+ error = function(e) NULL
+ )
if (length(newerr) && nzchar(newerr)) {
resenv$errbuf$push(newerr)
@@ -350,8 +410,11 @@ run_manage <- function(proc, timeout, spinner, stdout, stderr,
while (proc$is_alive()) {
## Timeout? Maybe finished by now...
- if (!is.null(timeout) && is.finite(timeout) &&
- Sys.time() - start_time > timeout) {
+ if (
+ !is.null(timeout) &&
+ is.finite(timeout) &&
+ Sys.time() - start_time > timeout
+ ) {
if (proc$kill(close_connections = FALSE)) timeout_happened <- TRUE
"!DEBUG Timeout killed run() process `proc$get_pid()`"
break
@@ -383,8 +446,10 @@ run_manage <- function(proc, timeout, spinner, stdout, stderr,
## We might still have output
"!DEBUG run() reading leftover output / error, process `proc$get_pid()`"
- while ((has_stdout && proc$is_incomplete_output()) ||
- (proc$has_error_connection() && proc$is_incomplete_error())) {
+ while (
+ (has_stdout && proc$is_incomplete_output()) ||
+ (proc$has_error_connection() && proc$is_incomplete_error())
+ ) {
proc$poll_io(-1)
if (!do_output()) break
}
@@ -399,21 +464,51 @@ run_manage <- function(proc, timeout, spinner, stdout, stderr,
)
}
-new_process_error <- function(result, call, echo, stderr_to_stdout,
- status = NA_integer_, command, args) {
+new_process_error <- function(
+ result,
+ call,
+ echo,
+ stderr_to_stdout,
+ status = NA_integer_,
+ command,
+ args
+) {
if (isTRUE(result$timeout)) {
- new_process_timeout_error(result, call, echo, stderr_to_stdout, status,
- command, args)
+ new_process_timeout_error(
+ result,
+ call,
+ echo,
+ stderr_to_stdout,
+ status,
+ command,
+ args
+ )
} else {
- new_process_status_error(result, call, echo, stderr_to_stdout, status,
- command, args)
+ new_process_status_error(
+ result,
+ call,
+ echo,
+ stderr_to_stdout,
+ status,
+ command,
+ args
+ )
}
}
-new_process_status_error <- function(result, call, echo, stderr_to_stdout,
- status = NA_integer_, command, args) {
+new_process_status_error <- function(
+ result,
+ call,
+ echo,
+ stderr_to_stdout,
+ status = NA_integer_,
+ command,
+ args
+) {
err <- new_error(
- "System command '", basename(command), "' failed",
+ "System command '",
+ basename(command),
+ "' failed",
call. = call
)
err$stderr <- if (stderr_to_stdout) result$stdout else result$stderr
@@ -424,10 +519,17 @@ new_process_status_error <- function(result, call, echo, stderr_to_stdout,
add_class(err, c("system_command_status_error", "system_command_error"))
}
-new_process_interrupt_cond <- function(result, call, echo, stderr_to_stdout,
- status = NA_integer_) {
+new_process_interrupt_cond <- function(
+ result,
+ call,
+ echo,
+ stderr_to_stdout,
+ status = NA_integer_
+) {
cond <- new_cond(
- "System command '", basename(result$command), "' interrupted",
+ "System command '",
+ basename(result$command),
+ "' interrupted",
call. = call
)
cond$stderr <- if (stderr_to_stdout) result$stdout else result$stderr
@@ -438,10 +540,21 @@ new_process_interrupt_cond <- function(result, call, echo, stderr_to_stdout,
add_class(cond, c("system_command_interrupt", "interrupt"))
}
-new_process_timeout_error <- function(result, call, echo, stderr_to_stdout,
- status = NA_integer_, command, args) {
+new_process_timeout_error <- function(
+ result,
+ call,
+ echo,
+ stderr_to_stdout,
+ status = NA_integer_,
+ command,
+ args
+) {
err <- new_error(
- "System command '", basename(command), "' timed out", call. = call)
+ "System command '",
+ basename(command),
+ "' timed out",
+ call. = call
+ )
err$stderr <- if (stderr_to_stdout) result$stdout else result$stderr
err$echo <- echo
err$stderr_to_stdout <- stderr_to_stdout
@@ -452,8 +565,13 @@ new_process_timeout_error <- function(result, call, echo, stderr_to_stdout,
#' @export
-format.system_command_error <- function(x, trace = TRUE, class = TRUE,
- advice = !trace, ...) {
+format.system_command_error <- function(
+ x,
+ trace = TRUE,
+ class = TRUE,
+ advice = !trace,
+ ...
+) {
class(x) <- setdiff(class(x), "system_command_error")
lines <- NextMethod(
diff --git a/R/standalone-errors.R b/R/standalone-errors.R
index 35d78374..28a6b3a6 100644
--- a/R/standalone-errors.R
+++ b/R/standalone-errors.R
@@ -168,7 +168,6 @@
# * `call.` can now be a frame environment as in `rlang::abort()`
err <- local({
-
# -- dependencies -----------------------------------------------------
rstudio_detect <- rstudio$detect
@@ -195,7 +194,8 @@ err <- local({
message <- .makeMessage(..., domain = domain)
structure(
list(message = message, call = call., srcref = srcref),
- class = c("condition"))
+ class = c("condition")
+ )
}
#' Create a new error condition
@@ -231,10 +231,12 @@ err <- local({
#' @param frame The throwing context. Can be used to hide frames from
#' the backtrace.
- throw <- throw_error <- function(cond,
- parent = NULL,
- call = parent.frame(),
- frame = environment()) {
+ throw <- throw_error <- function(
+ cond,
+ parent = NULL,
+ call = parent.frame(),
+ frame = environment()
+ ) {
if (!inherits(cond, "condition")) {
cond <- new_error(cond)
}
@@ -278,9 +280,11 @@ err <- local({
# baseenv(), so it is almost as if it was in baseenv() itself, like
# .Last.value. We save the print methods here as well, and then they
# will be found automatically.
- if (! "org:r-lib" %in% search()) {
- do.call("attach", list(new.env(), pos = length(search()),
- name = "org:r-lib"))
+ if (!"org:r-lib" %in% search()) {
+ do.call(
+ "attach",
+ list(new.env(), pos = length(search()), name = "org:r-lib")
+ )
}
env <- as.environment("org:r-lib")
env$.Last.error <- cond
@@ -291,13 +295,15 @@ err <- local({
# If this is not an error, then we'll just return here. This allows
# throwing interrupt conditions for example, with the same UI.
- if (! inherits(cond, "error")) return(invisible())
+ if (!inherits(cond, "error")) return(invisible())
.hide_from_trace <- NULL
# Top-level handler, this is intended for testing only for now,
# and its design might change.
- if (!is.null(th <- getOption("rlib_error_handler")) &&
- is.function(th)) {
+ if (
+ !is.null(th <- getOption("rlib_error_handler")) &&
+ is.function(th)
+ ) {
return(th(cond))
}
@@ -345,17 +351,20 @@ err <- local({
.hide_from_trace <- 1
force(call)
srcref <- srcref %||% utils::getSrcref(sys.call())
- withCallingHandlers({
- expr
- }, error = function(e) {
- .hide_from_trace <- 0:1
- e$srcref <- srcref
- e$procsrcref <- NULL
- if (!inherits(err, "condition")) {
- err <- new_error(err, call. = call)
+ withCallingHandlers(
+ {
+ expr
+ },
+ error = function(e) {
+ .hide_from_trace <- 0:1
+ e$srcref <- srcref
+ e$procsrcref <- NULL
+ if (!inherits(err, "condition")) {
+ err <- new_error(err, call. = call)
+ }
+ throw_error(err, parent = e)
}
- throw_error(err, parent = e)
- })
+ )
}
# -- rethrowing conditions from C code ---------------------------------
@@ -386,7 +395,13 @@ err <- local({
name <- native_name(.NAME)
err <- new_error("Native call to `", name, "` failed", call. = call1)
cerror <- if (inherits(e, "simpleError")) "c_error"
- class(err) <- c(cerror, "rlib_error_3_0", "rlib_error", "error", "condition")
+ class(err) <- c(
+ cerror,
+ "rlib_error_3_0",
+ "rlib_error",
+ "error",
+ "condition"
+ )
throw_error(err, parent = e)
}
)
@@ -421,7 +436,13 @@ err <- local({
name <- native_name(.NAME)
err <- new_error("Native call to `", name, "` failed", call. = call1)
cerror <- if (inherits(e, "simpleError")) "c_error"
- class(err) <- c(cerror, "rlib_error_3_0", "rlib_error", "error", "condition")
+ class(err) <- c(
+ cerror,
+ "rlib_error_3_0",
+ "rlib_error",
+ "error",
+ "condition"
+ )
throw_error(err, parent = e)
}
)
@@ -440,7 +461,6 @@ err <- local({
#' @return A condition object, with the trace added.
add_trace_back <- function(cond, frame = NULL) {
-
idx <- seq_len(sys.parent(1L))
frames <- sys.frames()[idx]
@@ -505,22 +525,29 @@ err <- local({
}
is_operator <- function(cl) {
- is.call(cl) && length(cl) >= 1 && is.symbol(cl[[1]]) &&
+ is.call(cl) &&
+ length(cl) >= 1 &&
+ is.symbol(cl[[1]]) &&
grepl("^[^.a-zA-Z]", as.character(cl[[1]]))
}
mark_invisible_frames <- function(funs, frames) {
visibles <- rep(TRUE, length(frames))
hide <- lapply(frames, "[[", ".hide_from_trace")
- w_hide <- unlist(mapply(seq_along(hide), hide, FUN = function(i, w) {
- i + w
- }, SIMPLIFY = FALSE))
+ w_hide <- unlist(mapply(
+ seq_along(hide),
+ hide,
+ FUN = function(i, w) {
+ i + w
+ },
+ SIMPLIFY = FALSE
+ ))
w_hide <- w_hide[w_hide <= length(frames)]
visibles[w_hide] <- FALSE
hide_from <- which(funs %in% names(invisible_frames))
for (start in hide_from) {
- hide_this <- invisible_frames[[ funs[start] ]]
+ hide_this <- invisible_frames[[funs[start]]]
for (i in seq_along(hide_this)) {
if (start + i > length(funs)) break
if (funs[start + i] != hide_this[i]) break
@@ -537,7 +564,8 @@ err <- local({
"cli::cli_abort" = c(
"rlang::abort",
"rlang:::signal_abort",
- "base::signalCondition"),
+ "base::signalCondition"
+ ),
"rlang::abort" = c("rlang:::signal_abort", "base::signalCondition")
)
@@ -558,12 +586,15 @@ err <- local({
get_call_scope <- function(call, ns) {
if (is.na(ns)) return("global")
if (!is.call(call)) return("")
- if (is.call(call[[1]]) &&
- (call[[1]][[1]] == quote(`::`) || call[[1]][[1]] == quote(`:::`))) return("")
+ if (
+ is.call(call[[1]]) &&
+ (call[[1]][[1]] == quote(`::`) || call[[1]][[1]] == quote(`:::`))
+ )
+ return("")
if (ns == "base") return("::")
- if (! ns %in% loadedNamespaces()) return("")
+ if (!ns %in% loadedNamespaces()) return("")
name <- call_name(call)
- if (! ns %in% loadedNamespaces()) return("::")
+ if (!ns %in% loadedNamespaces()) return("::")
nsenv <- asNamespace(ns)$.__NAMESPACE__.
if (is.null(nsenv)) return("::")
if (is.null(nsenv$exports)) return(":::")
@@ -580,7 +611,16 @@ err <- local({
topenv(x, matchThisEnv = err_env)
}
- new_trace <- function (calls, parents, visibles, namespaces, scopes, srcrefs, procsrcrefs, pids) {
+ new_trace <- function(
+ calls,
+ parents,
+ visibles,
+ namespaces,
+ scopes,
+ srcrefs,
+ procsrcrefs,
+ pids
+ ) {
trace <- data.frame(
stringsAsFactors = FALSE,
parent = parents,
@@ -633,9 +673,15 @@ err <- local({
# -- S3 methods -------------------------------------------------------
- format_error <- function(x, trace = FALSE, class = FALSE,
- advice = !trace, full = trace, header = TRUE,
- ...) {
+ format_error <- function(
+ x,
+ trace = FALSE,
+ class = FALSE,
+ advice = !trace,
+ full = trace,
+ header = TRUE,
+ ...
+ ) {
if (has_cli()) {
format_error_cli(x, trace, class, advice, full, header, ...)
} else {
@@ -643,8 +689,7 @@ err <- local({
}
}
- print_error <- function(x, trace = TRUE, class = TRUE,
- advice = !trace, ...) {
+ print_error <- function(x, trace = TRUE, class = TRUE, advice = !trace, ...) {
writeLines(format_error(x, trace, class, advice, ...))
}
@@ -740,12 +785,13 @@ err <- local({
paste0(if (add_exp) exp, msg),
if (inherits(cond$parent, "condition")) {
msg <- if (full && inherits(cond$parent, "rlib_error_3_0")) {
- format(cond$parent,
- trace = FALSE,
- full = TRUE,
- class = FALSE,
- header = FALSE,
- advice = FALSE
+ format(
+ cond$parent,
+ trace = FALSE,
+ full = TRUE,
+ class = FALSE,
+ header = FALSE,
+ advice = FALSE
)
} else if (inherits(cond$parent, "interrupt")) {
"interrupt"
@@ -754,9 +800,7 @@ err <- local({
}
add_exp <- substr(cli::ansi_strip(msg[1]), 1, 1) != "!"
if (add_exp) msg[1] <- paste0(exp, msg[1])
- c(format_header_line_cli(cond$parent, prefix = "Caused by error"),
- msg
- )
+ c(format_header_line_cli(cond$parent, prefix = "Caused by error"), msg)
}
)
}
@@ -770,12 +814,13 @@ err <- local({
paste0(if (add_exp) exp, cnd_message_robust(cond)),
if (inherits(cond$parent, "condition")) {
msg <- if (full && inherits(cond$parent, "rlib_error_3_0")) {
- format(cond$parent,
- trace = FALSE,
- full = TRUE,
- class = FALSE,
- header = FALSE,
- advice = FALSE
+ format(
+ cond$parent,
+ trace = FALSE,
+ full = TRUE,
+ class = FALSE,
+ header = FALSE,
+ advice = FALSE
)
} else if (inherits(cond$parent, "interrupt")) {
"interrupt"
@@ -786,7 +831,8 @@ err <- local({
if (add_exp) {
msg[1] <- paste0(exp, msg[1])
}
- c(format_header_line_plain(cond$parent, prefix = "Caused by error"),
+ c(
+ format_header_line_plain(cond$parent, prefix = "Caused by error"),
msg
)
}
@@ -802,9 +848,15 @@ err <- local({
# - error message, just `conditionMessage()`
# - advice about .Last.error and/or .Last.error.trace
- format_error_cli <- function(x, trace = TRUE, class = TRUE,
- advice = !trace, full = trace,
- header = TRUE, ...) {
+ format_error_cli <- function(
+ x,
+ trace = TRUE,
+ class = TRUE,
+ advice = !trace,
+ full = trace,
+ header = TRUE,
+ ...
+ ) {
p_class <- if (class) format_class_cli(x)
p_header <- if (header) format_header_line_cli(x)
p_msg <- cnd_message_cli(x, full)
@@ -813,11 +865,7 @@ err <- local({
c("---", "Backtrace:", format_trace_cli(x$trace))
}
- c(p_class,
- p_header,
- p_msg,
- p_advice,
- p_trace)
+ c(p_class, p_header, p_msg, p_advice, p_trace)
}
format_header_line_cli <- function(x, prefix = NULL) {
@@ -904,7 +952,11 @@ err <- local({
srcref <- if ("srcref" %in% names(x) || "procsrcref" %in% names(x)) {
vapply(
seq_len(nrow(x)),
- function(i) format_srcref_cli(x[["call"]][[i]], x$procsrcref[[i]] %||% x$srcref[[i]]),
+ function(i)
+ format_srcref_cli(
+ x[["call"]][[i]],
+ x$procsrcref[[i]] %||% x$srcref[[i]]
+ ),
character(1)
)
} else {
@@ -913,11 +965,15 @@ err <- local({
lines <- paste0(
cli::col_silver(format(x$num), ". "),
- ifelse (visible, "", "| "),
+ ifelse(visible, "", "| "),
scope,
- vapply(seq_along(x$call), function(i) {
- format_trace_call_cli(x$call[[i]], x$namespace[[i]])
- }, character(1)),
+ vapply(
+ seq_along(x$call),
+ function(i) {
+ format_trace_call_cli(x$call[[i]], x$namespace[[i]])
+ },
+ character(1)
+ ),
srcref
)
@@ -930,12 +986,17 @@ err <- local({
}
format_trace_call_cli <- function(call, ns = "") {
- envir <- tryCatch({
- if (!ns %in% loadedNamespaces()) stop("no")
- asNamespace(ns)
- }, error = function(e) .GlobalEnv)
+ envir <- tryCatch(
+ {
+ if (!ns %in% loadedNamespaces()) stop("no")
+ asNamespace(ns)
+ },
+ error = function(e) .GlobalEnv
+ )
cl <- trimws(format(call))
- if (length(cl) > 1) { cl <- paste0(cl[1], " ", cli::symbol$ellipsis) }
+ if (length(cl) > 1) {
+ cl <- paste0(cl[1], " ", cli::symbol$ellipsis)
+ }
# Older cli does not have 'envir'.
if ("envir" %in% names(formals(cli::code_highlight))) {
fmc <- cli::code_highlight(cl, envir = envir)[1]
@@ -947,9 +1008,15 @@ err <- local({
# ----------------------------------------------------------------------
- format_error_plain <- function(x, trace = TRUE, class = TRUE,
- advice = !trace, full = trace, header = TRUE,
- ...) {
+ format_error_plain <- function(
+ x,
+ trace = TRUE,
+ class = TRUE,
+ advice = !trace,
+ full = trace,
+ header = TRUE,
+ ...
+ ) {
p_class <- if (class) format_class_plain(x)
p_header <- if (header) format_header_line_plain(x)
p_msg <- cnd_message_plain(x, full)
@@ -958,11 +1025,7 @@ err <- local({
c("---", "Backtrace:", format_trace_plain(x$trace))
}
- c(p_class,
- p_header,
- p_msg,
- p_advice,
- p_trace)
+ c(p_class, p_header, p_msg, p_advice, p_trace)
}
format_trace_plain <- function(x, ...) {
@@ -983,7 +1046,11 @@ err <- local({
srcref <- if ("srcref" %in% names(x) || "procsrfref" %in% names(x)) {
vapply(
seq_len(nrow(x)),
- function(i) format_srcref_plain(x[["call"]][[i]], x$procsrcref[[i]] %||% x$srcref[[i]]),
+ function(i)
+ format_srcref_plain(
+ x[["call"]][[i]],
+ x$procsrcref[[i]] %||% x$srcref[[i]]
+ ),
character(1)
)
} else {
@@ -992,7 +1059,7 @@ err <- local({
lines <- paste0(
paste0(format(x$num), ". "),
- ifelse (visible, "", "| "),
+ ifelse(visible, "", "| "),
scope,
vapply(x[["call"]], format_trace_call_plain, character(1)),
srcref
@@ -1008,7 +1075,10 @@ err <- local({
format_header_line_plain <- function(x, prefix = NULL) {
p_error <- format_error_heading_plain(x, prefix)
p_call <- format_call_plain(x[["call"]])
- p_srcref <- format_srcref_plain(conditionCall(x), x$procsrcref %||% x$srcref)
+ p_srcref <- format_srcref_plain(
+ conditionCall(x),
+ x$procsrcref %||% x$srcref
+ )
paste0(p_error, p_call, p_srcref, if (!is.null(conditionCall(x))) ":")
}
@@ -1051,7 +1121,9 @@ err <- local({
format_trace_call_plain <- function(call) {
fmc <- trimws(format(call)[1])
- if (length(fmc) > 1) { fmc <- paste0(fmc[1], " ...") }
+ if (length(fmc) > 1) {
+ fmc <- paste0(fmc[1], " ...")
+ }
strtrim(fmc, getOption("width") - 5)
}
@@ -1109,7 +1181,9 @@ err <- local({
FALSE
} else if (tolower(getOption("knitr.in.progress", "false")) == "true") {
FALSE
- } else if (tolower(getOption("rstudio.notebook.executing", "false")) == "true") {
+ } else if (
+ tolower(getOption("rstudio.notebook.executing", "false")) == "true"
+ ) {
FALSE
} else if (identical(Sys.getenv("TESTTHAT"), "true")) {
FALSE
@@ -1124,13 +1198,14 @@ err <- local({
rstudio_stdout <- function() {
rstudio <- rstudio_detect()
- rstudio$type %in% c(
- "rstudio_console",
- "rstudio_console_starting",
- "rstudio_build_pane",
- "rstudio_job",
- "rstudio_render_pane"
- )
+ rstudio$type %in%
+ c(
+ "rstudio_console",
+ "rstudio_console_starting",
+ "rstudio_build_pane",
+ "rstudio_job",
+ "rstudio_render_pane"
+ )
}
default_output <- function() {
@@ -1148,7 +1223,12 @@ err <- local({
registerS3method("format", "rlib_trace_3_0", format_trace, baseenv())
registerS3method("print", "rlib_error_3_0", print_error, baseenv())
registerS3method("print", "rlib_trace_3_0", print_trace, baseenv())
- registerS3method("conditionMessage", "rlib_error_3_0", cnd_message, baseenv())
+ registerS3method(
+ "conditionMessage",
+ "rlib_error_3_0",
+ cnd_message,
+ baseenv()
+ )
}
}
@@ -1205,40 +1285,41 @@ err <- local({
structure(
list(
- .internal = err_env,
- new_cond = new_cond,
- new_error = new_error,
- throw = throw,
- throw_error = throw_error,
- chain_error = chain_error,
- chain_call = chain_call,
+ .internal = err_env,
+ new_cond = new_cond,
+ new_error = new_error,
+ throw = throw,
+ throw_error = throw_error,
+ chain_error = chain_error,
+ chain_call = chain_call,
chain_clean_call = chain_clean_call,
- add_trace_back = add_trace_back,
- process_call = process_call,
- onload_hook = onload_hook,
- is_interactive = is_interactive,
+ add_trace_back = add_trace_back,
+ process_call = process_call,
+ onload_hook = onload_hook,
+ is_interactive = is_interactive,
register_testthat_print = register_testthat_print,
format = list(
- advice = format_advice,
- call = format_call,
- class = format_class,
- error = format_error,
+ advice = format_advice,
+ call = format_call,
+ class = format_class,
+ error = format_error,
error_heading = format_error_heading,
- header_line = format_header_line,
- srcref = format_srcref,
- trace = format_trace
+ header_line = format_header_line,
+ srcref = format_srcref,
+ trace = format_trace
)
),
- class = c("standalone_errors", "standalone"))
+ class = c("standalone_errors", "standalone")
+ )
})
# These are optional, and feel free to remove them if you prefer to
# call them through the `err` object.
-new_cond <- err$new_cond
-new_error <- err$new_error
-throw <- err$throw
-throw_error <- err$throw_error
-chain_error <- err$chain_error
-chain_call <- err$chain_call
+new_cond <- err$new_cond
+new_error <- err$new_error
+throw <- err$throw
+throw_error <- err$throw_error
+chain_error <- err$chain_error
+chain_call <- err$chain_call
chain_clean_call <- err$chain_clean_call
diff --git a/R/supervisor.R b/R/supervisor.R
index 58e4893d..40efcaa1 100644
--- a/R/supervisor.R
+++ b/R/supervisor.R
@@ -1,13 +1,17 @@
# Stores information about the supervisor process
supervisor_info <- new.env()
-reg.finalizer(supervisor_info, function(s) {
- # Pass s to `supervisor_kill`, in case the GC event happens _after_ a new
- # `processx:::supervisor_info` has been created and the name
- # `supervisor_info` is bound to the new object. This could happen if the
- # package is unloaded and reloaded.
- supervisor_kill2(s)
-}, onexit = TRUE)
+reg.finalizer(
+ supervisor_info,
+ function(s) {
+ # Pass s to `supervisor_kill`, in case the GC event happens _after_ a new
+ # `processx:::supervisor_info` has been created and the name
+ # `supervisor_info` is bound to the new object. This could happen if the
+ # package is unloaded and reloaded.
+ supervisor_kill2(s)
+ },
+ onexit = TRUE
+)
#' Terminate all supervised processes and the supervisor process itself as
#' well
@@ -30,8 +34,7 @@ supervisor_kill <- function() {
# This takes an object s, because a new `supervisor_info` object could have been
# created.
supervisor_kill2 <- function(s = supervisor_info) {
- if (is.null(s$pid))
- return()
+ if (is.null(s$pid)) return()
if (!is.null(s$stdin) && is_pipe_open(s$stdin)) {
write_lines_named_pipe(s$stdin, "kill")
@@ -53,17 +56,16 @@ supervisor_reset <- function() {
supervisor_kill()
}
- supervisor_info$pid <- NULL
- supervisor_info$stdin <- NULL
- supervisor_info$stdout <- NULL
- supervisor_info$stdin_file <- NULL
+ supervisor_info$pid <- NULL
+ supervisor_info$stdin <- NULL
+ supervisor_info$stdout <- NULL
+ supervisor_info$stdin_file <- NULL
supervisor_info$stdout_file <- NULL
}
supervisor_ensure_running <- function() {
- if (!supervisor_running())
- supervisor_start()
+ if (!supervisor_running()) supervisor_start()
}
@@ -92,11 +94,10 @@ supervisor_unwatch_pid <- function(pid) {
# Start the supervisor process. Information about the process will be stored in
# supervisor_info. If startup fails, this function will throw an error.
supervisor_start <- function() {
-
- supervisor_info$stdin_file <- named_pipe_tempfile("supervisor_stdin")
+ supervisor_info$stdin_file <- named_pipe_tempfile("supervisor_stdin")
supervisor_info$stdout_file <- named_pipe_tempfile("supervisor_stdout")
- supervisor_info$stdin <- create_named_pipe(supervisor_info$stdin_file)
+ supervisor_info$stdin <- create_named_pipe(supervisor_info$stdin_file)
supervisor_info$stdout <- create_named_pipe(supervisor_info$stdout_file)
# Start the supervisor, passing the R process's PID to it.
@@ -116,8 +117,7 @@ supervisor_start <- function() {
while (cur_time < end_time) {
p$poll_io(round(as.numeric(end_time - cur_time, units = "secs") * 1000))
- if (!p$is_alive())
- break
+ if (!p$is_alive()) break
if (any(p$read_output_lines() == "Ready")) {
ready <- TRUE
@@ -127,8 +127,7 @@ supervisor_start <- function() {
cur_time <- Sys.time()
}
- if (p$is_alive())
- close(p$get_output_connection())
+ if (p$is_alive()) close(p$get_output_connection())
# Two ways of reaching this: if process has died, or if it hasn't emitted
# "Ready" after 5 seconds.
@@ -143,8 +142,7 @@ supervisor_start <- function() {
# normal way, and when loaded with devtools::load_all().
supervisor_path <- function() {
supervisor_name <- "supervisor"
- if (is_windows())
- supervisor_name <- paste0(supervisor_name, ".exe")
+ if (is_windows()) supervisor_name <- paste0(supervisor_name, ".exe")
# Detect if package was loaded via devtools::load_all()
dev_meta <- parent.env(environment())$.__DEVTOOLS__
diff --git a/R/utils.R b/R/utils.R
index 5a78f802..cc2ca5eb 100644
--- a/R/utils.R
+++ b/R/utils.R
@@ -1,4 +1,3 @@
-
enc2path <- function(x) {
if (is_windows()) {
enc2utf8(x)
@@ -48,27 +47,27 @@ full_path <- function(path) {
if (grepl("^[a-zA-Z]:", path)) {
drive <- substring(path, 1, 2)
path <- substring(path, 3)
-
} else if (substring(path, 1, 2) == "//") {
# Extract server name, like "//server", and use as drive.
pos <- regexec("^(//[^/]*)(.*)", path)[[1]]
- drive <- substring(path, pos[2], attr(pos, "match.length", exact = TRUE)[2])
+ drive <- substring(
+ path,
+ pos[2],
+ attr(pos, "match.length", exact = TRUE)[2]
+ )
path <- substring(path, pos[3])
# Must have a name, like "//server"
if (drive == "//")
throw(new_error("Server name not found in network path."))
-
} else {
drive <- substring(getwd(), 1, 2)
if (substr(path, 1, 1) != "/")
path <- substring(file.path(getwd(), path), 3)
}
-
} else {
- if (substr(path, 1, 1) != "/")
- path <- file.path(getwd(), path)
+ if (substr(path, 1, 1) != "/") path <- file.path(getwd(), path)
}
parts <- strsplit(path, "/")[[1]]
@@ -78,30 +77,27 @@ full_path <- function(path) {
while (i <= length(parts)) {
if (parts[i] == "." || parts[i] == "") {
parts <- parts[-i]
-
} else if (parts[i] == "..") {
if (i == 2) {
parts <- parts[-i]
} else {
- parts <- parts[-c(i-1, i)]
- i <- i-1
+ parts <- parts[-c(i - 1, i)]
+ i <- i - 1
}
} else {
- i <- i+1
+ i <- i + 1
}
}
new_path <- paste(parts, collapse = "/")
- if (new_path == "")
- new_path <- "/"
+ if (new_path == "") new_path <- "/"
- if (is_windows())
- new_path <- paste0(drive, new_path)
+ if (is_windows()) new_path <- paste0(drive, new_path)
new_path
}
-vcapply <- function (X, FUN, ..., USE.NAMES = TRUE) {
+vcapply <- function(X, FUN, ..., USE.NAMES = TRUE) {
vapply(X, FUN, FUN.VALUE = character(1), ..., USE.NAMES = USE.NAMES)
}
@@ -152,12 +148,10 @@ str_wrap_words <- function(words, width, indent = 0, exdent = 2) {
current_line <- paste0(current_line, words[i])
first_word <- FALSE
i <- i + 1
-
} else if (current_width + 1 + word_widths[i] <= width) {
current_width <- current_width + word_widths[i] + 1
current_line <- paste0(current_line, " ", words[i])
i <- i + 1
-
} else {
out <- c(out, current_line)
current_width <- exdent
@@ -194,9 +188,9 @@ get_tool <- function(prog) {
get_id <- function() {
paste0(
- "PS",
- paste(sample(c(LETTERS, 0:9), 10, replace = TRUE), collapse = ""),
- "_", as.integer(asNamespace("base")$.Internal(Sys.time()))
+ basename(tempfile("PS")),
+ "_",
+ as.integer(asNamespace("base")$.Internal(Sys.time()))
)
}
@@ -233,8 +227,10 @@ str_trim <- function(x) {
}
new_not_implemented_error <- function(message, call) {
- add_class(new_error(message, call. = call),
- c("not_implemented_error", "not_implemented"))
+ add_class(
+ new_error(message, call. = call),
+ c("not_implemented_error", "not_implemented")
+ )
}
add_class <- function(obj, class) {
@@ -250,7 +246,9 @@ is_interactive <- function() {
FALSE
} else if (tolower(getOption("knitr.in.progress", "false")) == "true") {
FALSE
- } else if (tolower(getOption("rstudio.notebook.executing", "false")) == "true") {
+ } else if (
+ tolower(getOption("rstudio.notebook.executing", "false")) == "true"
+ ) {
FALSE
} else if (identical(Sys.getenv("TESTTHAT"), "true")) {
FALSE
@@ -300,3 +298,24 @@ defer <- function(expr, frame = parent.frame(), after = FALSE) {
thunk <- as.call(list(function() expr))
do.call(on.exit, list(thunk, add = TRUE, after = after), envir = frame)
}
+
+rimraf <- function(...) {
+ x <- file.path(...)
+ if ("~" %in% x) stop("Cowardly refusing to delete `~`")
+ unlink(x, recursive = TRUE, force = TRUE)
+}
+
+get_test_lib <- function(lib) {
+ if (pkgload::is_dev_package("processx")) {
+ path <- "src"
+ } else {
+ path <- paste0('libs', .Platform$r_arch)
+ }
+
+ system.file(
+ package = "processx",
+ path,
+ "test",
+ paste0(lib, .Platform$dynlib.ext)
+ )
+}
diff --git a/README.Rmd b/README.Rmd
index 029146e8..63bc3650 100644
--- a/README.Rmd
+++ b/README.Rmd
@@ -20,7 +20,7 @@ knitr::opts_chunk$set(
[](https://github.com/r-lib/processx/actions/workflows/R-CMD-check.yaml)
[](https://www.r-pkg.org/pkg/processx)
[](https://www.r-pkg.org/pkg/processx)
-[](https://app.codecov.io/gh/r-lib/processx?branch=main)
+[](https://app.codecov.io/gh/r-lib/processx)
Tools to run system processes in the background,
@@ -83,6 +83,12 @@ Install the stable version from CRAN:
install.packages("processx")
```
+If you need the development version, install it from GitHub:
+
+```{r eval = FALSE}
+pak::pak("r-lib/processx")
+```
+
## Usage
```{r}
@@ -453,4 +459,4 @@ By contributing to this project, you agree to abide by its terms.
## License
-MIT © Mango Solutions, RStudio, Gábor Csárdi
+MIT © Ascent Digital Services, RStudio, Gábor Csárdi
diff --git a/README.md b/README.md
index 625e7a9e..9831684b 100644
--- a/README.md
+++ b/README.md
@@ -11,7 +11,7 @@
[](https://www.r-pkg.org/pkg/processx)
[](https://app.codecov.io/gh/r-lib/processx?branch=main)
+coverage](https://codecov.io/gh/r-lib/processx/graph/badge.svg)](https://app.codecov.io/gh/r-lib/processx)
Tools to run system processes in the background, read their standard
@@ -75,6 +75,12 @@ Install the stable version from CRAN:
install.packages("processx")
```
+If you need the development version, install it from GitHub:
+
+``` r
+pak::pak("r-lib/processx")
+```
+
## Usage
``` r
@@ -95,7 +101,7 @@ px <- paste0(
px
```
- #> [1] "/Users/gaborcsardi/Library/R/arm64/4.2/library/processx/bin/px"
+ #> [1] "/Users/gaborcsardi/Library/R/arm64/4.5/library/processx/bin/px"
### Running an external process
@@ -228,12 +234,11 @@ out1
out2
```
- #> [1] "CODE_OF_CONDUCT.md" "DESCRIPTION" "LICENSE"
- #> [4] "LICENSE.md" "Makefile" "NAMESPACE"
- #> [7] "NEWS.md" "R" "README.Rmd"
- #> [10] "README.md" "_pkgdown.yml" "codecov.yml"
- #> [13] "inst" "man" "processx.Rproj"
- #> [16] "src" "tests"
+ #> [1] "_pkgdown.yml" "codecov.yml" "DESCRIPTION" "inst"
+ #> [5] "LICENSE" "LICENSE.md" "Makefile" "man"
+ #> [9] "NAMESPACE" "NEWS.md" "processx.Rproj" "R"
+ #> [13] "README.md" "README.Rmd" "src" "tests"
+ #> [17] "vignettes"
#### Spinner
@@ -544,14 +549,14 @@ p$is_alive()
Sys.time()
```
- #> [1] "2022-06-10 13:57:49 CEST"
+ #> [1] "2025-04-26 09:34:10 CEST"
``` r
p$wait()
Sys.time()
```
- #> [1] "2022-06-10 13:57:51 CEST"
+ #> [1] "2025-04-26 09:34:12 CEST"
It is safe to call `wait()` multiple times:
@@ -606,7 +611,7 @@ p <- process$new("nonexistant-command-for-sure")
```
#> Error in c("process_initialize(self, private, command, args, stdin, stdout, ", : ! Native call to `processx_exec` failed
- #> Caused by error in `chain_call(c_processx_exec, command, c(command, args), pty, pty_options, …` at initialize.R:138:3:
+ #> Caused by error in `chain_call(c_processx_exec, command, c(command, args), pty, pty_options, …`:
#> ! cannot start processx process 'nonexistant-command-for-sure' (system error 2, No such file or directory) @unix/processx.c:613 (processx_exec)
``` r
@@ -637,4 +642,4 @@ contributing to this project, you agree to abide by its terms.
## License
-MIT © Mango Solutions, RStudio, Gábor Csárdi
+MIT © Ascent Digital Services, RStudio, Gábor Csárdi
diff --git a/air.toml b/air.toml
new file mode 100644
index 00000000..e69de29b
diff --git a/inst/COPYRIGHTS b/inst/COPYRIGHTS
new file mode 100644
index 00000000..e5d7d75a
--- /dev/null
+++ b/inst/COPYRIGHTS
@@ -0,0 +1,3 @@
+(c) 2016 Ascent Digital Services (formerly Mango Solutions)
+(c) 2017 Gábor Csárdi
+(c) 2017-2024 Posit Software, PBC (formerly RStudio)
diff --git a/man/process.Rd b/man/process.Rd
index a6330438..45f80d20 100644
--- a/man/process.Rd
+++ b/man/process.Rd
@@ -91,7 +91,6 @@ p$is_alive()
\subsection{Public methods}{
\itemize{
\item \href{#method-process-new}{\code{process$new()}}
-\item \href{#method-process-finalize}{\code{process$finalize()}}
\item \href{#method-process-kill}{\code{process$kill()}}
\item \href{#method-process-kill_tree}{\code{process$kill_tree()}}
\item \href{#method-process-signal}{\code{process$signal()}}
@@ -140,6 +139,7 @@ p$is_alive()
\item \href{#method-process-get_memory_info}{\code{process$get_memory_info()}}
\item \href{#method-process-suspend}{\code{process$suspend()}}
\item \href{#method-process-resume}{\code{process$resume()}}
+\item \href{#method-process-clone}{\code{process$clone()}}
}
}
\if{html}{\out{
}}
@@ -161,6 +161,7 @@ Start a new process in the background, and then return immediately.
env = NULL,
cleanup = TRUE,
cleanup_tree = FALSE,
+ cleanup_grace = 0,
wd = NULL,
echo_cmd = FALSE,
supervise = FALSE,
@@ -275,6 +276,11 @@ object is garbage collected.}
\item{\code{cleanup_tree}}{Whether to kill the process and its child
process tree when the \code{process} object is garbage collected.}
+\item{\code{cleanup_grace}}{Grace period between \code{SIGTERM} and \code{SIGKILL}.
+Only has an effect on Unix platforms. Set to 0 to terminate abruptly
+with \code{SIGKILL} only. Currently defaults to 0 until we implement
+a better approach on session quit.}
+
\item{\code{wd}}{Working directory of the process. It must exist.
If \code{NULL}, then the current working directory is used.}
@@ -312,18 +318,6 @@ It is only run once.}
\subsection{Returns}{
R6 object representing the process.
}
-}
-\if{html}{\out{
}}
-\if{html}{\out{}}
-\if{latex}{\out{\hypertarget{method-process-finalize}{}}}
-\subsection{Method \code{finalize()}}{
-Cleanup method that is called when the \code{process} object is garbage
-collected. If requested so in the process constructor, then it
-eliminates all processes in the process's subprocess tree.
-\subsection{Usage}{
-\if{html}{\out{}}\preformatted{process$finalize()}\if{html}{\out{
}}
-}
-
}
\if{html}{\out{
}}
\if{html}{\out{}}
@@ -1016,5 +1010,22 @@ Calls \code{\link[ps:ps_resume]{ps::ps_resume()}} to resume a suspended process.
\if{html}{\out{}}\preformatted{process$resume()}\if{html}{\out{
}}
}
+}
+\if{html}{\out{
}}
+\if{html}{\out{}}
+\if{latex}{\out{\hypertarget{method-process-clone}{}}}
+\subsection{Method \code{clone()}}{
+The objects of this class are cloneable with this method.
+\subsection{Usage}{
+\if{html}{\out{}}\preformatted{process$clone(deep = FALSE)}\if{html}{\out{
}}
+}
+
+\subsection{Arguments}{
+\if{html}{\out{}}
+\describe{
+\item{\code{deep}}{Whether to make a deep clone.}
+}
+\if{html}{\out{
}}
+}
}
}
diff --git a/man/process_initialize.Rd b/man/process_initialize.Rd
index e4dbbafb..0db37b60 100644
--- a/man/process_initialize.Rd
+++ b/man/process_initialize.Rd
@@ -19,6 +19,7 @@ process_initialize(
env,
cleanup,
cleanup_tree,
+ cleanup_grace,
wd,
echo_cmd,
supervise,
diff --git a/man/processx-package.Rd b/man/processx-package.Rd
index 59d46d95..b318e3a7 100644
--- a/man/processx-package.Rd
+++ b/man/processx-package.Rd
@@ -12,7 +12,7 @@ Tools to run system processes in the background. It can check if a background pr
Useful links:
\itemize{
\item \url{https://processx.r-lib.org}
- \item \url{https://github.com/r-lib/processx#readme}
+ \item \url{https://github.com/r-lib/processx}
\item Report bugs at \url{https://github.com/r-lib/processx/issues}
}
@@ -27,8 +27,8 @@ Authors:
Other contributors:
\itemize{
- \item RStudio [copyright holder, funder]
- \item Mango Solutions [copyright holder, funder]
+ \item Posit Software, PBC [copyright holder, funder]
+ \item Ascent Digital Services [copyright holder, funder]
}
}
diff --git a/man/run.Rd b/man/run.Rd
index 4b6c407c..feb58430 100644
--- a/man/run.Rd
+++ b/man/run.Rd
@@ -25,6 +25,7 @@ run(
windows_hide_window = FALSE,
encoding = "",
cleanup_tree = FALSE,
+ cleanup_grace = 0.1,
...
)
}
@@ -128,6 +129,8 @@ both streams in UTF-8 currently.}
\item{cleanup_tree}{Whether to clean up the child process tree after
the process has finished.}
+\item{cleanup_grace}{Passed to \code{kill()} or \code{kill_tree()} on cleanup.}
+
\item{...}{Extra arguments are passed to \code{process$new()}, see
\link{process}. Note that you cannot pass \code{stout} or \code{stderr} here,
because they are used internally by \code{run()}. You can use the
diff --git a/src/Makevars b/src/Makevars
index 2464737d..b3945aea 100644
--- a/src/Makevars
+++ b/src/Makevars
@@ -6,9 +6,16 @@ OBJECTS = init.o poll.o errors.o processx-connection.o \
unix/processx.o unix/sigchld.o unix/utils.o \
unix/named_pipe.o cleancall.o
-.PHONY: all clean
+all: tools/px tools/sock supervisor/supervisor client$(SHLIB_EXT) $(SHLIB) strip
-all: tools/px tools/sock supervisor/supervisor client$(SHLIB_EXT) $(SHLIB)
+strip: $(SHLIB) tools/px tools/sock supervisor/supervisor client$(SHLIB_EXT) test/sigtermignore$(SHLIB_EXT)
+ @if which strip >/dev/null && which uname >/dev/null && test "`uname`" = "Linux" && test "$$_R_SHLIB_STRIP_" = "true" && test -n "$$R_STRIP_SHARED_LIB"; then \
+ echo stripping $(SHLIB) tools/px tools/sock supervisor/supervisor client$(SHLIB_EXT); \
+ echo $$R_STRIP_SHARED_LIB $(SHLIB) tools/px tools/sock supervisor/supervisor client$(SHLIB_EXT); \
+ $$R_STRIP_SHARED_LIB $(SHLIB) tools/px tools/sock supervisor/supervisor client$(SHLIB_EXT); \
+ fi
+
+.PHONY: all clean strip
tools/px: tools/px.c
$(CC) $(CFLAGS) $(LDFLAGS) -Wall tools/px.c -o tools/px
@@ -25,11 +32,14 @@ CLIENT_OBJECTS = base64.o client.o errors.o
client$(SHLIB_EXT): $(CLIENT_OBJECTS)
$(SHLIB_LINK) -o client$(SHLIB_EXT) $(CLIENT_OBJECTS) $(PKG_LIBS) \
$(SHLIB_LIBADD) $(LIBR)
- if [ -n "${PROCESSX_UNLINK_R}" ]; then \
+ @if [ -n "${PROCESSX_UNLINK_R}" ]; then \
echo Removing libR.so dependency from client.so; \
patchelf --remove-needed libR.so client$(SHLIB_EXT); \
fi
+test/sigtermignore$(SHLIB_EXT): test/sigtermignore.o
+ $(SHLIB_LINK) -o test/sigtermignore$(SHLIB_EXT) test/sigtermignore.o
+
clean:
rm -rf $(SHLIB) $(OBJECTS) $(CLIENT_OBJECTS) \
supervisor/supervisor supervisor/supervisor.dSYM \
diff --git a/src/Makevars.win b/src/Makevars.win
index 7e5b0837..037ef13f 100644
--- a/src/Makevars.win
+++ b/src/Makevars.win
@@ -11,15 +11,12 @@ PKG_CFLAGS = -DSTRICT_R_HEADERS
PKG_LIBS = -lws2_32
-all: tools/px.exe tools/pxu.exe tools/sock.exe tools/interrupt.exe \
+all: tools/px.exe tools/sock.exe tools/interrupt.exe \
supervisor/supervisor.exe $(SHLIB) client$(SHLIB_EXT)
tools/px.exe: tools/px.c
$(CC) $(CFLAGS) -Wall $< -o $@
-tools/pxu.exe: tools/pxu.c
- $(CC) $(CFLAGS) -Wall -municode $< -o $@
-
tools/sock.exe: tools/sock.c
$(CC) $(CFLAGS) -I../inst/include -Wall $< -o $@
diff --git a/src/client.c b/src/client.c
index dcf36c4f..8dad6560 100644
--- a/src/client.c
+++ b/src/client.c
@@ -57,7 +57,7 @@ void processx__stdio_noinherit(BYTE* buffer) {
* does a perfect job.
*/
-SEXP processx_disable_inheritance() {
+SEXP processx_disable_inheritance(void) {
HANDLE handle;
STARTUPINFOW si;
@@ -103,6 +103,8 @@ SEXP processx_write(SEXP fd, SEXP data) {
#include
#include
#include
+#include
+#include
#include
#include
@@ -147,9 +149,19 @@ SEXP processx_disable_inheritance(void) {
SEXP processx_write(SEXP fd, SEXP data) {
int cfd = INTEGER(fd)[0];
+ struct sigaction old_handler, new_handler;
+ memset(&new_handler, 0, sizeof(new_handler));
+ sigemptyset(&new_handler.sa_mask);
+ new_handler.sa_handler = SIG_IGN;
+ sigaction(SIGPIPE, &new_handler, &old_handler );
+
ssize_t ret = write(cfd, RAW(data), LENGTH(data));
+ int err = errno;
+
+ sigaction(SIGPIPE, &old_handler, NULL );
+
if (ret == -1) {
- if (errno == EAGAIN || errno == EWOULDBLOCK) {
+ if (err == EAGAIN || err == EWOULDBLOCK) {
ret = 0;
} else {
R_THROW_SYSTEM_ERROR("Cannot write to fd");
diff --git a/src/create-time.c b/src/create-time.c
index 9839791f..a7b0b654 100644
--- a/src/create-time.c
+++ b/src/create-time.c
@@ -144,7 +144,7 @@ double processx__create_time_since_boot(long pid) {
warning("Cannot parse stat file, parse error: %s", strerror(errno));
return 0.0;
} else if (ret != 20) {
- warning("Cannot parse stat file, unknown parse error.", strerror(errno));
+ warning("Cannot parse stat file, unknown parse error: %s", strerror(errno));
return 0.0;
}
diff --git a/src/errors.c b/src/errors.c
index acb50db7..eafc5912 100644
--- a/src/errors.c
+++ b/src/errors.c
@@ -56,7 +56,7 @@ SEXP r_throw_system_error(const char *func, const char *filename, int line,
va_start(args, msg);
vsnprintf(errorbuf, ERRORBUF_SIZE, msg, args);
va_end(args);
- error("%s (system error %d, %s) @%s:%d (%s)", errorbuf, errorcode,
+ error("%s (system error %ld, %s) @%s:%d (%s)", errorbuf, errorcode,
realsysmsg, filename, line, func);
return R_NilValue;
}
diff --git a/src/init.c b/src/init.c
index a784d8a2..10f4e3b6 100644
--- a/src/init.c
+++ b/src/init.c
@@ -13,9 +13,26 @@ SEXP processx__echo_on(void);
SEXP processx__echo_off(void);
SEXP processx__set_boot_time(SEXP);
+#ifdef GCOV_COMPILE
+
+void __gcov_dump();
+SEXP gcov_flush() {
+ REprintf("Flushing coverage info\n");
+ __gcov_dump();
+ return R_NilValue;
+}
+
+#else
+
+SEXP gcov_flush(void) {
+ return R_NilValue;
+}
+
+#endif
+
static const R_CallMethodDef callMethods[] = {
CLEANCALL_METHOD_RECORD,
- { "processx_exec", (DL_FUNC) &processx_exec, 14 },
+ { "processx_exec", (DL_FUNC) &processx_exec, 15 },
{ "processx_wait", (DL_FUNC) &processx_wait, 3 },
{ "processx_is_alive", (DL_FUNC) &processx_is_alive, 2 },
{ "processx_get_exit_status", (DL_FUNC) &processx_get_exit_status, 2 },
@@ -73,6 +90,8 @@ static const R_CallMethodDef callMethods[] = {
{ "processx__echo_on", (DL_FUNC) &processx__echo_on, 0 },
{ "processx__echo_off", (DL_FUNC) &processx__echo_off, 0 },
+ { "gcov_flush", (DL_FUNC) gcov_flush, 0 },
+
{ NULL, NULL, 0 }
};
diff --git a/src/install.libs.R b/src/install.libs.R
index 20be5d58..357e22c1 100644
--- a/src/install.libs.R
+++ b/src/install.libs.R
@@ -1,10 +1,10 @@
-
progs <- if (WINDOWS) {
- c(file.path("tools", c("px.exe", "pxu.exe", "interrupt.exe", "sock.exe")),
- file.path("supervisor", "supervisor.exe"))
+ c(
+ file.path("tools", c("px.exe", "interrupt.exe", "sock.exe")),
+ file.path("supervisor", "supervisor.exe")
+ )
} else {
- c(file.path("tools", c("px", "sock")),
- file.path("supervisor", "supervisor"))
+ c(file.path("tools", c("px", "sock")), file.path("supervisor", "supervisor"))
}
dest <- file.path(R_PACKAGE_DIR, paste0("bin", R_ARCH))
@@ -18,3 +18,8 @@ file.copy(files, dest, overwrite = TRUE)
if (file.exists("symbols.rds")) {
file.copy("symbols.rds", dest, overwrite = TRUE)
}
+
+test_files <- Sys.glob(paste0("test/*", SHLIB_EXT))
+test_dest <- file.path(dest, "test")
+dir.create(test_dest, recursive = TRUE, showWarnings = FALSE)
+file.copy(test_files, test_dest, overwrite = TRUE)
diff --git a/src/processx-connection.h b/src/processx-connection.h
index d7b3ef98..34b34560 100644
--- a/src/processx-connection.h
+++ b/src/processx-connection.h
@@ -260,7 +260,7 @@ typedef unsigned long DWORD;
/* Threading in Windows */
#ifdef _WIN32
-int processx__start_thread();
+int processx__start_thread(void);
extern HANDLE processx__iocp_thread;
extern HANDLE processx__thread_start;
extern HANDLE processx__thread_done;
@@ -291,7 +291,7 @@ BOOL processx__thread_getstatus_select(LPDWORD lpNumberOfBytes,
PULONG_PTR lpCompletionKey,
LPOVERLAPPED *lpOverlapped,
DWORD dwMilliseconds);
-DWORD processx__thread_get_last_error();
+DWORD processx__thread_get_last_error(void);
#endif
diff --git a/src/processx.h b/src/processx.h
index 9e3d5eee..28272171 100644
--- a/src/processx.h
+++ b/src/processx.h
@@ -45,8 +45,8 @@ extern "C" {
SEXP processx_exec(SEXP command, SEXP args, SEXP pty, SEXP pty_options,
SEXP connections, SEXP env, SEXP windows_verbatim_args,
SEXP windows_hide_window, SEXP windows_detached_process,
- SEXP private_, SEXP cleanup, SEXP wd, SEXP encoding,
- SEXP tree_id);
+ SEXP private_, SEXP cleanup, SEXP cleanup_signal,
+ SEXP wd, SEXP encoding, SEXP tree_id);
SEXP processx_wait(SEXP status, SEXP timeout, SEXP name);
SEXP processx_is_alive(SEXP status, SEXP name);
SEXP processx_get_exit_status(SEXP status, SEXP name);
diff --git a/src/supervisor/windows.c b/src/supervisor/windows.c
index 2164d207..e0955429 100644
--- a/src/supervisor/windows.c
+++ b/src/supervisor/windows.c
@@ -13,7 +13,7 @@
#define MAX(a,b) ((a>b)?a:b)
-int getppid() {
+int getppid(void) {
int pid = GetCurrentProcessId();
HANDLE hProcessSnap = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
@@ -40,7 +40,7 @@ int getppid() {
}
-HANDLE open_stdin() {
+HANDLE open_stdin(void) {
HANDLE h_input = GetStdHandle(STD_INPUT_HANDLE);
if (h_input == INVALID_HANDLE_VALUE) {
diff --git a/src/supervisor/windows.h b/src/supervisor/windows.h
index 9bd5aed1..f487ebe1 100644
--- a/src/supervisor/windows.h
+++ b/src/supervisor/windows.h
@@ -13,8 +13,8 @@
// Functions ------------------------------------------------------------------
-int getppid();
-HANDLE open_stdin();
+int getppid(void);
+HANDLE open_stdin(void);
HANDLE open_named_pipe(const char* pipe_name);
void configure_input_handle(HANDLE h_input);
char* get_line_nonblock(char* buf, int max_chars, HANDLE h_input);
diff --git a/src/test/sigtermignore.c b/src/test/sigtermignore.c
new file mode 100644
index 00000000..b564fbfd
--- /dev/null
+++ b/src/test/sigtermignore.c
@@ -0,0 +1,11 @@
+#ifndef _WIN32
+
+#include
+#include
+#include
+
+void R_init_sigtermignore(DllInfo *dll) {
+ signal(SIGTERM, SIG_IGN);
+}
+
+#endif
diff --git a/src/tools/pxu.c b/src/tools/pxu.c
deleted file mode 100644
index a29412dc..00000000
--- a/src/tools/pxu.c
+++ /dev/null
@@ -1,220 +0,0 @@
-
-#ifndef _GNU_SOURCE
-#define _GNU_SOURCE 1
-#endif
-
-#include
-#include
-#include
-#include
-#include
-#include
-#include
-#include
-
-#include
-
-void usage() {
- fwprintf(stderr, L"Usage: px [command arg] [command arg] ...\n\n");
- fwprintf(stderr, L"Commands:\n");
- fwprintf(stderr, L" sleep -- "
- L"sleep for a number os seconds\n");
- fwprintf(stderr, L" out -- "
- L"print string to stdout\n");
- fwprintf(stderr, L" err -- "
- L"print string to stderr\n");
- fwprintf(stderr, L" outln -- "
- L"print string to stdout, add newline\n");
- fwprintf(stderr, L" errln -- "
- L"print string to stderr, add newline\n");
- fwprintf(stderr, L" errflush -- "
- L"flush stderr stream\n");
- fwprintf(stderr, L" cat -- "
- L"print file to stdout\n");
- fwprintf(stderr, L" return -- "
- L"return with exitcode\n");
- fwprintf(stderr, L" writefile -- "
- L"write to file\n");
- fwprintf(stderr, L" write -- "
- L"write to file descriptor\n");
- fwprintf(stderr, L" echo -- "
- L"echo from fd to another fd\n");
- fwprintf(stderr, L" getenv -- "
- L"environment variable to stdout\n");
-}
-
-void cat2(int f, const wchar_t *s) {
- char buf[8192];
- long n;
-
- while ((n = read(f, buf, (long) sizeof buf)) > 0) {
- if (write(1, buf, n) != n){
- fwprintf(stderr, L"write error copying %ls", s);
- exit(6);
- }
- }
-
- if (n < 0) fwprintf(stderr, L"error reading %ls", s);
-}
-
-void cat(const wchar_t* filename) {
- int f;
- if (!wcscmp(L"", filename)) {
- f = STDIN_FILENO;
- } else {
- f = _wopen(filename, O_RDONLY);
- }
-
- if (f < 0) {
- fwprintf(stderr, L"can't open %ls", filename);
- exit(6);
- }
-
- cat2(f, filename);
- close(f);
-}
-
-int write_to_fd(int fd, const wchar_t *s) {
- size_t len = wcslen(s);
- ssize_t ret = write(fd, s, len * sizeof(wchar_t));
- if (ret != len * sizeof(wchar_t)) {
- fwprintf(stderr, L"Cannot write to fd '%d'\n", fd);
- return 1;
- }
- return 0;
-}
-
-int write_to_fd_simple(int fd, const char *s) {
- size_t len = strlen(s);
- ssize_t ret = write(fd, s, len);
- if (ret != len) {
- fwprintf(stderr, L"Cannot write to fd '%d'\n", fd);
- return 1;
- }
- return 0;
-}
-
-int echo_from_fd(int fd1, int fd2, int nbytes) {
- char buffer[nbytes + 1];
- ssize_t ret;
- buffer[nbytes] = '\0';
- ret = read(fd1, buffer, nbytes);
- if (ret == -1) {
- fwprintf(stderr, L"Cannot read from fd '%d', %s\n", fd1, strerror(errno));
- return 1;
- }
- if (ret != nbytes) {
- fwprintf(stderr, L"Cannot read from fd '%d' (%d bytes)\n", fd1, (int) ret);
- return 1;
- }
- if (write_to_fd_simple(fd2, buffer)) return 1;
- fflush(stdout);
- fflush(stderr);
- return 0;
-}
-
-int wmain(int argc, const wchar_t **argv) {
-
- int num, idx, ret, fd, fd2, nbytes;
- double fnum;
-
- _setmode(_fileno(stdout), _O_U16TEXT);
-
- if (argc == 2 && !wcscmp(L"--help", argv[1])) { usage(); return 0; }
-
- for (idx = 1; idx < argc; idx++) {
- const wchar_t *cmd = argv[idx];
-
- if (idx + 1 == argc) {
- fwprintf(stderr, L"Missing argument for '%ls'\n", argv[idx]);
- return 5;
- }
-
- if (!wcscmp(L"sleep", cmd)) {
- ret = swscanf(argv[++idx], L"%lf", &fnum);
- if (ret != 1) {
- fwprintf(stderr, L"Invalid seconds for px sleep: '%ls'\n", argv[idx]);
- return 3;
- }
- num = (int) fnum;
- sleep(num);
- fnum = fnum - num;
- if (fnum > 0) usleep((useconds_t) (fnum * 1000.0 * 1000.0));
-
- } else if (!wcscmp(L"out", cmd)) {
- wprintf(L"%ls", argv[++idx]);
- fflush(stdout);
-
- } else if (!wcscmp(L"err", cmd)) {
- fwprintf(stderr, L"%ls", argv[++idx]);
-
- } else if (!wcscmp(L"outln", cmd)) {
- wprintf(L"%ls\n", argv[++idx]);
- fflush(stdout);
-
- } else if (!wcscmp(L"errln", cmd)) {
- fwprintf(stderr, L"%ls\n", argv[++idx]);
-
- } else if (!wcscmp(L"errflush", cmd)) {
- fflush(stderr);
-
- } else if (!wcscmp(L"cat", cmd)) {
- cat(argv[++idx]);
-
- } else if (!wcscmp(L"return", cmd)) {
- ret = swscanf(argv[++idx], L"%d", &num);
- if (ret != 1) {
- fwprintf(stderr, L"Invalid exit code for px return: '%ls'\n", argv[idx]);
- return 4;
- }
- return num;
-
- } else if (!wcscmp(L"writefile", cmd)) {
- if (idx + 2 >= argc) {
- fwprintf(stderr, L"Missing argument(s) for 'writefile'\n");
- return 5;
- }
- int fd = _wopen(argv[++idx], _O_WRONLY | _O_CREAT | _O_BINARY);
- if (fd == -1) return 5;
- if (write_to_fd(fd, argv[++idx])) { close(fd); return 5; }
- close(fd);
-
- } else if (!wcscmp(L"write", cmd)) {
- if (idx + 2 >= argc) {
- fwprintf(stderr, L"Missing argument(s) for 'write'\n");
- return 6;
- }
- ret = swscanf(argv[++idx], L"%d", &fd);
- if (ret != 1) {
- fwprintf(stderr, L"Invalid fd for write: '%ls'\n", argv[idx]);
- return 7;
- }
- if (write_to_fd(fd, argv[++idx])) return 7;
-
- } else if (!wcscmp(L"echo", cmd)) {
- if (idx + 3 >= argc) {
- fwprintf(stderr, L"Missing argument(s) for 'read'\n");
- return 8;
- }
- ret = swscanf(argv[++idx], L"%d", &fd);
- ret = ret + swscanf(argv[++idx], L"%d", &fd2);
- ret = ret + swscanf(argv[++idx], L"%d", &nbytes);
- if (ret != 3) {
- fwprintf(stderr, L"Invalid fd1, fd2 or nbytes for read: '%ls', '%ls', '%ls'\n",
- argv[idx-2], argv[idx-1], argv[idx]);
- return 9;
- }
- if (echo_from_fd(fd, fd2, nbytes)) return 10;
-
- } else if (!wcscmp(L"getenv", cmd)) {
- wprintf(L"%ls\n", _wgetenv(argv[++idx]));
- fflush(stdout);
-
- } else {
- fwprintf(stderr, L"Unknown px command: '%ls'\n", cmd);
- return 2;
- }
- }
-
- return 0;
-}
diff --git a/src/unix/processx-unix.h b/src/unix/processx-unix.h
index f9bbe675..fa481051 100644
--- a/src/unix/processx-unix.h
+++ b/src/unix/processx-unix.h
@@ -23,6 +23,8 @@ typedef struct processx_handle_s {
int fd2; /* readable */
int waitpipe[2]; /* use it for wait() with timeout */
int cleanup;
+ int cleanup_signal;
+ double cleanup_grace;
double create_time;
processx_connection_t *pipes[3];
int ptyfd;
@@ -36,7 +38,12 @@ void processx__sigchld_callback(int sig, siginfo_t *info, void *ctx);
void processx__setup_sigchld(void);
void processx__remove_sigchld(void);
void processx__block_sigchld(void);
+void processx__block_sigchld_save(sigset_t *old);
void processx__unblock_sigchld(void);
+void processx__procmask_set(sigset_t *set);
+
+int c_processx_wait(processx_handle_t *handle, int timeout, const char *name);
+int c_processx_kill(SEXP status, double grace, SEXP name);
void processx__finalizer(SEXP status);
diff --git a/src/unix/processx.c b/src/unix/processx.c
index a188f6ec..cb8df2b3 100644
--- a/src/unix/processx.c
+++ b/src/unix/processx.c
@@ -21,7 +21,7 @@ static void processx__child_init(processx_handle_t *handle, SEXP connections,
processx_options_t *options,
const char *tree_id);
-static SEXP processx__make_handle(SEXP private, int cleanup);
+static SEXP processx__make_handle(SEXP private, int cleanup, double cleanup_grace);
static void processx__handle_destroy(processx_handle_t *handle);
void processx__create_connections(processx_handle_t *handle, SEXP private,
const char *encoding);
@@ -324,38 +324,38 @@ static void processx__child_init(processx_handle_t *handle, SEXP connections,
/* LCOV_EXCL_STOP */
+struct cleanup_kill_data {
+ SEXP status;
+ double grace;
+ SEXP name;
+};
+
+SEXP c_processx_kill_data(void *payload) {
+ struct cleanup_kill_data *data = (struct cleanup_kill_data *) payload;
+ c_processx_kill(data->status, data->grace, data->name);
+ return R_NilValue;
+}
+
void processx__finalizer(SEXP status) {
processx_handle_t *handle = (processx_handle_t*) R_ExternalPtrAddr(status);
- pid_t pid;
- int wp, wstat;
-
- processx__block_sigchld();
/* Free child list nodes that are not needed any more. */
+ processx__block_sigchld();
processx__freelist_free();
+ processx__unblock_sigchld();
/* Already freed? */
- if (!handle) goto cleanup;
-
- pid = handle->pid;
+ if (!handle)
+ return;
+ // FIXME: Do we need cleancall here?
if (handle->cleanup) {
- /* Do a non-blocking waitpid() to see if it is running */
- do {
- wp = waitpid(pid, &wstat, WNOHANG);
- } while (wp == -1 && errno == EINTR);
-
- /* Maybe just waited on it? Then collect status */
- if (wp == pid) processx__collect_exit_status(status, wp, wstat);
-
- /* If it is running, we need to kill it, and wait for the exit status */
- if (wp == 0) {
- kill(-pid, SIGKILL);
- do {
- wp = waitpid(pid, &wstat, 0);
- } while (wp == -1 && errno == EINTR);
- processx__collect_exit_status(status, wp, wstat);
- }
+ struct cleanup_kill_data data = {
+ .status = status,
+ .grace = handle->cleanup_grace,
+ .name = R_NilValue
+ };
+ r_with_cleanup_context(c_processx_kill_data, &data);
}
/* Note: if no cleanup is requested, then we still have a sigchld
@@ -365,12 +365,9 @@ void processx__finalizer(SEXP status) {
/* Deallocate memory */
R_ClearExternalPtr(status);
processx__handle_destroy(handle);
-
- cleanup:
- processx__unblock_sigchld();
}
-static SEXP processx__make_handle(SEXP private, int cleanup) {
+static SEXP processx__make_handle(SEXP private, int cleanup, double cleanup_grace) {
processx_handle_t * handle;
SEXP result;
@@ -382,6 +379,7 @@ static SEXP processx__make_handle(SEXP private, int cleanup) {
result = PROTECT(R_MakeExternalPtr(handle, private, R_NilValue));
R_RegisterCFinalizerEx(result, processx__finalizer, 1);
handle->cleanup = cleanup;
+ handle->cleanup_grace = cleanup_grace;
UNPROTECT(1);
return result;
@@ -428,13 +426,14 @@ void processx__make_socketpair(int pipe[2], const char *exe) {
SEXP processx_exec(SEXP command, SEXP args, SEXP pty, SEXP pty_options,
SEXP connections, SEXP env, SEXP windows_verbatim_args,
SEXP windows_hide_window, SEXP windows_detached_process,
- SEXP private, SEXP cleanup, SEXP wd, SEXP encoding,
- SEXP tree_id) {
+ SEXP private, SEXP cleanup, SEXP cleanup_grace, SEXP wd,
+ SEXP encoding, SEXP tree_id) {
char *ccommand = processx__tmp_string(command, 0);
char **cargs = processx__tmp_character(args);
char **cenv = isNull(env) ? 0 : processx__tmp_character(env);
int ccleanup = INTEGER(cleanup)[0];
+ double ccleanup_grace = REAL(cleanup_grace)[0];
const int cpty = LOGICAL(pty)[0];
const char *cencoding = CHAR(STRING_ELT(encoding, 0));
@@ -469,7 +468,7 @@ SEXP processx_exec(SEXP command, SEXP args, SEXP pty, SEXP pty_options,
processx__setup_sigchld();
- result = PROTECT(processx__make_handle(private, ccleanup));
+ result = PROTECT(processx__make_handle(private, ccleanup, ccleanup_grace));
handle = R_ExternalPtrAddr(result);
if (cpty) {
@@ -674,30 +673,38 @@ static void processx__wait_cleanup(void *ptr) {
SEXP processx_wait(SEXP status, SEXP timeout, SEXP name) {
processx_handle_t *handle = R_ExternalPtrAddr(status);
+ int ctimeout = INTEGER(timeout)[0];
const char *cname = isNull(name) ? "???" : CHAR(STRING_ELT(name, 0));
- int ctimeout = INTEGER(timeout)[0], timeleft = ctimeout;
+
+ int ret = c_processx_wait(handle, ctimeout, cname);
+ return ScalarLogical(ret);
+}
+
+int c_processx_wait(processx_handle_t *handle, int timeout, const char *name) {
struct pollfd fd;
int ret = 0;
pid_t pid;
+ int timeleft = timeout;
int *fds = malloc(sizeof(int) * 2);
if (!fds) R_THROW_SYSTEM_ERROR("Allocating memory when waiting");
fds[0] = fds[1] = -1;
r_call_on_exit(processx__wait_cleanup, fds);
- processx__block_sigchld();
+ sigset_t old;
+ processx__block_sigchld_save(&old);
if (!handle) {
- processx__unblock_sigchld();
- return ScalarLogical(1);
+ processx__procmask_set(&old);
+ return 1;
}
pid = handle->pid;
/* If we already have the status, then return now. */
if (handle->collected) {
- processx__unblock_sigchld();
- return ScalarLogical(1);
+ processx__procmask_set(&old);
+ return 1;
}
/* Make sure this is active, in case another package replaced it... */
@@ -706,8 +713,8 @@ SEXP processx_wait(SEXP status, SEXP timeout, SEXP name) {
/* Setup the self-pipe that we can poll */
if (pipe(handle->waitpipe)) {
- processx__unblock_sigchld();
- R_THROW_SYSTEM_ERROR("processx error when waiting for '%s'", cname);
+ processx__procmask_set(&old);
+ R_THROW_SYSTEM_ERROR("processx error when waiting for '%s'", name);
}
fds[0] = handle->waitpipe[0];
fds[1] = handle->waitpipe[1];
@@ -723,7 +730,7 @@ SEXP processx_wait(SEXP status, SEXP timeout, SEXP name) {
- while (ctimeout < 0 || timeleft > PROCESSX_INTERRUPT_INTERVAL) {
+ while (timeout < 0 || timeleft > PROCESSX_INTERRUPT_INTERVAL) {
do {
ret = poll(&fd, 1, PROCESSX_INTERRUPT_INTERVAL);
} while (ret == -1 && errno == EINTR);
@@ -743,7 +750,7 @@ SEXP processx_wait(SEXP status, SEXP timeout, SEXP name) {
goto cleanup;
}
- if (ctimeout >= 0) timeleft -= PROCESSX_INTERRUPT_INTERVAL;
+ if (timeout >= 0) timeleft -= PROCESSX_INTERRUPT_INTERVAL;
}
/* Maybe we are not done, and there is a little left from the timeout */
@@ -755,7 +762,7 @@ SEXP processx_wait(SEXP status, SEXP timeout, SEXP name) {
if (ret == -1) {
R_THROW_SYSTEM_ERROR("processx wait with timeout error while "
- "waiting for '%s'", cname);
+ "waiting for '%s'", name);
}
cleanup:
@@ -763,7 +770,9 @@ SEXP processx_wait(SEXP status, SEXP timeout, SEXP name) {
handle->waitpipe[0] = -1;
handle->waitpipe[1] = -1;
- return ScalarLogical(ret != 0);
+ processx__procmask_set(&old);
+
+ return ret != 0;
}
/* This is similar to `processx_wait`, but a bit simpler, because we
@@ -963,6 +972,10 @@ SEXP processx_interrupt(SEXP status, SEXP name) {
*/
SEXP processx_kill(SEXP status, SEXP grace, SEXP name) {
+ return ScalarLogical(c_processx_kill(status, REAL(grace)[0], name));
+}
+
+int c_processx_kill(SEXP status, double grace, SEXP name) {
processx_handle_t *handle = R_ExternalPtrAddr(status);
const char *cname = isNull(name) ? "???" : CHAR(STRING_ELT(name, 0));
pid_t pid;
@@ -997,14 +1010,29 @@ SEXP processx_kill(SEXP status, SEXP grace, SEXP name) {
/* If the process is not running, return (FALSE) */
if (wp != 0) { goto cleanup; }
- /* It is still running, so a SIGKILL */
- int ret = kill(-pid, SIGKILL);
- if (ret == -1 && (errno == ESRCH || errno == EPERM)) { goto cleanup; }
- if (ret == -1) {
- processx__unblock_sigchld();
- R_THROW_SYSTEM_ERROR("process_kill for '%s'", cname);
+ /* It is still running, send a SIGTERM if gracious */
+ double grace_ms = grace * 1000;
+
+#define KILL_WITH(SIG) do { \
+ int ret = kill(-pid, SIG); \
+ if (ret == -1 && (errno == ESRCH || errno == EPERM)) { goto cleanup; } \
+ if (ret == -1) { \
+ processx__unblock_sigchld(); \
+ R_THROW_SYSTEM_ERROR("process_kill for '%s'", cname); \
+ } \
+} while(0)
+
+ if (grace_ms) {
+ KILL_WITH(SIGTERM);
+ if (c_processx_wait(handle, grace_ms, cname)) {
+ result = handle->exitcode == -SIGTERM;
+ goto cleanup;
+ }
}
+ /* It is still running, send a SIGKILL */
+ KILL_WITH(SIGKILL);
+
/* Do a waitpid to collect the status and reap the zombie */
do {
wp = waitpid(pid, &wstat, 0);
@@ -1020,7 +1048,7 @@ SEXP processx_kill(SEXP status, SEXP grace, SEXP name) {
cleanup:
processx__unblock_sigchld();
- return ScalarLogical(result);
+ return result;
}
SEXP processx_get_pid(SEXP status) {
diff --git a/src/unix/sigchld.c b/src/unix/sigchld.c
index cad171bb..5b53e66b 100644
--- a/src/unix/sigchld.c
+++ b/src/unix/sigchld.c
@@ -128,15 +128,26 @@ void processx__remove_sigchld(void) {
memset(&old_sig_handler, 0, sizeof(old_sig_handler));
}
-void processx__block_sigchld(void) {
+void processx__block_sigchld_save(sigset_t *old) {
sigset_t blockMask;
sigemptyset(&blockMask);
sigaddset(&blockMask, SIGCHLD);
- if (sigprocmask(SIG_BLOCK, &blockMask, NULL) == -1) {
+
+ if (sigprocmask(SIG_BLOCK, &blockMask, old) == -1) {
R_THROW_ERROR("processx error setting up signal handlers");
}
}
+void processx__procmask_set(sigset_t *set) {
+ if (sigprocmask(SIG_SETMASK, set, NULL) == -1) {
+ R_THROW_ERROR("processx error setting up signal handlers");
+ }
+}
+
+void processx__block_sigchld(void) {
+ processx__block_sigchld_save(NULL);
+}
+
void processx__unblock_sigchld(void) {
sigset_t unblockMask;
sigemptyset(&unblockMask);
diff --git a/src/win/processx.c b/src/win/processx.c
index 20010e4e..1b5259a4 100644
--- a/src/win/processx.c
+++ b/src/win/processx.c
@@ -51,11 +51,11 @@ static void processx__init_global_job_handle(void) {
}
}
-void R_init_processx_win() {
+void R_init_processx_win(void) {
/* Nothing to do currently */
}
-SEXP processx__unload_cleanup() {
+SEXP processx__unload_cleanup(void) {
if (processx__connection_iocp) CloseHandle(processx__connection_iocp);
if (processx__iocp_thread) TerminateThread(processx__iocp_thread, 0);
@@ -868,8 +868,8 @@ void processx__handle_destroy(processx_handle_t *handle) {
SEXP processx_exec(SEXP command, SEXP args, SEXP pty, SEXP pty_options,
SEXP connections, SEXP env, SEXP windows_verbatim_args,
SEXP windows_hide, SEXP windows_detached_process,
- SEXP private, SEXP cleanup, SEXP wd, SEXP encoding,
- SEXP tree_id) {
+ SEXP private, SEXP cleanup, SEXP _cleanup_grace, SEXP wd,
+ SEXP encoding, SEXP tree_id) {
const char *ccommand = CHAR(STRING_ELT(command, 0));
const char *cencoding = CHAR(STRING_ELT(encoding, 0));
diff --git a/src/win/stdio.c b/src/win/stdio.c
index 302fcf0c..c208859c 100644
--- a/src/win/stdio.c
+++ b/src/win/stdio.c
@@ -91,11 +91,12 @@ static int processx__create_output_handle(HANDLE *handle_ptr, const char *file,
}
static void processx__unique_pipe_name(char* ptr, char* name, size_t size) {
- int r;
- GetRNGstate();
- r = (int)(unif_rand() * 65000);
- snprintf(name, size, "\\\\?\\pipe\\px\\%p-%lu", ptr + r, GetCurrentProcessId());
- PutRNGstate();
+ // we'll retry with a larger number if it already exists
+ static int cntr = 0;
+ snprintf(
+ name, size, "\\\\?\\pipe\\px\\%p-%lu", ptr + cntr++,
+ GetCurrentProcessId()
+ );
}
int processx__create_pipe(void *id, HANDLE* parent_pipe_ptr,
diff --git a/src/win/thread.c b/src/win/thread.c
index 0d7c2782..9370a6ee 100644
--- a/src/win/thread.c
+++ b/src/win/thread.c
@@ -3,7 +3,7 @@
HANDLE processx__connection_iocp = NULL;
-HANDLE processx__get_default_iocp() {
+HANDLE processx__get_default_iocp(void) {
if (! processx__connection_iocp) {
processx__connection_iocp = CreateIoCompletionPort(
/* FileHandle = */ INVALID_HANDLE_VALUE,
@@ -44,7 +44,7 @@ struct processx__thread_getstatus_data {
ULONG_PTR processx__key_none = 1;
-DWORD processx_i_thread_readfile() {
+DWORD processx_i_thread_readfile(void) {
processx_connection_t *ccon = processx__thread_readfile_data.ccon;
@@ -86,7 +86,7 @@ DWORD processx_i_thread_readfile() {
return res;
}
-DWORD processx_i_thread_connectpipe() {
+DWORD processx_i_thread_connectpipe(void) {
processx_connection_t *ccon = processx__thread_readfile_data.ccon;
@@ -125,7 +125,7 @@ DWORD processx_i_thread_connectpipe() {
return res;
}
-DWORD processx_i_thread_getstatus() {
+DWORD processx_i_thread_getstatus(void) {
static const char *ok_buf = "OK";
HANDLE iocp = processx__get_default_iocp();
if (!iocp) return FALSE;
@@ -185,7 +185,7 @@ DWORD processx__thread_callback(void *data) {
return 0;
}
-int processx__start_thread() {
+int processx__start_thread(void) {
if (processx__iocp_thread != NULL) return 0;
DWORD threadid;
@@ -317,6 +317,6 @@ BOOL processx__thread_getstatus_select(LPDWORD lpNumberOfBytes,
return processx__thread_success;
}
-DWORD processx__thread_get_last_error() {
+DWORD processx__thread_get_last_error(void) {
return processx__thread_last_error;
}
diff --git a/src/win/utils.c b/src/win/utils.c
index b0708d1e..630fdfa1 100644
--- a/src/win/utils.c
+++ b/src/win/utils.c
@@ -1,17 +1,17 @@
#include "../processx.h"
-SEXP processx_disable_crash_dialog() {
+SEXP processx_disable_crash_dialog(void) {
/* TODO */
return R_NilValue;
}
-SEXP processx__echo_on() {
+SEXP processx__echo_on(void) {
R_THROW_ERROR("Only implemented on Unix");
return R_NilValue;
}
-SEXP processx__echo_off() {
+SEXP processx__echo_off(void) {
R_THROW_ERROR("Only implemented on Unix");
return R_NilValue;
}
diff --git a/tests/testthat.R b/tests/testthat.R
index ea473876..ec759cb7 100644
--- a/tests/testthat.R
+++ b/tests/testthat.R
@@ -1,3 +1,11 @@
+# This file is part of the standard setup for testthat.
+# It is recommended that you do not modify it.
+#
+# Where should you do additional test configuration?
+# Learn more about the roles of various files in:
+# * https://r-pkgs.org/testing-design.html#sec-tests-files-overview
+# * https://testthat.r-lib.org/articles/special-files.html
+
library(testthat)
library(processx)
diff --git a/tests/testthat/_snaps/Darwin/process.md b/tests/testthat/_snaps/Darwin/process.md
new file mode 100644
index 00000000..77686ef5
--- /dev/null
+++ b/tests/testthat/_snaps/Darwin/process.md
@@ -0,0 +1,20 @@
+# non existing process
+
+ Code
+ process$new(tempfile())
+ Condition
+ Error:
+ ! Native call to `processx_exec` failed
+ Caused by error:
+ ! cannot start processx process '/' (system error 2, No such file or directory) @unix/processx.c:612 (processx_exec)
+
+# working directory does not exist
+
+ Code
+ process$new(px, wd = tempfile())
+ Condition
+ Error:
+ ! Native call to `processx_exec` failed
+ Caused by error:
+ ! cannot start processx process '/px' (system error 2, No such file or directory) @unix/processx.c:612 (processx_exec)
+
diff --git a/tests/testthat/_snaps/Darwin/run.md b/tests/testthat/_snaps/Darwin/run.md
new file mode 100644
index 00000000..1e22fc2f
--- /dev/null
+++ b/tests/testthat/_snaps/Darwin/run.md
@@ -0,0 +1,10 @@
+# working directory does not exist
+
+ Code
+ run(px, wd = tempfile())
+ Condition
+ Error:
+ ! Native call to `processx_exec` failed
+ Caused by error:
+ ! cannot start processx process '/px' (system error 2, No such file or directory) @unix/processx.c:612 (processx_exec)
+
diff --git a/tests/testthat/_snaps/Darwin/unix-sockets.md b/tests/testthat/_snaps/Darwin/unix-sockets.md
new file mode 100644
index 00000000..bbb8fdf2
--- /dev/null
+++ b/tests/testthat/_snaps/Darwin/unix-sockets.md
@@ -0,0 +1,34 @@
+# reading unaccepted server socket is error
+
+ Code
+ conn_read_chars(sock1)
+ Condition
+ Error:
+ ! Native call to `processx_connection_read_chars` failed
+ Caused by error:
+ ! Cannot read from processx connection (system error 57, Socket is not connected) @processx-connection.c:1828 (processx__connection_read)
+
+# errors
+
+ Code
+ conn_create_unix_socket(sock)
+ Condition
+ Error:
+ ! Native call to `processx_connection_create_socket` failed
+ Caused by error:
+ ! Server socket path too long: /
+ Code
+ conn_create_unix_socket("/dev/null")
+ Condition
+ Error:
+ ! Native call to `processx_connection_create_socket` failed
+ Caused by error:
+ ! Cannot bind to socket (system error 48, Address already in use) @processx-connection.c:442 (processx_connection_create_socket)
+ Code
+ conn_connect_unix_socket("/dev/null")
+ Condition
+ Error:
+ ! Native call to `processx_connection_connect_socket` failed
+ Caused by error:
+ ! Cannot connect to socket (system error 38, Socket operation on non-socket) @processx-connection.c:513 (processx_connection_connect_socket)
+
diff --git a/tests/testthat/_snaps/Linux/process.md b/tests/testthat/_snaps/Linux/process.md
new file mode 100644
index 00000000..1477629c
--- /dev/null
+++ b/tests/testthat/_snaps/Linux/process.md
@@ -0,0 +1,20 @@
+# non existing process
+
+ Code
+ process$new(tempfile())
+ Condition
+ Error:
+ ! Native call to `processx_exec` failed
+ Caused by error:
+ ! cannot start processx process '/' (system error 2, No such file or directory) @unix/processx.c:610 (processx_exec)
+
+# working directory does not exist
+
+ Code
+ process$new(px, wd = tempfile())
+ Condition
+ Error:
+ ! Native call to `processx_exec` failed
+ Caused by error:
+ ! cannot start processx process '/px' (system error 2, No such file or directory) @unix/processx.c:610 (processx_exec)
+
diff --git a/tests/testthat/_snaps/Linux/run.md b/tests/testthat/_snaps/Linux/run.md
new file mode 100644
index 00000000..d828f68c
--- /dev/null
+++ b/tests/testthat/_snaps/Linux/run.md
@@ -0,0 +1,10 @@
+# working directory does not exist
+
+ Code
+ run(px, wd = tempfile())
+ Condition
+ Error:
+ ! Native call to `processx_exec` failed
+ Caused by error:
+ ! cannot start processx process '/px' (system error 2, No such file or directory) @unix/processx.c:610 (processx_exec)
+
diff --git a/tests/testthat/_snaps/Linux/unix-sockets.md b/tests/testthat/_snaps/Linux/unix-sockets.md
new file mode 100644
index 00000000..f738d39e
--- /dev/null
+++ b/tests/testthat/_snaps/Linux/unix-sockets.md
@@ -0,0 +1,34 @@
+# reading unaccepted server socket is error
+
+ Code
+ conn_read_chars(sock1)
+ Condition
+ Error:
+ ! Native call to `processx_connection_read_chars` failed
+ Caused by error:
+ ! Cannot read from processx connection (system error 22, Invalid argument) @processx-connection.c:1828 (processx__connection_read)
+
+# errors
+
+ Code
+ conn_create_unix_socket(sock)
+ Condition
+ Error:
+ ! Native call to `processx_connection_create_socket` failed
+ Caused by error:
+ ! Server socket path too long: /
+ Code
+ conn_create_unix_socket("/dev/null")
+ Condition
+ Error:
+ ! Native call to `processx_connection_create_socket` failed
+ Caused by error:
+ ! Cannot bind to socket (system error 98, Address already in use) @processx-connection.c:442 (processx_connection_create_socket)
+ Code
+ conn_connect_unix_socket("/dev/null")
+ Condition
+ Error:
+ ! Native call to `processx_connection_connect_socket` failed
+ Caused by error:
+ ! Cannot connect to socket (system error 111, Connection refused) @processx-connection.c:513 (processx_connection_connect_socket)
+
diff --git a/tests/testthat/_snaps/Windows/process.md b/tests/testthat/_snaps/Windows/process.md
new file mode 100644
index 00000000..3067b32c
--- /dev/null
+++ b/tests/testthat/_snaps/Windows/process.md
@@ -0,0 +1,21 @@
+# non existing process
+
+ Code
+ process$new(tempfile())
+ Condition
+ Error:
+ ! Native call to `processx_exec` failed
+ Caused by error:
+ ! Command '/' not found @win/processx.c:982 (processx_exec)
+
+# working directory does not exist
+
+ Code
+ process$new(px, wd = tempfile())
+ Condition
+ Error:
+ ! Native call to `processx_exec` failed
+ Caused by error:
+ ! create process '/px' (system error 267, The directory name is invalid.
+ ) @win/processx.c:1040 (processx_exec)
+
diff --git a/tests/testthat/_snaps/Windows/run.md b/tests/testthat/_snaps/Windows/run.md
new file mode 100644
index 00000000..baf78e96
--- /dev/null
+++ b/tests/testthat/_snaps/Windows/run.md
@@ -0,0 +1,11 @@
+# working directory does not exist
+
+ Code
+ run(px, wd = tempfile())
+ Condition
+ Error:
+ ! Native call to `processx_exec` failed
+ Caused by error:
+ ! create process '/px' (system error 267, The directory name is invalid.
+ ) @win/processx.c:1040 (processx_exec)
+
diff --git a/tests/testthat/_snaps/Windows/unix-sockets.md b/tests/testthat/_snaps/Windows/unix-sockets.md
new file mode 100644
index 00000000..24243ebc
--- /dev/null
+++ b/tests/testthat/_snaps/Windows/unix-sockets.md
@@ -0,0 +1,10 @@
+# reading unaccepted server socket is error
+
+ Code
+ conn_read_chars(sock1)
+ Condition
+ Error:
+ ! Native call to `processx_connection_read_chars` failed
+ Caused by error:
+ ! Cannot read from an un-accepted socket connection @processx-connection.c:1731 (processx__connection_read)
+
diff --git a/tests/testthat/_snaps/assertions.md b/tests/testthat/_snaps/assertions.md
new file mode 100644
index 00000000..7730a649
--- /dev/null
+++ b/tests/testthat/_snaps/assertions.md
@@ -0,0 +1,352 @@
+# is_string
+
+ Code
+ assert_that(is_string(n))
+ Condition
+ Error:
+ ! n is not a string (length 1 character)
+
+---
+
+ Code
+ assert_that(is_string(n))
+ Condition
+ Error:
+ ! n is not a string (length 1 character)
+
+---
+
+ Code
+ assert_that(is_string(n))
+ Condition
+ Error:
+ ! n is not a string (length 1 character)
+
+---
+
+ Code
+ assert_that(is_string(n))
+ Condition
+ Error:
+ ! n is not a string (length 1 character)
+
+---
+
+ Code
+ assert_that(is_string(n))
+ Condition
+ Error:
+ ! n is not a string (length 1 character)
+
+---
+
+ Code
+ assert_that(is_string(n))
+ Condition
+ Error:
+ ! n is not a string (length 1 character)
+
+---
+
+ Code
+ assert_that(is_string(n))
+ Condition
+ Error:
+ ! n is not a string (length 1 character)
+
+# is_string_or_null
+
+ Code
+ assert_that(is_string_or_null(n))
+ Condition
+ Error:
+ ! n must be a string (length 1 character) or NULL
+
+---
+
+ Code
+ assert_that(is_string_or_null(n))
+ Condition
+ Error:
+ ! n must be a string (length 1 character) or NULL
+
+---
+
+ Code
+ assert_that(is_string_or_null(n))
+ Condition
+ Error:
+ ! n must be a string (length 1 character) or NULL
+
+---
+
+ Code
+ assert_that(is_string_or_null(n))
+ Condition
+ Error:
+ ! n must be a string (length 1 character) or NULL
+
+---
+
+ Code
+ assert_that(is_string_or_null(n))
+ Condition
+ Error:
+ ! n must be a string (length 1 character) or NULL
+
+---
+
+ Code
+ assert_that(is_string_or_null(n))
+ Condition
+ Error:
+ ! n must be a string (length 1 character) or NULL
+
+# is_flag
+
+ Code
+ assert_that(is_flag(n))
+ Condition
+ Error:
+ ! n is not a flag (length 1 logical)
+
+---
+
+ Code
+ assert_that(is_flag(n))
+ Condition
+ Error:
+ ! n is not a flag (length 1 logical)
+
+---
+
+ Code
+ assert_that(is_flag(n))
+ Condition
+ Error:
+ ! n is not a flag (length 1 logical)
+
+---
+
+ Code
+ assert_that(is_flag(n))
+ Condition
+ Error:
+ ! n is not a flag (length 1 logical)
+
+---
+
+ Code
+ assert_that(is_flag(n))
+ Condition
+ Error:
+ ! n is not a flag (length 1 logical)
+
+---
+
+ Code
+ assert_that(is_flag(n))
+ Condition
+ Error:
+ ! n is not a flag (length 1 logical)
+
+---
+
+ Code
+ assert_that(is_flag(n))
+ Condition
+ Error:
+ ! n is not a flag (length 1 logical)
+
+# is_integerish_scalar
+
+ Code
+ assert_that(is_integerish_scalar(n))
+ Condition
+ Error:
+ ! n is not a length 1 integer
+
+---
+
+ Code
+ assert_that(is_integerish_scalar(n))
+ Condition
+ Error:
+ ! n is not a length 1 integer
+
+---
+
+ Code
+ assert_that(is_integerish_scalar(n))
+ Condition
+ Error:
+ ! n is not a length 1 integer
+
+---
+
+ Code
+ assert_that(is_integerish_scalar(n))
+ Condition
+ Error:
+ ! n is not a length 1 integer
+
+---
+
+ Code
+ assert_that(is_integerish_scalar(n))
+ Condition
+ Error:
+ ! n is not a length 1 integer
+
+---
+
+ Code
+ assert_that(is_integerish_scalar(n))
+ Condition
+ Error:
+ ! n is not a length 1 integer
+
+---
+
+ Code
+ assert_that(is_integerish_scalar(n))
+ Condition
+ Error:
+ ! n is not a length 1 integer
+
+---
+
+ Code
+ assert_that(is_integerish_scalar(n))
+ Condition
+ Error:
+ ! n is not a length 1 integer
+
+# is_pid
+
+ Code
+ assert_that(is_pid(n))
+ Condition
+ Error:
+ ! n is not a process id (length 1 integer)
+
+---
+
+ Code
+ assert_that(is_pid(n))
+ Condition
+ Error:
+ ! n is not a process id (length 1 integer)
+
+---
+
+ Code
+ assert_that(is_pid(n))
+ Condition
+ Error:
+ ! n is not a process id (length 1 integer)
+
+---
+
+ Code
+ assert_that(is_pid(n))
+ Condition
+ Error:
+ ! n is not a process id (length 1 integer)
+
+---
+
+ Code
+ assert_that(is_pid(n))
+ Condition
+ Error:
+ ! n is not a process id (length 1 integer)
+
+---
+
+ Code
+ assert_that(is_pid(n))
+ Condition
+ Error:
+ ! n is not a process id (length 1 integer)
+
+---
+
+ Code
+ assert_that(is_pid(n))
+ Condition
+ Error:
+ ! n is not a process id (length 1 integer)
+
+---
+
+ Code
+ assert_that(is_pid(n))
+ Condition
+ Error:
+ ! n is not a process id (length 1 integer)
+
+# is_flag_or_string
+
+ Code
+ assert_that(is_flag_or_string(n))
+ Condition
+ Error:
+ ! n is not a flag or a string
+
+---
+
+ Code
+ assert_that(is_flag_or_string(n))
+ Condition
+ Error:
+ ! n is not a flag or a string
+
+---
+
+ Code
+ assert_that(is_flag_or_string(n))
+ Condition
+ Error:
+ ! n is not a flag or a string
+
+---
+
+ Code
+ assert_that(is_flag_or_string(n))
+ Condition
+ Error:
+ ! n is not a flag or a string
+
+---
+
+ Code
+ assert_that(is_flag_or_string(n))
+ Condition
+ Error:
+ ! n is not a flag or a string
+
+---
+
+ Code
+ assert_that(is_flag_or_string(n))
+ Condition
+ Error:
+ ! n is not a flag or a string
+
+---
+
+ Code
+ assert_that(is_flag_or_string(n))
+ Condition
+ Error:
+ ! n is not a flag or a string
+
+# is_existing_file
+
+ Code
+ assert_that(is_existing_file(tempfile()))
+ Condition
+ Error:
+ ! File tempfile() does not exist
+
diff --git a/tests/testthat/_snaps/err-output.md b/tests/testthat/_snaps/err-output.md
index 32890a03..a32049c0 100644
--- a/tests/testthat/_snaps/err-output.md
+++ b/tests/testthat/_snaps/err-output.md
@@ -50,32 +50,6 @@
! This failed
Type .Last.error to see the more details.
-# simple error with cli and colors
-
- Code
- cat(out$stderr)
- Output
- [1m[33mError[39m[22m in `f()`[90m at script.R:5:5[39m:
- [33m![39m This failed
- ---
- Backtrace:
- [90m1. [39mbase::[36msource[39m[33m("script.R")[39m
- [90m2. | base::withVisible(eval(ei, envir))[39m
- [90m3. | base::eval(ei, envir)[39m
- [90m4. | base::eval(ei, envir)[39m
- [90m5. [39mglobal [36mf[39m[33m()[39m[90m at script.R:5:5[39m
- [90m6. [39mprocessx:::[36mthrow[39m[33m("This failed")[39m[90m at script.R:4:10[39m
- Execution halted
-
----
-
- Code
- cat(out$stdout)
- Output
- [1m[33mError[39m[22m in `f()`[90m at script.R:6:5[39m:
- [33m![39m This failed
- [90mType .Last.error to see the more details.[39m
-
# chain_error
Code
@@ -161,42 +135,6 @@
21. | processx:::throw_error(err, parent = e)
Execution halted
----
-
- Code
- cat(out$stderr)
- Output
- [1m[33mError[39m[22m in `do()`[90m at script.R:19:14[39m:
- [33m![39m Failed to base64 encode
- [1mCaused by error[22m in `do2()`[90m at script.R:15:13[39m:
- [33m![39m something is wrong here
- [1mCaused by error[22m in `do3()`[90m at script.R:12:13[39m:
- [33m![39m because of this
- ---
- Backtrace:
- [90m 1. [39mbase::[36msource[39m[33m("script.R")[39m
- [90m 2. | base::withVisible(eval(ei, envir))[39m
- [90m 3. | base::eval(ei, envir)[39m
- [90m 4. | base::eval(ei, envir)[39m
- [90m 5. [39mglobal [36mf[39m[33m()[39m[90m at script.R:20:9[39m
- [90m 6. [39mglobal [36mg[39m[33m()[39m[90m at script.R:17:14[39m
- [90m 7. [39mglobal [36mh[39m[33m()[39m[90m at script.R:18:14[39m
- [90m 8. [39mglobal [36mdo[39m[33m()[39m[90m at script.R:19:14[39m
- [90m 9. [39mprocessx:::[36mchain_error[39m[33m([39m[36mdo2[39m[34m()[39m, [33m"Failed to base64 encode")[39m[90m at script.R:15:13[39m
- [90m10. | base::withCallingHandlers({ ...[39m
- [90m11. [39mglobal [36mdo2[39m[33m()[39m
- [90m12. [39mprocessx:::[36mchain_error[39m[33m([39m[36mdo3[39m[34m()[39m, [33m"something is wrong here")[39m[90m at script.R:12:13[39m
- [90m13. | base::withCallingHandlers({ ...[39m
- [90m14. [39mglobal [36mdo3[39m[33m()[39m
- [90m15. [39mprocessx:::[36mthrow[39m[33m("because of this")[39m[90m at script.R:9:13[39m
- [90m16. | base::signalCondition(cond)[39m
- [90m17. | (function (e) ...[39m
- [90m18. | processx:::throw_error(err, parent = e)[39m
- [90m19. | base::signalCondition(cond)[39m
- [90m20. | (function (e) ...[39m
- [90m21. | processx:::throw_error(err, parent = e)[39m
- Execution halted
-
# chain_error with stop()
Code
@@ -361,30 +299,3 @@
11. | processx:::throw_error(err, parent = e)
Execution halted
----
-
- Code
- cat(out$stderr)
- Output
- [1m[33mError[39m[22m in `eval(ei, envir)`:
- [33m![39m failed to run external program
- [1mCaused by error[22m in `processx::run(px, c("return", "1"))`[90m at script.R:9:9[39m:
- [33m![39m System command 'px' failed
- ---
- Exit status: 1
- Stderr:
- ---
- Backtrace:
- [90m 1. [39mbase::[36msource[39m[33m("script.R")[39m
- [90m 2. | base::withVisible(eval(ei, envir))[39m
- [90m 3. | base::eval(ei, envir)[39m
- [90m 4. | base::eval(ei, envir)[39m
- [90m 5. [39mprocessx:::[36mchain_error[39m[33m([39mprocessx::[36mrun[39m[34m([39mpx, [36mc([39m[33m"return"[39m, [33m"1"[39m[36m)[39m[34m)[39m, [33m"failed to r[39m...[90m at script.R:9:9[39m
- [90m 6. | base::withCallingHandlers({ ...[39m
- [90m 7. [39mprocessx::[36mrun[39m[33m([39mpx, [36mc[39m[34m([39m[33m"return"[39m, [33m"1"[39m[34m)[39m[33m)[39m
- [90m 8. [39mprocessx:::throw(new_process_error(res, call = sys.call(), echo = echo, ...
- [90m 9. | base::signalCondition(cond)[39m
- [90m10. | (function (e) ...[39m
- [90m11. | processx:::throw_error(err, parent = e)[39m
- Execution halted
-
diff --git a/tests/testthat/_snaps/fifo.md b/tests/testthat/_snaps/fifo.md
new file mode 100644
index 00000000..35703aba
--- /dev/null
+++ b/tests/testthat/_snaps/fifo.md
@@ -0,0 +1,16 @@
+# errors
+
+ Code
+ conn_create_fifo(read = TRUE, write = TRUE)
+ Condition
+ Error:
+ ! Bi-directional FIFOs are not supported currently
+
+---
+
+ Code
+ conn_connect_fifo(read = TRUE, write = TRUE)
+ Condition
+ Error:
+ ! Bi-directional FIFOs are not supported currently
+
diff --git a/tests/testthat/_snaps/io.md b/tests/testthat/_snaps/io.md
new file mode 100644
index 00000000..3449d0b5
--- /dev/null
+++ b/tests/testthat/_snaps/io.md
@@ -0,0 +1,73 @@
+# Output and error are discarded by default
+
+ Code
+ p$read_output_lines(n = 1)
+ Condition
+ Error:
+ ! stdout is not a pipe.
+ Code
+ p$read_all_output_lines()
+ Condition
+ Error:
+ ! stdout is not a pipe.
+ Code
+ p$read_all_output()
+ Condition
+ Error:
+ ! stdout is not a pipe.
+ Code
+ p$read_error_lines(n = 1)
+ Condition
+ Error:
+ ! stderr is not a pipe.
+ Code
+ p$read_all_error_lines()
+ Condition
+ Error:
+ ! stderr is not a pipe.
+ Code
+ p$read_all_error()
+ Condition
+ Error:
+ ! stderr is not a pipe.
+
+# same pipe
+
+ Code
+ p$read_all_error_lines()
+ Condition
+ Error:
+ ! stderr is not a pipe.
+
+# same file
+
+ Code
+ p$read_all_output_lines()
+ Condition
+ Error:
+ ! stdout is not a pipe.
+
+---
+
+ Code
+ p$read_all_error_lines()
+ Condition
+ Error:
+ ! stderr is not a pipe.
+
+# same NULL, for completeness
+
+ Code
+ p$read_all_output_lines()
+ Condition
+ Error:
+ ! stdout is not a pipe.
+
+---
+
+ Code
+ p$read_all_error_lines()
+ Condition
+ Error:
+ ! stderr is not a pipe.
+
diff --git a/tests/testthat/_snaps/newcli/err-output.md b/tests/testthat/_snaps/newcli/err-output.md
new file mode 100644
index 00000000..b7af06c7
--- /dev/null
+++ b/tests/testthat/_snaps/newcli/err-output.md
@@ -0,0 +1,89 @@
+# simple error with cli and colors
+
+ Code
+ cat(out$stderr)
+ Output
+ [1m[33mError[39m[22m in `f()`[90m at script.R:5:5[39m:
+ [33m![39m This failed
+ ---
+ Backtrace:
+ [90m1. [39mbase::[1msource[22m[38;5;178m([38;5;37m"script.R"[38;5;178m)[39m
+ [90m2. | base::withVisible(eval(ei, envir))[39m
+ [90m3. | base::eval(ei, envir)[39m
+ [90m4. | base::eval(ei, envir)[39m
+ [90m5. [39mglobal [1mf[22m[38;5;178m()[39m[90m at script.R:5:5[39m
+ [90m6. [39mprocessx:::[1mthrow[22m[38;5;178m([38;5;37m"This failed"[38;5;178m)[39m[90m at script.R:4:10[39m
+ Execution halted
+
+---
+
+ Code
+ cat(out$stdout)
+ Output
+ [1m[33mError[39m[22m in `f()`[90m at script.R:6:5[39m:
+ [33m![39m This failed
+ [90mType .Last.error to see the more details.[39m
+
+# chain_error
+
+ Code
+ cat(out$stderr)
+ Output
+ [1m[33mError[39m[22m in `do()`[90m at script.R:19:14[39m:
+ [33m![39m Failed to base64 encode
+ [1mCaused by error[22m in `do2()`[90m at script.R:15:13[39m:
+ [33m![39m something is wrong here
+ [1mCaused by error[22m in `do3()`[90m at script.R:12:13[39m:
+ [33m![39m because of this
+ ---
+ Backtrace:
+ [90m 1. [39mbase::[1msource[22m[38;5;178m([38;5;37m"script.R"[38;5;178m)[39m
+ [90m 2. | base::withVisible(eval(ei, envir))[39m
+ [90m 3. | base::eval(ei, envir)[39m
+ [90m 4. | base::eval(ei, envir)[39m
+ [90m 5. [39mglobal [1mf[22m[38;5;178m()[39m[90m at script.R:20:9[39m
+ [90m 6. [39mglobal [1mg[22m[38;5;178m()[39m[90m at script.R:17:14[39m
+ [90m 7. [39mglobal [1mh[22m[38;5;178m()[39m[90m at script.R:18:14[39m
+ [90m 8. [39mglobal [1mdo[22m[38;5;178m()[39m[90m at script.R:19:14[39m
+ [90m 9. [39mprocessx:::[1mchain_error[22m[38;5;178m([39m[1mdo2[22m[33m()[39m, [38;5;37m"Failed to base64 encode"[38;5;178m)[39m[90m at script.R:15:13[39m
+ [90m10. | base::withCallingHandlers({ ...[39m
+ [90m11. [39mglobal [1mdo2[22m[38;5;178m()[39m
+ [90m12. [39mprocessx:::[1mchain_error[22m[38;5;178m([39m[1mdo3[22m[33m()[39m, [38;5;37m"something is wrong here"[38;5;178m)[39m[90m at script.R:12:13[39m
+ [90m13. | base::withCallingHandlers({ ...[39m
+ [90m14. [39mglobal [1mdo3[22m[38;5;178m()[39m
+ [90m15. [39mprocessx:::[1mthrow[22m[38;5;178m([38;5;37m"because of this"[38;5;178m)[39m[90m at script.R:9:13[39m
+ [90m16. | base::signalCondition(cond)[39m
+ [90m17. | (function (e) ...[39m
+ [90m18. | processx:::throw_error(err, parent = e)[39m
+ [90m19. | base::signalCondition(cond)[39m
+ [90m20. | (function (e) ...[39m
+ [90m21. | processx:::throw_error(err, parent = e)[39m
+ Execution halted
+
+# full parent error is printed in non-interactive mode
+
+ Code
+ cat(out$stderr)
+ Output
+ [1m[33mError[39m[22m in `eval(ei, envir)`:
+ [33m![39m failed to run external program
+ [1mCaused by error[22m in `processx::run(px, c("return", "1"))`[90m at script.R:9:9[39m:
+ [33m![39m System command 'px' failed
+ ---
+ Exit status: 1
+ Stderr:
+ ---
+ Backtrace:
+ [90m 1. [39mbase::[1msource[22m[38;5;178m([38;5;37m"script.R"[38;5;178m)[39m
+ [90m 2. | base::withVisible(eval(ei, envir))[39m
+ [90m 3. | base::eval(ei, envir)[39m
+ [90m 4. | base::eval(ei, envir)[39m
+ [90m 5. [39mprocessx:::[1mchain_error[22m[38;5;178m([39mprocessx::[1mrun[22m[33m([39mpx, [1mc[22m[34m([39m[38;5;37m"return"[39m, [38;5;37m"1"[39m[34m)[39m[33m)[39m, [38;5;37m"failed to r[39m...[90m at script.R:9:9[39m
+ [90m 6. | base::withCallingHandlers({ ...[39m
+ [90m 7. [39mprocessx::[1mrun[22m[38;5;178m([39mpx, [1mc[22m[33m([39m[38;5;37m"return"[39m, [38;5;37m"1"[39m[33m)[39m[38;5;178m)[39m
+ [90m 8. [39mprocessx:::throw(new_process_error(res, call = sys.call(), echo = echo, ...
+ [90m 9. | base::signalCondition(cond)[39m
+ [90m10. | (function (e) ...[39m
+ [90m11. | processx:::throw_error(err, parent = e)[39m
+ Execution halted
+
diff --git a/tests/testthat/_snaps/oldcli/err-output.md b/tests/testthat/_snaps/oldcli/err-output.md
new file mode 100644
index 00000000..a14e88f7
--- /dev/null
+++ b/tests/testthat/_snaps/oldcli/err-output.md
@@ -0,0 +1,89 @@
+# simple error with cli and colors
+
+ Code
+ cat(out$stderr)
+ Output
+ [1m[33mError[39m[22m in `f()`[90m at script.R:5:5[39m:
+ [33m![39m This failed
+ ---
+ Backtrace:
+ [90m1. [39mbase::[36msource[39m[33m("script.R")[39m
+ [90m2. | base::withVisible(eval(ei, envir))[39m
+ [90m3. | base::eval(ei, envir)[39m
+ [90m4. | base::eval(ei, envir)[39m
+ [90m5. [39mglobal [36mf[39m[33m()[39m[90m at script.R:5:5[39m
+ [90m6. [39mprocessx:::[36mthrow[39m[33m("This failed")[39m[90m at script.R:4:10[39m
+ Execution halted
+
+---
+
+ Code
+ cat(out$stdout)
+ Output
+ [1m[33mError[39m[22m in `f()`[90m at script.R:6:5[39m:
+ [33m![39m This failed
+ [90mType .Last.error to see the more details.[39m
+
+# chain_error
+
+ Code
+ cat(out$stderr)
+ Output
+ [1m[33mError[39m[22m in `do()`[90m at script.R:19:14[39m:
+ [33m![39m Failed to base64 encode
+ [1mCaused by error[22m in `do2()`[90m at script.R:15:13[39m:
+ [33m![39m something is wrong here
+ [1mCaused by error[22m in `do3()`[90m at script.R:12:13[39m:
+ [33m![39m because of this
+ ---
+ Backtrace:
+ [90m 1. [39mbase::[36msource[39m[33m("script.R")[39m
+ [90m 2. | base::withVisible(eval(ei, envir))[39m
+ [90m 3. | base::eval(ei, envir)[39m
+ [90m 4. | base::eval(ei, envir)[39m
+ [90m 5. [39mglobal [36mf[39m[33m()[39m[90m at script.R:20:9[39m
+ [90m 6. [39mglobal [36mg[39m[33m()[39m[90m at script.R:17:14[39m
+ [90m 7. [39mglobal [36mh[39m[33m()[39m[90m at script.R:18:14[39m
+ [90m 8. [39mglobal [36mdo[39m[33m()[39m[90m at script.R:19:14[39m
+ [90m 9. [39mprocessx:::[36mchain_error[39m[33m([39m[36mdo2[39m[34m()[39m, [33m"Failed to base64 encode")[39m[90m at script.R:15:13[39m
+ [90m10. | base::withCallingHandlers({ ...[39m
+ [90m11. [39mglobal [36mdo2[39m[33m()[39m
+ [90m12. [39mprocessx:::[36mchain_error[39m[33m([39m[36mdo3[39m[34m()[39m, [33m"something is wrong here")[39m[90m at script.R:12:13[39m
+ [90m13. | base::withCallingHandlers({ ...[39m
+ [90m14. [39mglobal [36mdo3[39m[33m()[39m
+ [90m15. [39mprocessx:::[36mthrow[39m[33m("because of this")[39m[90m at script.R:9:13[39m
+ [90m16. | base::signalCondition(cond)[39m
+ [90m17. | (function (e) ...[39m
+ [90m18. | processx:::throw_error(err, parent = e)[39m
+ [90m19. | base::signalCondition(cond)[39m
+ [90m20. | (function (e) ...[39m
+ [90m21. | processx:::throw_error(err, parent = e)[39m
+ Execution halted
+
+# full parent error is printed in non-interactive mode
+
+ Code
+ cat(out$stderr)
+ Output
+ [1m[33mError[39m[22m in `eval(ei, envir)`:
+ [33m![39m failed to run external program
+ [1mCaused by error[22m in `processx::run(px, c("return", "1"))`[90m at script.R:9:9[39m:
+ [33m![39m System command 'px' failed
+ ---
+ Exit status: 1
+ Stderr:
+ ---
+ Backtrace:
+ [90m 1. [39mbase::[36msource[39m[33m("script.R")[39m
+ [90m 2. | base::withVisible(eval(ei, envir))[39m
+ [90m 3. | base::eval(ei, envir)[39m
+ [90m 4. | base::eval(ei, envir)[39m
+ [90m 5. [39mprocessx:::[36mchain_error[39m[33m([39mprocessx::[36mrun[39m[34m([39mpx, [36mc([39m[33m"return"[39m, [33m"1"[39m[36m)[39m[34m)[39m, [33m"failed to r[39m...[90m at script.R:9:9[39m
+ [90m 6. | base::withCallingHandlers({ ...[39m
+ [90m 7. [39mprocessx::[36mrun[39m[33m([39mpx, [36mc[39m[34m([39m[33m"return"[39m, [33m"1"[39m[34m)[39m[33m)[39m
+ [90m 8. [39mprocessx:::throw(new_process_error(res, call = sys.call(), echo = echo, ...
+ [90m 9. | base::signalCondition(cond)[39m
+ [90m10. | (function (e) ...[39m
+ [90m11. | processx:::throw_error(err, parent = e)[39m
+ Execution halted
+
diff --git a/tests/testthat/_snaps/process.md b/tests/testthat/_snaps/process.md
new file mode 100644
index 00000000..b91b39ef
--- /dev/null
+++ b/tests/testthat/_snaps/process.md
@@ -0,0 +1,8 @@
+# post processing
+
+ Code
+ p$get_result()
+ Condition
+ Error:
+ ! Process is still alive
+
diff --git a/tests/testthat/_snaps/pty.md b/tests/testthat/_snaps/pty.md
new file mode 100644
index 00000000..fdb74fc8
--- /dev/null
+++ b/tests/testthat/_snaps/pty.md
@@ -0,0 +1,8 @@
+# read_output_lines() fails for pty
+
+ Code
+ p$read_output_lines()
+ Condition
+ Error:
+ ! Cannot read lines from a pty (see manual)
+
diff --git a/tests/testthat/_snaps/standalone-errors.md b/tests/testthat/_snaps/standalone-errors.md
index 73d57539..eed40841 100644
--- a/tests/testthat/_snaps/standalone-errors.md
+++ b/tests/testthat/_snaps/standalone-errors.md
@@ -1,30 +1,26 @@
# can pass frame as error call in `new_error()`
Code
- (expect_error(f()))
- Output
-
- Error in `f()`:
+ f()
+ Condition
+ Error:
! my message
Code
- (expect_error(g()))
- Output
-
- Error in `g()`:
+ g()
+ Condition
+ Error:
! my message
# can pass frame as error call in `throw()`
Code
- (expect_error(f()))
- Output
-
- Error in `f()`:
+ f()
+ Condition
+ Error:
! my message
Code
- (expect_error(g()))
- Output
-
- Error in `g()`:
+ g()
+ Condition
+ Error:
! my message
diff --git a/tests/testthat/_snaps/unix-sockets.md b/tests/testthat/_snaps/unix-sockets.md
new file mode 100644
index 00000000..fac92de9
--- /dev/null
+++ b/tests/testthat/_snaps/unix-sockets.md
@@ -0,0 +1,40 @@
+# CRUD
+
+ Code
+ conn_accept_unix_socket(sock1)
+ Condition
+ Error:
+ ! Native call to `processx_connection_accept_socket` failed
+ Caused by error:
+ ! Socket is not listening @processx-connection.c:540 (processx_connection_accept_socket)
+
+# writing unaccepted server socket is error
+
+ Code
+ conn_write(sock1, "Hello\n")
+ Condition
+ Error:
+ ! Native call to `processx_connection_write_bytes` failed
+ Caused by error:
+ ! Cannot write to an un-accepted socket connection @processx-connection.c:966 (processx_c_connection_write_bytes)
+
+# errors
+
+ Code
+ conn_accept_unix_socket(ff)
+ Condition
+ Error:
+ ! Native call to `processx_connection_accept_socket` failed
+ Caused by error:
+ ! Not a socket connection @processx-connection.c:536 (processx_connection_accept_socket)
+
+---
+
+ Code
+ conn_unix_socket_state(ff)
+ Condition
+ Error:
+ ! Native call to `processx_connection_socket_state` failed
+ Caused by error:
+ ! Not a socket connection @processx-connection.c:585 (processx_connection_socket_state)
+
diff --git a/tests/testthat/_snaps/utils.md b/tests/testthat/_snaps/utils.md
new file mode 100644
index 00000000..660b9426
--- /dev/null
+++ b/tests/testthat/_snaps/utils.md
@@ -0,0 +1,18 @@
+# full_path gives correct values, windows
+
+ Code
+ full_path("//")
+ Condition
+ Error:
+ ! Server name not found in network path.
+ Code
+ full_path("///")
+ Condition
+ Error:
+ ! Server name not found in network path.
+ Code
+ full_path("///a")
+ Condition
+ Error:
+ ! Server name not found in network path.
+
diff --git a/tests/testthat/helper.R b/tests/testthat/helper.R
index e541087c..82794930 100644
--- a/tests/testthat/helper.R
+++ b/tests/testthat/helper.R
@@ -1,4 +1,3 @@
-
skip_other_platforms <- function(platform) {
if (os_type() != platform) skip(paste("only run it on", platform))
}
@@ -8,7 +7,7 @@ skip_if_no_tool <- function(tool) {
}
skip_extra_tests <- function() {
- if (Sys.getenv("PROCESSX_EXTRA_TESTS") == "") skip("no extra tests")
+ if (Sys.getenv("PROCESSX_EXTRA_TESTS") == "") skip("no extra tests")
}
skip_if_no_ps <- function() {
@@ -66,22 +65,32 @@ httpbin <- webfakes::new_app_process(
)
interrupt_me <- function(expr, after = 1) {
- tryCatch({
- p <- callr::r_bg(function(pid, after) {
- Sys.sleep(after)
- ps::ps_interrupt(ps::ps_handle(pid))
- }, list(pid = Sys.getpid(), after = after))
- expr
- p$kill()
- }, interrupt = function(e) e)
+ tryCatch(
+ {
+ p <- callr::r_bg(
+ function(pid, after) {
+ Sys.sleep(after)
+ ps::ps_interrupt(ps::ps_handle(pid))
+ },
+ list(pid = Sys.getpid(), after = after)
+ )
+ expr
+ p$kill()
+ },
+ interrupt = function(e) e
+ )
}
expect_error <- function(..., class = "error") {
testthat::expect_error(..., class = class)
}
-local_temp_dir <- function(pattern = "file", tmpdir = tempdir(),
- fileext = "", envir = parent.frame()) {
+local_temp_dir <- function(
+ pattern = "file",
+ tmpdir = tempdir(),
+ fileext = "",
+ envir = parent.frame()
+) {
path <- tempfile(pattern = pattern, tmpdir = tmpdir, fileext = fileext)
dir.create(path)
withr::local_dir(path, .local_envir = envir)
@@ -111,10 +120,13 @@ run_script <- function(expr, ..., quoted = NULL, encoding = "") {
writeLines(deparse(quoted), con = sf)
writeLines(
- deparse(substitute({
- options(keep.source = TRUE)
- source(sf)
- }, list(sf = basename(sf)))),
+ deparse(substitute(
+ {
+ options(keep.source = TRUE)
+ source(sf)
+ },
+ list(sf = basename(sf))
+ )),
con = sf2
)
@@ -128,7 +140,7 @@ run_script <- function(expr, ..., quoted = NULL, encoding = "") {
)
enc <- function(x) iconv(list(x), encoding, "UTF-8")
-
+
list(
script = readLines(sf),
stdout = enc(readBin(so, "raw", file.size(so))),
@@ -149,6 +161,29 @@ scrub_srcref <- function(x) {
x
}
+transform_tempdir <- function(x) {
+ x <- sub(tempdir(), "", x, fixed = TRUE)
+ x <- sub(normalizePath(tempdir()), "", x, fixed = TRUE)
+ x <- sub(
+ normalizePath(tempdir(), winslash = "/"),
+ "",
+ x,
+ fixed = TRUE
+ )
+ x <- sub("\\R\\", "/R/", x, fixed = TRUE)
+ x <- sub("[\\\\/]file[a-zA-Z0-9]+", "/", x)
+ x <- sub("[A-Z]:.*Rtmp[a-zA-Z0-9]+[\\\\/]", "/", x)
+ x
+}
+
+transform_px <- function(x) {
+ sub("'.*/px([.]exe)?'", "'/px'", x)
+}
+
+sysname <- function() {
+ Sys.info()[["sysname"]]
+}
+
err$register_testthat_print()
poll_until <- function(fn, interrupt = 0.2, timeout = 5) {
@@ -166,3 +201,8 @@ poll_until <- function(fn, interrupt = 0.2, timeout = 5) {
skip_on_cran()
stop("timeout")
}
+
+load_sigtermignore <- function() {
+ lib <- asNamespace("processx")$get_test_lib("sigtermignore")
+ dyn.load(lib)
+}
diff --git a/tests/testthat/test-assertions.R b/tests/testthat/test-assertions.R
index fc4a5349..87987423 100644
--- a/tests/testthat/test-assertions.R
+++ b/tests/testthat/test-assertions.R
@@ -1,7 +1,13 @@
-
strings <- list("foo", "", "111", "1", "-", "NA")
-not_strings <- list(1, character(), NA_character_, NA,
- c("foo", NA), c("1", "2"), NULL)
+not_strings <- list(
+ 1,
+ character(),
+ NA_character_,
+ NA,
+ c("foo", NA),
+ c("1", "2"),
+ NULL
+)
test_that("is_string", {
for (p in strings) {
@@ -11,7 +17,7 @@ test_that("is_string", {
for (n in not_strings) {
expect_false(is_string(n))
- expect_error(assert_that(is_string(n)), "is not a string")
+ expect_snapshot(error = TRUE, assert_that(is_string(n)))
}
})
@@ -26,17 +32,21 @@ test_that("is_string_or_null", {
for (n in not_strings) {
if (!is.null(n)) {
expect_false(is_string_or_null(n))
- expect_error(
- assert_that(is_string_or_null(n)),
- "must be a string .* NULL"
- )
+ expect_snapshot(error = TRUE, assert_that(is_string_or_null(n)))
}
}
})
flags <- list(TRUE, FALSE)
-not_flags <- list(1, character(), NA_character_, NA,
- c("foo", NA), c("1", "2"), NULL)
+not_flags <- list(
+ 1,
+ character(),
+ NA_character_,
+ NA,
+ c("foo", NA),
+ c("1", "2"),
+ NULL
+)
test_that("is_flag", {
for (p in flags) {
@@ -46,13 +56,21 @@ test_that("is_flag", {
for (n in not_flags) {
expect_false(is_flag(n))
- expect_error(assert_that(is_flag(n)), "is not a flag")
+ expect_snapshot(error = TRUE, assert_that(is_flag(n)))
}
})
ints <- list(1, 0, -1, 1L, 0L, -1L, 1.0, 42.0)
-not_ints <- list(1.2, 0.1, "foo", numeric(), integer(), NULL,
- NA_integer_, NA_real_)
+not_ints <- list(
+ 1.2,
+ 0.1,
+ "foo",
+ numeric(),
+ integer(),
+ NULL,
+ NA_integer_,
+ NA_real_
+)
test_that("is_integerish_scalar", {
for (p in ints) {
@@ -62,10 +80,7 @@ test_that("is_integerish_scalar", {
for (n in not_ints) {
expect_false(is_integerish_scalar(n))
- expect_error(
- assert_that(is_integerish_scalar(n)),
- "is not a length 1 integer"
- )
+ expect_snapshot(error = TRUE, assert_that(is_integerish_scalar(n)))
}
})
@@ -77,7 +92,7 @@ test_that("is_pid", {
for (n in not_ints) {
expect_false(is_pid(n))
- expect_error(assert_that(is_pid(n)), "is not a process id")
+ expect_snapshot(error = TRUE, assert_that(is_pid(n)))
}
})
@@ -89,20 +104,13 @@ test_that("is_flag_or_string", {
for (n in intersect(not_flags, not_strings)) {
expect_false(is_flag_or_string(n))
- expect_error(
- assert_that(is_flag_or_string(n)),
- "is not a flag or a string"
- )
+ expect_snapshot(error = TRUE, assert_that(is_flag_or_string(n)))
}
-
})
test_that("is_existing_file", {
expect_false(is_existing_file(tempfile()))
- expect_error(
- assert_that(is_existing_file(tempfile())),
- "File .* does not exist"
- )
+ expect_snapshot(error = TRUE, assert_that(is_existing_file(tempfile())))
cat("foo\n", file = tmp <- tempfile())
on.exit(unlink(tmp), add = TRUE)
diff --git a/tests/testthat/test-chr-io.R b/tests/testthat/test-chr-io.R
index 324d6ec2..94869369 100644
--- a/tests/testthat/test-chr-io.R
+++ b/tests/testthat/test-chr-io.R
@@ -1,6 +1,4 @@
-
test_that("Can read last line without trailing newline", {
-
px <- get_tool("px")
p <- process$new(px, c("out", "foobar"), stdout = "|")
@@ -10,7 +8,6 @@ test_that("Can read last line without trailing newline", {
})
test_that("Can read single characters", {
-
px <- get_tool("px")
p <- process$new(px, c("out", "123"), stdout = "|")
@@ -26,7 +23,6 @@ test_that("Can read single characters", {
})
test_that("Can read multiple characters", {
-
px <- get_tool("px")
p <- process$new(px, c("out", "123456789"), stdout = "|")
diff --git a/tests/testthat/test-cleanup.R b/tests/testthat/test-cleanup.R
index c42c38b5..59682ffb 100644
--- a/tests/testthat/test-cleanup.R
+++ b/tests/testthat/test-cleanup.R
@@ -1,6 +1,4 @@
-
test_that("process is cleaned up", {
-
px <- get_tool("px")
p <- process$new(px, c("sleep", "1"), cleanup = TRUE)
pid <- p$get_pid()
@@ -12,7 +10,6 @@ test_that("process is cleaned up", {
})
test_that("process can stay alive", {
-
px <- get_tool("px")
on.exit(tools::pskill(pid, 9), add = TRUE)
diff --git a/tests/testthat/test-client-lib.R b/tests/testthat/test-client-lib.R
index 943cdc90..b1944523 100644
--- a/tests/testthat/test-client-lib.R
+++ b/tests/testthat/test-client-lib.R
@@ -1,4 +1,3 @@
-
test_that("client lib is standalone", {
lib <- load_client_lib(client)
on.exit(try(lib$.finalize()), add = TRUE)
@@ -9,9 +8,14 @@ test_that("client lib is standalone", {
for (f in funobjs) expect_identical(environmentName(topenv(f)), "base")
expect_message(
- mapply(codetools::checkUsage, funobjs, funs,
- MoreArgs = list(report = message)),
- NA)
+ mapply(
+ codetools::checkUsage,
+ funobjs,
+ funs,
+ MoreArgs = list(report = message)
+ ),
+ NA
+ )
})
test_that("base64", {
@@ -27,8 +31,9 @@ test_that("base64", {
for (i in 5:32) {
mtcars2 <- unserialize(lib$base64_decode(lib$base64_encode(
- serialize(mtcars[1:i, ], NULL))))
- expect_identical(mtcars[1:i,], mtcars2)
+ serialize(mtcars[1:i, ], NULL)
+ )))
+ expect_identical(mtcars[1:i, ], mtcars2)
}
})
@@ -68,7 +73,8 @@ test_that("processx_connection_set_stdout", {
on.exit(unlink(tmp), add = TRUE)
opt <- callr::r_process_options(
func = stdout_to_file,
- args = list(filename = tmp))
+ args = list(filename = tmp)
+ )
on.exit(p$kill(), add = TRUE)
p <- callr::r_process$new(opt)
@@ -94,7 +100,8 @@ test_that("processx_connection_set_stdout", {
on.exit(unlink(tmp), add = TRUE)
opt <- callr::r_process_options(
func = stderr_to_file,
- args = list(filename = tmp))
+ args = list(filename = tmp)
+ )
on.exit(p$kill(), add = TRUE)
p <- callr::r_process$new(opt)
@@ -126,7 +133,8 @@ test_that("setting stdout multiple times", {
on.exit(unlink(c(tmp1, tmp2)), add = TRUE)
opt <- callr::r_process_options(
func = stdout_to_file,
- args = list(file1 = tmp1, file2 = tmp2))
+ args = list(file1 = tmp1, file2 = tmp2)
+ )
on.exit(p$kill(), add = TRUE)
p <- callr::r_process$new(opt)
diff --git a/tests/testthat/test-connections.R b/tests/testthat/test-connections.R
index d7387797..efe31265 100644
--- a/tests/testthat/test-connections.R
+++ b/tests/testthat/test-connections.R
@@ -1,10 +1,8 @@
-
if (!is.null(packageDescription("stats")[["ExperimentalWindowsRuntime"]])) {
if (!identical(Sys.getenv("NOT_CRAN"), "true")) return()
}
test_that("lot of text", {
-
px <- get_tool("px")
txt <- strrep("x", 100000)
cat(txt, file = tmp <- tempfile())
@@ -17,7 +15,6 @@ test_that("lot of text", {
})
test_that("UTF-8", {
-
px <- get_tool("px")
txt <- charToRaw(strrep("\xc2\xa0\xe2\x86\x92\xf0\x90\x84\x82", 20000))
writeBin(txt, con = tmp <- tempfile())
@@ -30,7 +27,6 @@ test_that("UTF-8", {
})
test_that("UTF-8 multibyte character cut in half", {
-
px <- get_tool("px")
rtxt <- charToRaw("a\xc2\xa0a")
@@ -38,22 +34,30 @@ test_that("UTF-8 multibyte character cut in half", {
writeBin(rtxt[1:2], tmp1 <- tempfile())
writeBin(rtxt[3:4], tmp2 <- tempfile())
- p1 <- process$new(px, c("cat", tmp1, "cat", tmp2), stdout = "|",
- encoding = "UTF-8")
+ p1 <- process$new(
+ px,
+ c("cat", tmp1, "cat", tmp2),
+ stdout = "|",
+ encoding = "UTF-8"
+ )
on.exit(p1$kill(), add = TRUE)
out <- p1$read_all_output_lines()
expect_equal(rtxt, charToRaw(out))
cmd <- paste("(cat", shQuote(tmp1), ";sleep 1;cat", shQuote(tmp2), ")")
- p2 <- process$new(px, c("cat", tmp1, "sleep", "1", "cat", tmp2),
- stdout = "|", stderr = "|", encoding = "UTF-8")
+ p2 <- process$new(
+ px,
+ c("cat", tmp1, "sleep", "1", "cat", tmp2),
+ stdout = "|",
+ stderr = "|",
+ encoding = "UTF-8"
+ )
on.exit(p2$kill(), add = TRUE)
out <- p2$read_all_output_lines()
expect_equal(rtxt, charToRaw(out))
})
test_that("UTF-8 multibyte character cut in half at the end of the file", {
-
px <- get_tool("px")
rtxt <- charToRaw("a\xc2\xa0a")
writeBin(c(rtxt, rtxt[1:2]), tmp1 <- tempfile())
@@ -68,7 +72,6 @@ test_that("UTF-8 multibyte character cut in half at the end of the file", {
})
test_that("Invalid UTF-8 characters in the middle of the string", {
-
px <- get_tool("px")
half <- charToRaw("\xc2\xa0")[1]
rtxt <- sample(rep(c(half, charToRaw("a")), 100))
@@ -82,10 +85,9 @@ test_that("Invalid UTF-8 characters in the middle of the string", {
})
test_that("Convert from another encoding to UTF-8", {
-
px <- get_tool("px")
- latin1 <- "\xe1\xe9\xed";
+ latin1 <- "\xe1\xe9\xed"
writeBin(charToRaw(latin1), tmp1 <- tempfile())
p <- process$new(px, c("cat", tmp1), stdout = "|", encoding = "latin1")
@@ -96,7 +98,6 @@ test_that("Convert from another encoding to UTF-8", {
})
test_that("Passing connection to stdout", {
-
# file first
tmp <- tempfile()
con <- conn_create_file(tmp, write = TRUE)
diff --git a/tests/testthat/test-env.R b/tests/testthat/test-env.R
index 4b4f049b..fe85e9d2 100644
--- a/tests/testthat/test-env.R
+++ b/tests/testthat/test-env.R
@@ -1,11 +1,9 @@
-
test_that("inherit by default", {
-
v <- basename(tempfile())
if (os_type() == "unix") {
cmd <- c("bash", "-c", paste0("echo $", v))
} else {
- cmd <- c("cmd", "/c", paste0("echo %", v, "%"))
+ cmd <- c("cmd", "/c", paste0("echo %", v, "%"))
}
skip_if_no_tool(cmd[1])
@@ -16,12 +14,11 @@ test_that("inherit by default", {
})
test_that("specify custom env", {
-
v <- c(basename(tempfile()), basename(tempfile()))
if (os_type() == "unix") {
cmd <- c("bash", "-c", paste0("echo ", paste0("$", v, collapse = " ")))
} else {
- cmd <- c("cmd", "/c", paste0("echo ", paste0("%", v, "%", collapse = " ")))
+ cmd <- c("cmd", "/c", paste0("echo ", paste0("%", v, "%", collapse = " ")))
}
skip_if_no_tool(cmd[1])
diff --git a/tests/testthat/test-err-output.R b/tests/testthat/test-err-output.R
index 402ac0fc..789ce848 100644
--- a/tests/testthat/test-err-output.R
+++ b/tests/testthat/test-err-output.R
@@ -1,6 +1,4 @@
-
test_that("simple error", {
-
out <- run_script({
f <- function() processx:::throw("This failed")
f()
@@ -16,7 +14,6 @@ test_that("simple error", {
})
test_that("simple error with cli", {
-
out <- run_script({
library(cli)
f <- function() processx:::throw("This failed")
@@ -34,14 +31,14 @@ test_that("simple error with cli", {
})
test_that("simple error with cli and colors", {
-
+ cli <- if (packageVersion("cli") >= "3.6.3") "newcli" else "oldcli"
out <- run_script({
library(cli)
options(cli.num_colors = 256)
f <- function() processx:::throw("This failed")
f()
})
- expect_snapshot(cat(out$stderr))
+ expect_snapshot(cat(out$stderr), variant = cli)
out <- run_script({
library(cli)
@@ -50,7 +47,7 @@ test_that("simple error with cli and colors", {
f <- function() processx:::throw("This failed")
f()
})
- expect_snapshot(cat(out$stdout))
+ expect_snapshot(cat(out$stdout), variant = cli)
})
test_that("chain_error", {
@@ -78,29 +75,44 @@ test_that("chain_error", {
expect_snapshot(cat(out$stderr), transform = scrub_srcref)
expr2 <- substitute(
- {o; c },
+ {
+ o
+ c
+ },
list(o = quote(options(rlib_interactive = TRUE)), c = expr)
)
out <- run_script(quoted = expr2)
expect_snapshot(cat(out$stdout))
expr2 <- substitute(
- {o; c },
+ {
+ o
+ c
+ },
list(o = quote(library(cli)), c = expr)
)
out <- run_script(quoted = expr2)
expect_snapshot(cat(out$stderr), transform = scrub_srcref)
expr2 <- substitute(
- {o; c },
- list(o = quote({library(cli); options(cli.num_colors = 256)}), c = expr)
+ {
+ o
+ c
+ },
+ list(
+ o = quote({
+ library(cli)
+ options(cli.num_colors = 256)
+ }),
+ c = expr
+ )
)
out <- run_script(quoted = expr2)
- expect_snapshot(cat(out$stderr), transform = scrub_srcref)
+ cli <- if (packageVersion("cli") >= "3.6.3") "newcli" else "oldcli"
+ expect_snapshot(cat(out$stderr), transform = scrub_srcref, variant = cli)
})
test_that("chain_error with stop()", {
-
expr <- quote({
do3 <- function() {
stop("because of this")
@@ -124,7 +136,10 @@ test_that("chain_error with stop()", {
expect_snapshot(cat(out$stderr), transform = scrub_srcref)
expr2 <- substitute(
- {o; c },
+ {
+ o
+ c
+ },
list(o = quote(options(rlib_interactive = TRUE)), c = expr)
)
out <- run_script(quoted = expr2)
@@ -132,7 +147,6 @@ test_that("chain_error with stop()", {
})
test_that("chain_error with rlang::abort()", {
-
expr <- quote({
options(cli.unicode = FALSE)
do3 <- function() {
@@ -157,7 +171,10 @@ test_that("chain_error with rlang::abort()", {
expect_snapshot(cat(out$stderr), transform = scrub_srcref)
expr2 <- substitute(
- {o; c },
+ {
+ o
+ c
+ },
list(o = quote(options(rlib_interactive = TRUE)), c = expr)
)
out <- run_script(quoted = expr2)
@@ -181,7 +198,10 @@ test_that("full parent error is printed in non-interactive mode", {
)
expr2 <- substitute(
- {o; c },
+ {
+ o
+ c
+ },
list(o = quote(options(rlib_interactive = TRUE)), c = expr)
)
out <- run_script(quoted = expr2)
@@ -191,7 +211,10 @@ test_that("full parent error is printed in non-interactive mode", {
)
expr2 <- substitute(
- {o; c },
+ {
+ o
+ c
+ },
list(o = quote(library(cli)), c = expr)
)
out <- run_script(quoted = expr2)
@@ -201,12 +224,23 @@ test_that("full parent error is printed in non-interactive mode", {
)
expr2 <- substitute(
- {o; c },
- list(o = quote({library(cli); options(cli.num_colors = 256)}), c = expr)
+ {
+ o
+ c
+ },
+ list(
+ o = quote({
+ library(cli)
+ options(cli.num_colors = 256)
+ }),
+ c = expr
+ )
)
out <- run_script(quoted = expr2)
+ cli <- if (packageVersion("cli") >= "3.6.3") "newcli" else "oldcli"
expect_snapshot(
cat(out$stderr),
- transform = function(x) scrub_px(scrub_srcref(x))
+ transform = function(x) scrub_px(scrub_srcref(x)),
+ variant = cli
)
})
diff --git a/tests/testthat/test-errors.R b/tests/testthat/test-errors.R
index d6ecf656..edbebe8e 100644
--- a/tests/testthat/test-errors.R
+++ b/tests/testthat/test-errors.R
@@ -1,10 +1,12 @@
-
test_that("run() prints stderr if echo = FALSE", {
px <- get_tool("px")
err <- tryCatch(
- run(px, c("outln", "nopppp", "errln", "bad", "errln", "foobar",
- "return", "2")),
- error = function(e) e)
+ run(
+ px,
+ c("outln", "nopppp", "errln", "bad", "errln", "foobar", "return", "2")
+ ),
+ error = function(e) e
+ )
expect_true(any(grepl("foobar", format(err))))
expect_false(any(grepl("nopppp", conditionMessage(err))))
})
@@ -13,18 +15,23 @@ test_that("run() omits stderr if echo = TRUE", {
px <- get_tool("px")
err <- tryCatch(
capture.output(
- run(px, c("errln", "bad", "errln", "foobar", "return", "2"),
- echo = TRUE)),
- error = function(e) e)
+ run(px, c("errln", "bad", "errln", "foobar", "return", "2"), echo = TRUE)
+ ),
+ error = function(e) e
+ )
expect_false(any(grepl("foobar", conditionMessage(err))))
})
test_that("run() handles stderr_to_stdout = TRUE properly", {
px <- get_tool("px")
err <- tryCatch(
- run(px, c("outln", "nopppp", "errln", "bad", "errln", "foobar",
- "return", "2"), stderr_to_stdout = TRUE),
- error = function(e) e)
+ run(
+ px,
+ c("outln", "nopppp", "errln", "bad", "errln", "foobar", "return", "2"),
+ stderr_to_stdout = TRUE
+ ),
+ error = function(e) e
+ )
expect_true(any(grepl("foobar", format(err))))
expect_true(any(grepl("nopppp", format(err))))
})
@@ -36,7 +43,8 @@ test_that("run() only prints the last 10 lines of stderr", {
list(rlib_interactive = TRUE),
ferr <- format(tryCatch(
run(px, c(args, "return", "2")),
- error = function(e) e))
+ error = function(e) e
+ ))
)
expect_false(any(grepl("foobar1--", ferr)))
expect_true(any(grepl("foobar2--", ferr)))
@@ -60,7 +68,6 @@ test_that("prints full stderr in non-interactive mode", {
})
test_that("output from error", {
-
out <- run_script({
processx::run(
processx:::get_tool("px"),
diff --git a/tests/testthat/test-extra-connections.R b/tests/testthat/test-extra-connections.R
index 500cfc26..7f5122b6 100644
--- a/tests/testthat/test-extra-connections.R
+++ b/tests/testthat/test-extra-connections.R
@@ -1,6 +1,4 @@
-
test_that("writing to extra connection", {
-
skip_on_cran()
msg <- "foobar"
@@ -9,8 +7,12 @@ test_that("writing to extra connection", {
pipe <- conn_create_pipepair(nonblocking = c(FALSE, FALSE))
expect_silent(
- p <- process$new(cmd[1], cmd[-1],
- stdout = "|", stderr = "|", connections = list(pipe[[1]])
+ p <- process$new(
+ cmd[1],
+ cmd[-1],
+ stdout = "|",
+ stderr = "|",
+ connections = list(pipe[[1]])
)
)
close(pipe[[1]])
@@ -24,16 +26,27 @@ test_that("writing to extra connection", {
})
test_that("reading from extra connection", {
-
skip_on_cran()
cmd <- c(
- get_tool("px"), "sleep", "0.5", "write", "3", "foobar\r\n", "out", "ok")
+ get_tool("px"),
+ "sleep",
+ "0.5",
+ "write",
+ "3",
+ "foobar\r\n",
+ "out",
+ "ok"
+ )
pipe <- conn_create_pipepair()
expect_silent(
- p <- process$new(cmd[1], cmd[-1], stdout = "|", stderr = "|",
+ p <- process$new(
+ cmd[1],
+ cmd[-1],
+ stdout = "|",
+ stderr = "|",
connections = list(pipe[[2]])
)
)
@@ -53,7 +66,6 @@ test_that("reading from extra connection", {
})
test_that("reading and writing to extra connection", {
-
skip_on_cran()
msg <- "foobar\n"
@@ -63,7 +75,11 @@ test_that("reading and writing to extra connection", {
pipe2 <- conn_create_pipepair()
expect_silent(
- p <- process$new(cmd[1], cmd[-1], stdout = "|", stderr = "|",
+ p <- process$new(
+ cmd[1],
+ cmd[-1],
+ stdout = "|",
+ stderr = "|",
connections = list(pipe1[[1]], pipe2[[2]])
)
)
diff --git a/tests/testthat/test-fifo.R b/tests/testthat/test-fifo.R
index ad881331..bf028ccc 100644
--- a/tests/testthat/test-fifo.R
+++ b/tests/testthat/test-fifo.R
@@ -1,4 +1,3 @@
-
test_that("read end first", {
skip_on_cran()
@@ -129,14 +128,13 @@ test_that("write end first 2", {
test_that("errors", {
skip_on_cran()
- expect_error(
- conn_create_fifo(read = TRUE, write= TRUE)
- )
+ expect_snapshot(error = TRUE, conn_create_fifo(read = TRUE, write = TRUE))
reader <- conn_create_fifo(read = TRUE)
on.exit(close(reader), add = TRUE)
- expect_error(
+ expect_snapshot(
+ error = TRUE,
conn_connect_fifo(read = TRUE, write = TRUE)
)
diff --git a/tests/testthat/test-io.R b/tests/testthat/test-io.R
index f3a0ce0d..e0578c32 100644
--- a/tests/testthat/test-io.R
+++ b/tests/testthat/test-io.R
@@ -1,24 +1,27 @@
-
test_that("Output and error are discarded by default", {
-
px <- get_tool("px")
p <- process$new(px, c("outln", "foobar"))
on.exit(try_silently(p$kill(grace = 0)), add = TRUE)
- expect_error(p$read_output_lines(n=1), "not a pipe")
- expect_error(p$read_all_output_lines(), "not a pipe")
- expect_error(p$read_all_output(), "not a pipe")
- expect_error(p$read_error_lines(n=1), "not a pipe")
- expect_error(p$read_all_error_lines(), "not a pipe")
- expect_error(p$read_all_error(), "not a pipe")
+ expect_snapshot(error = TRUE, {
+ p$read_output_lines(n = 1)
+ p$read_all_output_lines()
+ p$read_all_output()
+ p$read_error_lines(n = 1)
+ p$read_all_error_lines()
+ p$read_all_error()
+ })
})
test_that("We can get the output", {
-
px <- get_tool("px")
- p <- process$new(px, c("out", "foo\nbar\nfoobar\n"),
- stdout = "|", stderr = "|")
+ p <- process$new(
+ px,
+ c("out", "foo\nbar\nfoobar\n"),
+ stdout = "|",
+ stderr = "|"
+ )
on.exit(try_silently(p$kill(grace = 0)), add = TRUE)
out <- p$read_all_output_lines()
@@ -26,7 +29,6 @@ test_that("We can get the output", {
})
test_that("We can get the error stream", {
-
tmp <- tempfile(fileext = ".bat")
on.exit(unlink(tmp), add = TRUE)
@@ -41,7 +43,6 @@ test_that("We can get the error stream", {
})
test_that("Output & error at the same time", {
-
tmp <- tempfile(fileext = ".bat")
on.exit(unlink(tmp), add = TRUE)
@@ -51,7 +52,8 @@ test_that("Output & error at the same time", {
"echo wow",
">&2 echo world",
"echo wooow",
- sep = "\n", file = tmp
+ sep = "\n",
+ file = tmp
)
Sys.chmod(tmp, "700")
@@ -66,7 +68,6 @@ test_that("Output & error at the same time", {
})
test_that("Output and error to specific files", {
-
tmp <- tempfile(fileext = ".bat")
on.exit(unlink(tmp), add = TRUE)
@@ -76,7 +77,8 @@ test_that("Output and error to specific files", {
"echo wow",
">&2 echo world",
"echo wooow",
- sep = "\n", file = tmp
+ sep = "\n",
+ file = tmp
)
Sys.chmod(tmp, "700")
@@ -96,7 +98,6 @@ test_that("Output and error to specific files", {
})
test_that("is_incomplete", {
-
px <- get_tool("px")
p <- process$new(px, c("out", "foo\nbar\nfoobar\n"), stdout = "|")
on.exit(p$kill(), add = TRUE)
@@ -111,7 +112,6 @@ test_that("is_incomplete", {
})
test_that("readChar on IO, unix", {
-
## Need to skip, because of the different EOL character
skip_other_platforms("unix")
@@ -128,7 +128,6 @@ test_that("readChar on IO, unix", {
})
test_that("readChar on IO, windows", {
-
## Need to skip, because of the different EOL character
skip_other_platforms("windows")
@@ -155,7 +154,7 @@ test_that("same pipe", {
out <- p$read_all_output()
expect_equal(out, "o1e1o2e2")
- expect_error(p$read_all_error_lines(), "not a pipe")
+ expect_snapshot(error = TRUE, p$read_all_error_lines())
})
test_that("same file", {
@@ -169,8 +168,8 @@ test_that("same file", {
expect_equal(p$get_exit_status(), 0L)
expect_equal(readLines(tmp), "o1e1o2e2")
- expect_error(p$read_all_output_lines(), "not a pipe")
- expect_error(p$read_all_error_lines(), "not a pipe")
+ expect_snapshot(error = TRUE, p$read_all_output_lines())
+ expect_snapshot(error = TRUE, p$read_all_error_lines())
})
test_that("same NULL, for completeness", {
@@ -180,6 +179,6 @@ test_that("same NULL, for completeness", {
p$wait(2000)
p$kill()
expect_equal(p$get_exit_status(), 0L)
- expect_error(p$read_all_output_lines(), "not a pipe")
- expect_error(p$read_all_error_lines(), "not a pipe")
+ expect_snapshot(error = TRUE, p$read_all_output_lines())
+ expect_snapshot(error = TRUE, p$read_all_error_lines())
})
diff --git a/tests/testthat/test-kill-tree.R b/tests/testthat/test-kill-tree.R
index b785530a..6eecae8b 100644
--- a/tests/testthat/test-kill-tree.R
+++ b/tests/testthat/test-kill-tree.R
@@ -1,4 +1,3 @@
-
test_that("tree ids are inherited", {
skip_on_cran()
skip_if_no_ps()
@@ -18,10 +17,13 @@ test_that("tree ids are inherited", {
deadline <- Sys.time() + 3
while (TRUE) {
if (Sys.time() >= deadline) break
- tryCatch({
- env <- ps::ps_environ(ep)[[ev]]
- break },
- error = function(e) e)
+ tryCatch(
+ {
+ env <- ps::ps_environ(ep)[[ev]]
+ break
+ },
+ error = function(e) e
+ )
Sys.sleep(0.05)
}
@@ -38,7 +40,7 @@ test_that("tree ids are inherited if env is specified", {
p <- process$new(px, c("sleep", "10"), env = c(FOO = "bar"))
on.exit(p$kill(), add = TRUE)
- ep <- ps::ps_handle(p$get_pid())
+ ep <- ps::ps_handle(p$get_pid())
ev <- paste0("PROCESSX_", get_private(p)$tree_id)
@@ -49,10 +51,13 @@ test_that("tree ids are inherited if env is specified", {
deadline <- Sys.time() + 3
while (TRUE) {
if (Sys.time() >= deadline) break
- tryCatch({
- env <- ps::ps_environ(ep)[[ev]]
- break },
- error = function(e) e)
+ tryCatch(
+ {
+ env <- ps::ps_environ(ep)[[ev]]
+ break
+ },
+ error = function(e) e
+ )
Sys.sleep(0.05)
}
@@ -82,13 +87,20 @@ test_that("kill_tree", {
test_that("kill_tree with children", {
skip_on_cran()
skip_if_no_ps()
+ # temporarily
+ if (getRversion() >= "4.0.0" && is_windows()) {
+ skip("Fails on Windows & new R")
+ }
tmp <- tempfile()
on.exit(unlink(tmp), add = TRUE)
p <- callr::r_bg(
function(px, tmp) {
- processx::run(px, c("outln", "ok", "sleep", "100"),
- stdout_callback = function(x, p) cat(x, file = tmp, append = TRUE))
+ processx::run(
+ px,
+ c("outln", "ok", "sleep", "100"),
+ stdout_callback = function(x, p) cat(x, file = tmp, append = TRUE)
+ )
},
args = list(px = get_tool("px"), tmp = tmp)
)
@@ -116,10 +128,17 @@ test_that("kill_tree and orphaned children", {
on.exit(unlink(tmp), add = TRUE)
p1 <- callr::r_bg(
function(px, tmp) {
- p <- processx::process$new(px, c("outln", "ok", "sleep", "100"),
- stdout = tmp, cleanup = FALSE)
- list(pid = p$get_pid(), create_time = p$get_start_time(),
- id = p$.__enclos_env__$private$tree_id)
+ p <- processx::process$new(
+ px,
+ c("outln", "ok", "sleep", "100"),
+ stdout = tmp,
+ cleanup = FALSE
+ )
+ list(
+ pid = p$get_pid(),
+ create_time = p$get_start_time(),
+ id = p$.__enclos_env__$private$tree_id
+ )
},
args = list(px = get_tool("px"), tmp = tmp)
)
@@ -131,8 +150,11 @@ test_that("kill_tree and orphaned children", {
expect_true(ps::ps_is_running(ps))
deadline <- Sys.time() + 2
- while ((!file.exists(tmp) || file_size(tmp) == 0) &&
- Sys.time() < deadline) Sys.sleep(0.05)
+ while (
+ (!file.exists(tmp) || file_size(tmp) == 0) &&
+ Sys.time() < deadline
+ )
+ Sys.sleep(0.05)
expect_true(Sys.time() < deadline)
res <- p1$kill_tree(pres$id)
diff --git a/tests/testthat/test-poll-connections.R b/tests/testthat/test-poll-connections.R
index 406b317c..d8b40e31 100644
--- a/tests/testthat/test-poll-connections.R
+++ b/tests/testthat/test-poll-connections.R
@@ -1,6 +1,4 @@
-
test_that("poll a connection", {
-
px <- get_tool("px")
p <- process$new(px, c("sleep", ".5", "outln", "foobar"), stdout = "|")
on.exit(p$kill())
@@ -19,7 +17,6 @@ test_that("poll a connection", {
})
test_that("poll a connection and a process", {
-
px <- get_tool("px")
p1 <- process$new(px, c("sleep", ".5", "outln", "foobar"), stdout = "|")
p2 <- process$new(px, c("sleep", ".5", "outln", "foobar"), stdout = "|")
@@ -32,25 +29,26 @@ test_that("poll a connection and a process", {
poll(list(out, p2), 0),
list(
"timeout",
- c(output = "timeout", error = "nopipe", process = "nopipe"))
+ c(output = "timeout", error = "nopipe", process = "nopipe")
+ )
)
## At least one of them is ready. Usually both on Unix, but on Windows
## it is different because the IOCP is a queue
pr <- poll(list(out, p2), 2000)
- expect_true(pr[[1]] == "ready" || pr[[2]][["output"]] == "ready")
+ expect_true(pr[[1]] == "ready" || pr[[2]][["output"]] == "ready")
p1$poll_io(2000)
p2$poll_io(2000)
p1$read_output_lines()
p2$read_output_lines()
pr <- poll(list(out, p2), 2000)
- expect_true(pr[[1]] == "ready" || pr[[2]][["output"]] == "ready")
+ expect_true(pr[[1]] == "ready" || pr[[2]][["output"]] == "ready")
p1$kill(close_connections = FALSE)
p2$kill(close_connections = FALSE)
pr <- poll(list(out, p2), 2000)
- expect_true(pr[[1]] == "ready" || pr[[2]][["output"]] == "ready")
+ expect_true(pr[[1]] == "ready" || pr[[2]][["output"]] == "ready")
close(out)
close(p2$get_output_connection())
diff --git a/tests/testthat/test-poll-curl.R b/tests/testthat/test-poll-curl.R
index 0d45069d..3f786cda 100644
--- a/tests/testthat/test-poll-curl.R
+++ b/tests/testthat/test-poll-curl.R
@@ -1,4 +1,3 @@
-
test_that("curl fds", {
skip_on_cran()
@@ -10,41 +9,51 @@ test_that("curl fds", {
pool <- curl::new_pool()
url1 <- httpbin$url("/status/200")
url2 <- httpbin$url("/delay/1")
- curl::multi_add(pool = pool, curl::new_handle(url = url1),
- done = done, fail = fail)
- curl::multi_add(pool = pool, curl::new_handle(url = url1),
- done = done, fail = fail)
- curl::multi_add(pool = pool, curl::new_handle(url = url2),
- done = done, fail = fail)
- curl::multi_add(pool = pool, curl::new_handle(url = url1),
- done = done, fail = fail)
- curl::multi_add(pool = pool, curl::new_handle(url = url1),
- done = done, fail = fail)
+ curl::multi_add(
+ pool = pool,
+ curl::new_handle(url = url1, http_version = 2),
+ done = done,
+ fail = fail
+ )
+ curl::multi_add(
+ pool = pool,
+ curl::new_handle(url = url1, http_version = 2),
+ done = done,
+ fail = fail
+ )
+ curl::multi_add(
+ pool = pool,
+ curl::new_handle(url = url2, http_version = 2),
+ done = done,
+ fail = fail
+ )
+ curl::multi_add(
+ pool = pool,
+ curl::new_handle(url = url1, http_version = 2),
+ done = done,
+ fail = fail
+ )
+ curl::multi_add(
+ pool = pool,
+ curl::new_handle(url = url1, http_version = 2),
+ done = done,
+ fail = fail
+ )
+
+ # This does not do much, but at least it tests that we can poll()
+ # libcurl's file descriptors
timeout <- Sys.time() + 5
repeat {
- state <- curl::multi_run(timeout = 1/10000, pool = pool, poll = TRUE)
fds <- curl::multi_fdset(pool = pool)
- if (length(fds$reads) > 0) break;
- if (Sys.time() >= timeout) break;
- }
-
- expect_true(Sys.time() < timeout)
-
- xfds <- list()
- xpr <- character()
-
- while (state$pending > 0) {
- fds <- curl::multi_fdset(pool = pool)
- xfds <- c(xfds, fds["reads"])
- pr <- poll(list(curl_fds(fds)), 2000)
- xpr <- c(xpr, pr[[1]])
+ if (length(fds$reads) > 0) {
+ pr <- poll(list(curl_fds(fds)), 1000)
+ }
state <- curl::multi_run(timeout = 0.1, pool = pool, poll = TRUE)
+ if (state$pending == 0 || Sys.time() >= timeout) break
}
- expect_true(all(vapply(xfds, length, 1L) > 0))
- expect_true(all(xpr == "event"))
-
+ expect_true(Sys.time() < timeout)
expect_equal(vapply(resp, "[[", "", "url"), c(rep(url1, 4), url2))
})
@@ -53,14 +62,14 @@ test_that("curl fds before others", {
pool <- curl::new_pool()
url <- httpbin$url("/delay/1")
- curl::multi_add(pool = pool, curl::new_handle(url = url))
+ curl::multi_add(pool = pool, curl::new_handle(url = url, http_version = 2))
timeout <- Sys.time() + 5
repeat {
- state <- curl::multi_run(timeout = 1/10000, pool = pool, poll = TRUE)
+ state <- curl::multi_run(timeout = 1 / 10000, pool = pool, poll = TRUE)
fds <- curl::multi_fdset(pool = pool)
- if (length(fds$reads) > 0) break;
- if (Sys.time() >= timeout) break;
+ if (length(fds$reads) > 0) break
+ if (Sys.time() >= timeout) break
}
expect_true(Sys.time() < timeout)
@@ -72,8 +81,7 @@ test_that("curl fds before others", {
pr <- poll(list(pp, curl_fds(fds)), 10000)
expect_equal(
pr,
- list(c(output = "nopipe", error = "nopipe", process = "silent"),
- "event")
+ list(c(output = "nopipe", error = "nopipe", process = "silent"), "event")
)
pp$kill()
@@ -84,14 +92,14 @@ test_that("process fd before curl fd", {
pool <- curl::new_pool()
url <- httpbin$url("/delay/1")
- curl::multi_add(pool = pool, curl::new_handle(url = url))
+ curl::multi_add(pool = pool, curl::new_handle(url = url, http_version = 2))
timeout <- Sys.time() + 5
repeat {
- state <- curl::multi_run(timeout = 1/10000, pool = pool, poll = TRUE)
+ state <- curl::multi_run(timeout = 1 / 10000, pool = pool, poll = TRUE)
fds <- curl::multi_fdset(pool = pool)
- if (length(fds$reads) > 0) break;
- if (Sys.time() >= timeout) break;
+ if (length(fds$reads) > 0) break
+ if (Sys.time() >= timeout) break
}
expect_true(Sys.time() < timeout)
@@ -103,8 +111,7 @@ test_that("process fd before curl fd", {
pr <- poll(list(pp, curl_fds(fds)), 10000)
expect_equal(
pr,
- list(c(output = "nopipe", error = "nopipe", process = "ready"),
- "silent")
+ list(c(output = "nopipe", error = "nopipe", process = "ready"), "silent")
)
pp$kill()
diff --git a/tests/testthat/test-poll-stress.R b/tests/testthat/test-poll-stress.R
index bac2cae9..56065759 100644
--- a/tests/testthat/test-poll-stress.R
+++ b/tests/testthat/test-poll-stress.R
@@ -1,4 +1,3 @@
-
test_that("many processes", {
skip_on_cran()
@@ -7,9 +6,8 @@ test_that("many processes", {
px <- get_tool("px")
on.exit(try(lapply(pp, function(x) x$kill()), silent = TRUE), add = TRUE)
pp <- lapply(1:num, function(i) {
- cmd <- c("sleep", "1", "outln", paste("out", i),
- "errln", paste("err", i))
- process$new(px, cmd, stdout = "|", stderr = "|")
+ cmd <- c("sleep", "1", "outln", paste("out", i), "errln", paste("err", i))
+ process$new(px, cmd, stdout = "|", stderr = "|")
})
## poll them
@@ -24,7 +22,10 @@ test_that("many processes", {
results[[i]][[2]] <<- c(results[[i]][[2]], pp[[i]]$read_error_lines())
}
})
- inc <- sapply(pp, function(x) x$is_incomplete_output() || x$is_incomplete_error())
+ inc <- sapply(
+ pp,
+ function(x) x$is_incomplete_output() || x$is_incomplete_error()
+ )
if (!any(inc)) break
}
diff --git a/tests/testthat/test-poll.R b/tests/testthat/test-poll.R
index d8f16de3..6ea067e6 100644
--- a/tests/testthat/test-poll.R
+++ b/tests/testthat/test-poll.R
@@ -1,65 +1,87 @@
-
test_that("polling for output available", {
-
px <- get_tool("px")
p <- process$new(px, c("sleep", "1", "outln", "foobar"), stdout = "|")
## Timeout
- expect_equal(p$poll_io(0), c(output = "timeout", error = "nopipe",
- process = "nopipe"))
+ expect_equal(
+ p$poll_io(0),
+ c(output = "timeout", error = "nopipe", process = "nopipe")
+ )
p$wait()
- expect_equal(p$poll_io(-1), c(output = "ready", error = "nopipe",
- process = "nopipe"))
+ expect_equal(
+ p$poll_io(-1),
+ c(output = "ready", error = "nopipe", process = "nopipe")
+ )
p$read_output_lines()
- expect_equal(p$poll_io(-1), c(output = "ready", error = "nopipe",
- process = "nopipe"))
+ expect_equal(
+ p$poll_io(-1),
+ c(output = "ready", error = "nopipe", process = "nopipe")
+ )
p$kill(close_connections = FALSE)
- expect_equal(p$poll_io(-1), c(output = "ready", error = "nopipe",
- process = "nopipe"))
+ expect_equal(
+ p$poll_io(-1),
+ c(output = "ready", error = "nopipe", process = "nopipe")
+ )
close(p$get_output_connection())
- expect_equal(p$poll_io(-1), c(output = "closed", error = "nopipe",
- process = "nopipe"))
+ expect_equal(
+ p$poll_io(-1),
+ c(output = "closed", error = "nopipe", process = "nopipe")
+ )
})
test_that("polling for stderr", {
-
px <- get_tool("px")
p <- process$new(px, c("sleep", "1", "errln", "foobar"), stderr = "|")
## Timeout
- expect_equal(p$poll_io(0), c(output = "nopipe", error = "timeout",
- process = "nopipe"))
+ expect_equal(
+ p$poll_io(0),
+ c(output = "nopipe", error = "timeout", process = "nopipe")
+ )
p$wait()
- expect_equal(p$poll_io(-1), c(output = "nopipe", error = "ready",
- process = "nopipe"))
+ expect_equal(
+ p$poll_io(-1),
+ c(output = "nopipe", error = "ready", process = "nopipe")
+ )
p$read_error_lines()
- expect_equal(p$poll_io(-1), c(output = "nopipe", error = "ready",
- process = "nopipe"))
+ expect_equal(
+ p$poll_io(-1),
+ c(output = "nopipe", error = "ready", process = "nopipe")
+ )
p$kill(close_connections = FALSE)
- expect_equal(p$poll_io(-1), c(output = "nopipe", error = "ready",
- process = "nopipe"))
+ expect_equal(
+ p$poll_io(-1),
+ c(output = "nopipe", error = "ready", process = "nopipe")
+ )
close(p$get_error_connection())
- expect_equal(p$poll_io(-1), c(output = "nopipe", error = "closed",
- process = "nopipe"))
+ expect_equal(
+ p$poll_io(-1),
+ c(output = "nopipe", error = "closed", process = "nopipe")
+ )
})
test_that("polling for both stdout and stderr", {
-
px <- get_tool("px")
- p <- process$new(px, c("sleep", "1", "errln", "foo", "outln", "bar"),
- stdout = "|", stderr = "|")
+ p <- process$new(
+ px,
+ c("sleep", "1", "errln", "foo", "outln", "bar"),
+ stdout = "|",
+ stderr = "|"
+ )
## Timeout
- expect_equal(p$poll_io(0), c(output = "timeout", error = "timeout",
- process = "nopipe"))
+ expect_equal(
+ p$poll_io(0),
+ c(output = "timeout", error = "timeout", process = "nopipe")
+ )
p$wait()
expect_true("ready" %in% p$poll_io(-1))
@@ -72,16 +94,20 @@ test_that("polling for both stdout and stderr", {
close(p$get_output_connection())
close(p$get_error_connection())
- expect_equal(p$poll_io(-1), c(output = "closed", error = "closed",
- process = "nopipe"))
+ expect_equal(
+ p$poll_io(-1),
+ c(output = "closed", error = "closed", process = "nopipe")
+ )
})
test_that("multiple polls", {
-
px <- get_tool("px")
p <- process$new(
- px, c("sleep", "1", "outln", "foo", "sleep", "1", "outln", "bar"),
- stdout = "|", stderr = "|")
+ px,
+ c("sleep", "1", "outln", "foo", "sleep", "1", "outln", "bar"),
+ stdout = "|",
+ stderr = "|"
+ )
on.exit(p$kill(), add = TRUE)
out <- character()
diff --git a/tests/testthat/test-poll2.R b/tests/testthat/test-poll2.R
index 15c36839..1aa122bc 100644
--- a/tests/testthat/test-poll2.R
+++ b/tests/testthat/test-poll2.R
@@ -1,9 +1,10 @@
-
test_that("single process", {
-
px <- get_tool("px")
- p <- process$new(px, c("sleep", "1", "outln", "foo", "outln", "bar"),
- stdout = "|")
+ p <- process$new(
+ px,
+ c("sleep", "1", "outln", "foo", "outln", "bar"),
+ stdout = "|"
+ )
on.exit(p$kill(), add = TRUE)
## Timeout
@@ -38,7 +39,6 @@ test_that("single process", {
})
test_that("multiple processes", {
-
px <- get_tool("px")
cmd1 <- c("sleep", "1", "outln", "foo", "outln", "bar")
cmd2 <- c("sleep", "2", "errln", "foo", "errln", "bar")
@@ -58,7 +58,10 @@ test_that("multiple processes", {
p1$wait()
res <- poll(list(p1 = p1, p2 = p2), -1)
- expect_equal(res$p1, c(output = "ready", error = "nopipe", process = "nopipe"))
+ expect_equal(
+ res$p1,
+ c(output = "ready", error = "nopipe", process = "nopipe")
+ )
expect_equal(res$p2[["output"]], "nopipe")
expect_true(res$p2[["error"]] %in% c("silent", "ready"))
@@ -82,11 +85,9 @@ test_that("multiple processes", {
p2 = c(output = "nopipe", error = "closed", process = "nopipe")
)
)
-
})
test_that("multiple polls", {
-
px <- get_tool("px")
cmd <- c("sleep", "1", "outln", "foo", "sleep", "1", "outln", "bar")
p <- process$new(px, cmd, stdout = "|", stderr = "|")
@@ -107,10 +108,14 @@ test_that("polling and buffering", {
px <- get_tool("px")
for (i in 1:10) {
-
## We set up two processes, one produces a output, that we do not
## read out from the cache. The other one does not produce output.
- p1 <- process$new(px, c(rbind("outln", 1:20), "sleep", "3"), stdout = "|", stderr = "|")
+ p1 <- process$new(
+ px,
+ c(rbind("outln", 1:20), "sleep", "3"),
+ stdout = "|",
+ stderr = "|"
+ )
p2 <- process$new(px, c("sleep", "3"), stdout = "|", stderr = "|")
## We poll until p1 has output. We read out some of the output,
@@ -136,18 +141,16 @@ test_that("polling and buffering", {
p1$kill()
p2$kill()
- if (s[[2]][1] != "silent") break;
+ if (s[[2]][1] != "silent") break
}
})
test_that("polling and buffering #2", {
-
px <- get_tool("px")
## We run this a bunch of times, because it used to fail
## non-deterministically on the CI
for (i in 1:10) {
-
## Two processes, they both produce output. For the first process,
## we make sure that there is something in the buffer.
## For the second process we need to poll, but data should be
diff --git a/tests/testthat/test-poll3.R b/tests/testthat/test-poll3.R
index 4ded0f5d..8ea92aa4 100644
--- a/tests/testthat/test-poll3.R
+++ b/tests/testthat/test-poll3.R
@@ -1,58 +1,74 @@
-
test_that("poll connection", {
px <- get_tool("px")
p <- process$new(px, c("sleep", ".5", "outln", "foobar"))
on.exit(p$kill())
## Timeout
- expect_equal(p$poll_io(0), c(output = "nopipe", error = "nopipe",
- process = "timeout"))
+ expect_equal(
+ p$poll_io(0),
+ c(output = "nopipe", error = "nopipe", process = "timeout")
+ )
p$wait()
- expect_equal(p$poll_io(-1), c(output = "nopipe", error = "nopipe",
- process = "ready"))
+ expect_equal(
+ p$poll_io(-1),
+ c(output = "nopipe", error = "nopipe", process = "ready")
+ )
p$kill(close_connections = FALSE)
- expect_equal(p$poll_io(-1), c(output = "nopipe", error = "nopipe",
- process = "ready"))
+ expect_equal(
+ p$poll_io(-1),
+ c(output = "nopipe", error = "nopipe", process = "ready")
+ )
close(p$get_poll_connection())
- expect_equal(p$poll_io(-1), c(output = "nopipe", error = "nopipe",
- process = "closed"))
+ expect_equal(
+ p$poll_io(-1),
+ c(output = "nopipe", error = "nopipe", process = "closed")
+ )
})
test_that("poll connection + stdout", {
-
px <- get_tool("px")
p1 <- process$new(px, c("outln", "foobar"), stdout = "|")
on.exit(p1$kill(), add = TRUE)
expect_false(p1$has_poll_connection())
- p2 <- process$new(px, c("sleep", "0.5", "outln", "foobar"), stdout = "|",
- poll_connection = TRUE)
+ p2 <- process$new(
+ px,
+ c("sleep", "0.5", "outln", "foobar"),
+ stdout = "|",
+ poll_connection = TRUE
+ )
on.exit(p2$kill(), add = TRUE)
- expect_equal(p2$poll_io(0), c(output = "timeout", error = "nopipe",
- process = "timeout"))
+ expect_equal(
+ p2$poll_io(0),
+ c(output = "timeout", error = "nopipe", process = "timeout")
+ )
pr <- p2$poll_io(-1)
expect_true("ready" %in% pr)
})
test_that("poll connection + stderr", {
-
px <- get_tool("px")
p1 <- process$new(px, c("errln", "foobar"), stderr = "|")
on.exit(p1$kill(), add = TRUE)
expect_false(p1$has_poll_connection())
- p2 <- process$new(px, c("sleep", "0.5", "errln", "foobar"), stderr = "|",
- poll_connection = TRUE)
+ p2 <- process$new(
+ px,
+ c("sleep", "0.5", "errln", "foobar"),
+ stderr = "|",
+ poll_connection = TRUE
+ )
on.exit(p2$kill(), add = TRUE)
- expect_equal(p2$poll_io(0), c(output = "nopipe", error = "timeout",
- process = "timeout"))
-
+ expect_equal(
+ p2$poll_io(0),
+ c(output = "nopipe", error = "timeout", process = "timeout")
+ )
})
diff --git a/tests/testthat/test-print.R b/tests/testthat/test-print.R
index b031cff0..72001ba1 100644
--- a/tests/testthat/test-print.R
+++ b/tests/testthat/test-print.R
@@ -1,6 +1,4 @@
-
test_that("print", {
-
px <- get_tool("px")
p <- process$new(px, c("sleep", "5"))
on.exit(try_silently(p$kill(grace = 0)), add = TRUE)
diff --git a/tests/testthat/test-process.R b/tests/testthat/test-process.R
index 911ab483..92dd92f8 100644
--- a/tests/testthat/test-process.R
+++ b/tests/testthat/test-process.R
@@ -1,6 +1,4 @@
-
test_that("process works", {
-
px <- get_tool("px")
p <- process$new(px, c("sleep", "5"))
on.exit(try_silently(p$kill(grace = 0)), add = TRUE)
@@ -8,7 +6,6 @@ test_that("process works", {
})
test_that("get_exit_status", {
-
px <- get_tool("px")
p <- process$new(px, c("return", "1"))
on.exit(p$kill(), add = TRUE)
@@ -17,30 +14,43 @@ test_that("get_exit_status", {
})
test_that("non existing process", {
- expect_error(process$new(tempfile()))
+ expect_snapshot(
+ error = TRUE,
+ process$new(tempfile()),
+ transform = transform_tempdir,
+ variant = sysname()
+ )
## This closes connections in finalizers
gc()
})
test_that("post processing", {
-
px <- get_tool("px")
p <- process$new(
- px, c("return", "0"), post_process = function() "foobar")
+ px,
+ c("return", "0"),
+ post_process = function() "foobar"
+ )
p$wait(5000)
p$kill()
expect_equal(p$get_result(), "foobar")
p <- process$new(
- px, c("sleep", "5"), post_process = function() "yep")
- expect_error(p$get_result(), "alive")
+ px,
+ c("sleep", "5"),
+ post_process = function() "yep"
+ )
+ expect_snapshot(error = TRUE, p$get_result())
p$kill()
expect_equal(p$get_result(), "yep")
## Only runs once
xx <- 0
p <- process$new(
- px, c("return", "0"), post_process = function() xx <<- xx + 1)
+ px,
+ c("return", "0"),
+ post_process = function() xx <<- xx + 1
+ )
p$wait(5000)
p$kill()
p$get_result()
@@ -50,7 +60,7 @@ test_that("post processing", {
})
test_that("working directory", {
- px <- get_tool("px")
+ px <- get_tool("px")
dir.create(tmp <- tempfile())
on.exit(unlink(tmp, recursive = TRUE), add = TRUE)
cat("foo\nbar\n", file = file.path(tmp, "file"))
@@ -63,7 +73,12 @@ test_that("working directory", {
test_that("working directory does not exist", {
px <- get_tool("px")
- expect_error(process$new(px, wd = tempfile()))
+ expect_snapshot(
+ error = TRUE,
+ process$new(px, wd = tempfile()),
+ transform = transform_px,
+ variant = sysname()
+ )
## This closes connections in finalizers
gc()
})
@@ -228,3 +243,101 @@ test_that("can exit or sigkill parent of cleanup process", {
tools::pskill(p$get_pid(), tools::SIGKILL)
poll_until(function() !ps::ps_is_running(cleanup_p))
})
+
+test_that("can kill process with grace", {
+ # https://github.com/r-lib/callr/pull/250
+ skip_if_not_installed("callr", "3.7.3.9001")
+
+ withr::local_envvar("PROCESSX_R_SIGTERM_CLEANUP" = "true")
+
+ # Write subprocess `tempdir()` to this file
+ out <- tempfile()
+ defer(rimraf(out))
+
+ fn <- function(file) {
+ file.create(tempfile())
+ cat(paste0(tempdir(), "\n"), file = file)
+ }
+ get_temp_dir <- function(frame = parent.frame()) {
+ dir <- readLines(out)
+ expect_length(dir, 1)
+ defer(rimraf(dir), frame = frame)
+ dir
+ }
+
+ # Check that SIGTERM was called on subprocess by examining side
+ # effect of tempdir cleanup
+ p <- callr::r_session$new()
+ p$run(fn, list(file = out))
+ dir <- get_temp_dir()
+ p$kill(grace = 0.1)
+ poll_until(function() !dir.exists(dir))
+
+ # When `grace` is 0, the tempdir isn't cleaned up
+ p <- callr::r_session$new()
+ p$run(fn, list(file = out))
+ dir <- get_temp_dir()
+ p$kill(grace = 0)
+ expect_true(dir.exists(dir))
+})
+
+test_that("can use custom `cleanup_signal`", {
+ # https://github.com/r-lib/callr/pull/250
+ skip_if_not_installed("callr", "3.7.3.9001")
+
+ withr::local_envvar("PROCESSX_R_SIGTERM_CLEANUP" = "true")
+
+ # Should become the default in callr
+ opts <- callr::r_process_options(
+ extra = list(
+ cleanup_grace = 0.1
+ )
+ )
+ p <- callr::r_session$new(opts)
+
+ out <- tempfile()
+ defer(rimraf(out))
+
+ fn <- function(file) {
+ file.create(tempfile())
+ writeLines(tempdir(), file)
+ }
+ p$run(fn, list(file = out))
+
+ dir <- readLines(out)
+ defer(rimraf(dir))
+
+ # GC `p` to trigger finalizer
+ rm(p)
+ gc()
+
+ # Needs POSIX signals
+ skip_on_os("windows")
+
+ # As usual we verify the delivery of SIGTERM by checking that the
+ # callr cleanup handler kicked in and deleted the tempdir
+ expect_false(dir.exists(dir))
+})
+
+test_that("can load sigtermignore", {
+ p <- callr::r_session$new()
+ defer(p$kill())
+
+ p$run(load_sigtermignore)
+
+ tools::pskill(p$get_pid(), tools::SIGTERM)
+ tools::pskill(p$get_pid(), tools::SIGTERM)
+
+ expect_true(p$is_alive())
+})
+
+test_that("can kill with SIGTERM when ignored", {
+ p <- callr::r_session$new()
+ defer(p$kill())
+
+ p$run(load_sigtermignore)
+
+ p$signal(tools::SIGTERM)
+ Sys.sleep(0.05)
+ expect_true(p$is_alive())
+})
diff --git a/tests/testthat/test-ps-methods.R b/tests/testthat/test-ps-methods.R
index cb9e3529..27481e4a 100644
--- a/tests/testthat/test-ps-methods.R
+++ b/tests/testthat/test-ps-methods.R
@@ -1,4 +1,3 @@
-
test_that("ps methods", {
skip_if_no_ps()
diff --git a/tests/testthat/test-pty.R b/tests/testthat/test-pty.R
index 6a243852..c5a01e5e 100644
--- a/tests/testthat/test-pty.R
+++ b/tests/testthat/test-pty.R
@@ -1,8 +1,10 @@
-
test_that("fails in windows", {
skip_other_platforms("windows")
- expect_error(process$new("R", pty = TRUE), "only implemented on Unix",
- class = "error")
+ expect_error(
+ process$new("R", pty = TRUE),
+ "only implemented on Unix",
+ class = "error"
+ )
})
test_that("pty works", {
@@ -58,7 +60,7 @@ test_that("read_output_lines() fails for pty", {
p <- process$new("cat", pty = TRUE)
p$write_input("foobar\n")
- expect_error(p$read_output_lines(), "Cannot read lines from a pty")
+ expect_snapshot(error = TRUE, p$read_output_lines())
pr <- p$poll_io(300)
expect_equal(pr[["output"]], "ready")
diff --git a/tests/testthat/test-run.R b/tests/testthat/test-run.R
index 604a2414..4ac9dfb7 100644
--- a/tests/testthat/test-run.R
+++ b/tests/testthat/test-run.R
@@ -1,15 +1,15 @@
-
test_that("run can run", {
-
px <- get_tool("px")
- expect_error({
- run(px, c("sleep", "0"))
- }, NA)
+ expect_error(
+ {
+ run(px, c("sleep", "0"))
+ },
+ NA
+ )
gc()
})
test_that("timeout works", {
-
px <- get_tool("px")
tic <- Sys.time()
x <- run(px, c("sleep", "5"), timeout = 0.00001, error_on_status = FALSE)
@@ -21,7 +21,6 @@ test_that("timeout works", {
})
test_that("timeout throws right error", {
-
px <- get_tool("px")
e <- tryCatch(
run(px, c("sleep", "5"), timeout = 0.00001, error_on_status = TRUE),
@@ -33,14 +32,14 @@ test_that("timeout throws right error", {
})
test_that("callbacks work", {
-
px <- get_tool("px")
## This typically freezes on Unix, if there is a malloc/free race
## condition in the SIGCHLD handler.
for (i in 1:30) {
out <- NULL
run(
- px, rbind("outln", 1:20),
+ px,
+ rbind("outln", 1:20),
stdout_line_callback = function(x, ...) out <<- c(out, x)
)
expect_equal(out, as.character(1:20))
@@ -50,7 +49,8 @@ test_that("callbacks work", {
for (i in 1:30) {
out <- NULL
run(
- px, rbind("errln", 1:20),
+ px,
+ rbind("errln", 1:20),
stderr_line_callback = function(x, ...) out <<- c(out, x),
error_on_status = FALSE
)
@@ -66,7 +66,7 @@ test_that("working directory", {
cat("foo\nbar\n", file = file.path(tmp, "file"))
x <- run(px, c("cat", "file"), wd = tmp)
- if (is_windows()) {
+ if (is_windows()) {
expect_equal(x$stdout, "foo\r\nbar\r\n")
} else {
expect_equal(x$stdout, "foo\nbar\n")
@@ -76,7 +76,12 @@ test_that("working directory", {
test_that("working directory does not exist", {
px <- get_tool("px")
- expect_error(run(px, wd = tempfile()))
+ expect_snapshot(
+ error = TRUE,
+ run(px, wd = tempfile()),
+ transform = transform_px,
+ variant = sysname()
+ )
gc()
})
@@ -84,12 +89,16 @@ test_that("stderr_to_stdout", {
px <- get_tool("px")
out <- run(
- px, c("out", "o1", "err", "e1", "out", "o2", "err", "e2", "outln", ""),
- stderr_to_stdout = TRUE)
+ px,
+ c("out", "o1", "err", "e1", "out", "o2", "err", "e2", "outln", ""),
+ stderr_to_stdout = TRUE
+ )
expect_equal(out$status, 0L)
expect_equal(
- out$stdout, paste0("o1e1o2e2", if (is_windows()) "\r", "\n"))
+ out$stdout,
+ paste0("o1e1o2e2", if (is_windows()) "\r", "\n")
+ )
expect_equal(out$stderr, NULL)
expect_false(out$timeout)
})
@@ -105,7 +114,8 @@ test_that("condition on interrupt", {
cnd <- tryCatch(
interrupt_me(run(px, c("errln", "oops", "errflush", "sleep", 3)), 0.5),
error = function(c) c,
- interrupt = function(c) c)
+ interrupt = function(c) c
+ )
expect_s3_class(cnd, "system_command_interrupt")
expect_equal(str_trim(cnd$stderr), "oops")
@@ -122,7 +132,8 @@ test_that("stdin", {
expect_equal(
strsplit(res$stdout, "\r?\n")[[1]],
- c("foobar", "this is the input"))
+ c("foobar", "this is the input")
+ )
})
test_that("drop stdout", {
@@ -152,7 +163,12 @@ test_that("redirect stout", {
on.exit(unlink(c(tmp1, tmp2)), add = TRUE)
px <- get_tool("px")
- res <- run(px, c("outln", "boo", "errln", "bah"), stdout = tmp1, stderr = tmp2)
+ res <- run(
+ px,
+ c("outln", "boo", "errln", "bah"),
+ stdout = tmp1,
+ stderr = tmp2
+ )
expect_null(res$stdout)
expect_null(res$stderr)
expect_equal(readLines(tmp1), "boo")
diff --git a/tests/testthat/test-set-std.R b/tests/testthat/test-set-std.R
index fe9b5ad8..32fcee62 100644
--- a/tests/testthat/test-set-std.R
+++ b/tests/testthat/test-set-std.R
@@ -1,4 +1,3 @@
-
test_that("setting stdout to a file", {
stdout_to_file <- function(filename) {
con <- processx::conn_create_file(filename, write = TRUE)
@@ -13,7 +12,8 @@ test_that("setting stdout to a file", {
on.exit(unlink(tmp), add = TRUE)
opt <- callr::r_process_options(
func = stdout_to_file,
- args = list(filename = tmp))
+ args = list(filename = tmp)
+ )
on.exit(p$kill(), add = TRUE)
p <- callr::r_process$new(opt)
@@ -40,7 +40,8 @@ test_that("setting stderr to a file", {
on.exit(unlink(tmp), add = TRUE)
opt <- callr::r_process_options(
func = stderr_to_file,
- args = list(filename = tmp))
+ args = list(filename = tmp)
+ )
on.exit(p$kill(), add = TRUE)
p <- callr::r_process$new(opt)
@@ -75,7 +76,8 @@ test_that("setting stdout multiple times", {
on.exit(unlink(c(tmp1, tmp2)), add = TRUE)
opt <- callr::r_process_options(
func = stdout_to_file,
- args = list(file1 = tmp1, file2 = tmp2))
+ args = list(file1 = tmp1, file2 = tmp2)
+ )
on.exit(p$kill(), add = TRUE)
p <- callr::r_process$new(opt)
@@ -143,7 +145,8 @@ test_that("set stdout and save the old fd", {
on.exit(unlink(c(tmp1, tmp2)), add = TRUE)
opt <- callr::r_process_options(
func = stdout,
- args = list(file1 = tmp1, file2 = tmp2))
+ args = list(file1 = tmp1, file2 = tmp2)
+ )
on.exit(p$kill(), add = TRUE)
p <- callr::r_process$new(opt)
@@ -172,7 +175,8 @@ test_that("set stderr and save the old fd", {
on.exit(unlink(c(tmp1, tmp2)), add = TRUE)
opt <- callr::r_process_options(
func = stderr,
- args = list(file1 = tmp1, file2 = tmp2))
+ args = list(file1 = tmp1, file2 = tmp2)
+ )
on.exit(p$kill(), add = TRUE)
p <- callr::r_process$new(opt)
diff --git a/tests/testthat/test-sigchld.R b/tests/testthat/test-sigchld.R
index 156ad93c..a1c648b4 100644
--- a/tests/testthat/test-sigchld.R
+++ b/tests/testthat/test-sigchld.R
@@ -1,4 +1,3 @@
-
test_that("is_alive()", {
skip_other_platforms("unix")
skip_on_cran()
@@ -47,7 +46,14 @@ test_that("finalizer", {
p <- mcparallel(Sys.sleep(1))
q <- mcparallel(Sys.sleep(1))
res <- mccollect(list(p, q))
- tryCatch({ rm(px); gc(); "OK" }, error = function(x) x)
+ tryCatch(
+ {
+ rm(px)
+ gc()
+ "OK"
+ },
+ error = function(x) x
+ )
})
expect_identical(res$result, "OK")
@@ -100,7 +106,7 @@ test_that("signal", {
q <- mcparallel(Sys.sleep(1))
res <- mccollect(list(p, q))
- signal <- px$signal(2) # SIGINT
+ signal <- px$signal(2) # SIGINT
status <- px$get_exit_status()
list(signal = signal, status = status)
})
@@ -163,11 +169,14 @@ test_that("SIGCHLD handler", {
q <- mcparallel(Sys.sleep(1))
res <- mccollect(list(p, q))
- out <- tryCatch({
- px2 <- process$new("true")
- px2$wait(1)
- "OK"
- }, error = function(e) e)
+ out <- tryCatch(
+ {
+ px2 <- process$new("true")
+ px2$wait(1)
+ "OK"
+ },
+ error = function(e) e
+ )
list(out = out, status = px$get_exit_status())
})
diff --git a/tests/testthat/test-standalone-errors.R b/tests/testthat/test-standalone-errors.R
index eeec174b..05bfca5e 100644
--- a/tests/testthat/test-standalone-errors.R
+++ b/tests/testthat/test-standalone-errors.R
@@ -1,4 +1,3 @@
-
test_that("throw() is standalone", {
stenv <- environment(throw)
objs <- ls(stenv, all.names = TRUE)
@@ -8,8 +7,12 @@ test_that("throw() is standalone", {
expect_message(
withCallingHandlers(
- res <- mapply(codetools::checkUsage, funobjs, funs,
- MoreArgs = list(report = message)),
+ res <- mapply(
+ codetools::checkUsage,
+ funobjs,
+ funs,
+ MoreArgs = list(report = message)
+ ),
message = function(c) {
if (grepl(".hide_from_trace", c$message)) {
invokeRestart("muffleMessage")
@@ -37,18 +40,23 @@ test_that("new_error", {
test_that("throw() works with condition objects or strings", {
expect_error(
- throw("foobar"), "foobar",
- class = "rlib_error")
+ throw("foobar"),
+ "foobar",
+ class = "rlib_error"
+ )
expect_error(
- throw(new_error("foobar")), "foobar",
- class = "rlib_error")
+ throw(new_error("foobar")),
+ "foobar",
+ class = "rlib_error"
+ )
})
test_that("parent must be an error object", {
expect_error(
throw(new_error("foobar"), parent = "nope"),
"Parent condition must be a condition object",
- class = "rlib_error")
+ class = "rlib_error"
+ )
})
test_that("throw() adds the proper call, if requested", {
@@ -77,7 +85,6 @@ test_that("caught conditions have no trace", {
})
test_that("un-caught condition has trace", {
-
skip_on_cran()
# We need to run this in a separate script, because
@@ -90,14 +97,17 @@ test_that("un-caught condition has trace", {
se <- paste0(sf, "err")
on.exit(unlink(c(sf, op, so, se), recursive = TRUE), add = TRUE)
- expr <- substitute({
- f <- function() g()
- g <- function() processx:::throw(processx:::new_error("oooops"))
- options(rlib_error_handler = function(c) {
- saveRDS(c, file = `__op__`)
- })
- f()
- }, list("__op__" = op))
+ expr <- substitute(
+ {
+ f <- function() g()
+ g <- function() processx:::throw(processx:::new_error("oooops"))
+ options(rlib_error_handler = function(c) {
+ saveRDS(c, file = `__op__`)
+ })
+ f()
+ },
+ list("__op__" = op)
+ )
cat(deparse(expr), file = sf, sep = "\n")
@@ -109,13 +119,12 @@ test_that("un-caught condition has trace", {
})
test_that("chain_call", {
-
do <- function() {
chain_call(c_processx_base64_encode, "foobar")
}
cond <- tryCatch(
- do(),
- error = function(e) e
+ do(),
+ error = function(e) e
)
expect_equal(cond$call, "do()")
@@ -128,7 +137,8 @@ test_that("errors from subprocess", {
if (packageVersion("callr") != "3.7.0") skip("only with callr 3.7.0")
err <- tryCatch(
callr::r(function() 1 + "a"),
- error = function(e) e)
+ error = function(e) e
+ )
expect_s3_class(err, "rlib_error")
expect_s3_class(err$parent, "error")
expect_false(is.null(err$parent$trace))
@@ -138,7 +148,8 @@ test_that("errors from subprocess", {
skip_if_not_installed("callr", minimum_version = "3.7.0.9000")
err <- tryCatch(
callr::r(function() 1 + "a"),
- error = function(e) e)
+ error = function(e) e
+ )
expect_s3_class(err, "rlib_error")
expect_s3_class(err$parent, "error")
expect_false(is.null(err$parent_trace))
@@ -155,15 +166,18 @@ test_that("error trace from subprocess", {
se <- paste0(sf, "err")
on.exit(unlink(c(sf, op, so, se), recursive = TRUE), add = TRUE)
- expr <- substitute({
- h <- function() callr::r(function() 1 + "a")
- options(rlib_error_handler = function(c) {
- saveRDS(c, file = `__op__`)
- # quit after the first, because the other one is caught here as well
- q()
- })
- h()
- }, list("__op__" = op))
+ expr <- substitute(
+ {
+ h <- function() callr::r(function() 1 + "a")
+ options(rlib_error_handler = function(c) {
+ saveRDS(c, file = `__op__`)
+ # quit after the first, because the other one is caught here as well
+ q()
+ })
+ h()
+ },
+ list("__op__" = op)
+ )
cat(deparse(expr), file = sf, sep = "\n")
@@ -191,15 +205,18 @@ test_that("error trace from subprocess", {
se <- paste0(sf, "err")
on.exit(unlink(c(sf, op, so, se), recursive = TRUE), add = TRUE)
- expr <- substitute({
- h <- function() callr::r(function() 1 + "a")
- options(rlib_error_handler = function(c) {
- saveRDS(c, file = `__op__`)
- # quit after the first, because the other one is caught here as well
- q()
- })
- h()
- }, list("__op__" = op))
+ expr <- substitute(
+ {
+ h <- function() callr::r(function() 1 + "a")
+ options(rlib_error_handler = function(c) {
+ saveRDS(c, file = `__op__`)
+ # quit after the first, because the other one is caught here as well
+ q()
+ })
+ h()
+ },
+ list("__op__" = op)
+ )
cat(deparse(expr), file = sf, sep = "\n")
@@ -223,15 +240,18 @@ test_that("error trace from throw() in subprocess", {
se <- paste0(sf, "err")
on.exit(unlink(c(sf, op, so, se), recursive = TRUE), add = TRUE)
- expr <- substitute({
- h <- function() callr::r(function() processx::run("does-not-exist---"))
- options(rlib_error_handler = function(c) {
- saveRDS(c, file = `__op__`)
- # quit after the first, because the other one is caught here as well
- q()
- })
- h()
- }, list("__op__" = op))
+ expr <- substitute(
+ {
+ h <- function() callr::r(function() processx::run("does-not-exist---"))
+ options(rlib_error_handler = function(c) {
+ saveRDS(c, file = `__op__`)
+ # quit after the first, because the other one is caught here as well
+ q()
+ })
+ h()
+ },
+ list("__op__" = op)
+ )
cat(deparse(expr), file = sf, sep = "\n")
@@ -259,15 +279,18 @@ test_that("error trace from throw() in subprocess", {
se <- paste0(sf, "err")
on.exit(unlink(c(sf, op, so, se), recursive = TRUE), add = TRUE)
- expr <- substitute({
- h <- function() callr::r(function() processx::run("does-not-exist---"))
- options(rlib_error_handler = function(c) {
- saveRDS(c, file = `__op__`)
- # quit after the first, because the other one is caught here as well
- q()
- })
- h()
- }, list("__op__" = op))
+ expr <- substitute(
+ {
+ h <- function() callr::r(function() processx::run("does-not-exist---"))
+ options(rlib_error_handler = function(c) {
+ saveRDS(c, file = `__op__`)
+ # quit after the first, because the other one is caught here as well
+ q()
+ })
+ h()
+ },
+ list("__op__" = op)
+ )
cat(deparse(expr), file = sf, sep = "\n")
@@ -317,13 +340,12 @@ test_that("error is printed on error", {
selines <- readLines(so)
expect_true(
any(grepl("No such file or directory", selines)) ||
- any(grepl("Command .* not found", selines))
+ any(grepl("Command .* not found", selines))
)
expect_false(any(grepl("Stack trace", selines)))
})
test_that("trace is printed on error in non-interactive sessions", {
-
sf <- tempfile(fileext = ".R")
so <- paste0(sf, "out")
se <- paste0(sf, "err")
@@ -361,9 +383,9 @@ test_that("can pass frame as error call in `new_error()`", {
f <- function() check_bar()
g <- function() check_foo()
- expect_snapshot({
- (expect_error(f()))
- (expect_error(g()))
+ expect_snapshot(error = TRUE, {
+ f()
+ g()
})
})
@@ -377,8 +399,8 @@ test_that("can pass frame as error call in `throw()`", {
f <- function() check_bar()
g <- function() check_foo()
- expect_snapshot({
- (expect_error(f()))
- (expect_error(g()))
+ expect_snapshot(error = TRUE, {
+ f()
+ g()
})
})
diff --git a/tests/testthat/test-stdin.R b/tests/testthat/test-stdin.R
index 95da613e..1c7b2c70 100644
--- a/tests/testthat/test-stdin.R
+++ b/tests/testthat/test-stdin.R
@@ -1,6 +1,4 @@
-
test_that("stdin", {
-
skip_on_cran()
skip_if_no_tool("cat")
@@ -22,7 +20,6 @@ test_that("stdin", {
})
test_that("stdin & stdout", {
-
skip_on_cran()
skip_if_no_tool("cat")
@@ -44,7 +41,6 @@ test_that("stdin & stdout", {
})
test_that("stdin buffer full", {
-
skip_on_cran()
skip_other_platforms("unix")
@@ -60,7 +56,6 @@ test_that("stdin buffer full", {
})
test_that("file as stdin", {
-
skip_on_cran()
skip_if_no_tool("cat")
@@ -79,7 +74,6 @@ test_that("file as stdin", {
})
test_that("large file as stdin", {
-
skip_on_cran()
skip_if_no_tool("cat")
diff --git a/tests/testthat/test-stress.R b/tests/testthat/test-stress.R
index 6109d49d..448dcecb 100644
--- a/tests/testthat/test-stress.R
+++ b/tests/testthat/test-stress.R
@@ -1,4 +1,3 @@
-
test_that("can start 100 processes quickly", {
skip_on_cran()
px <- get_tool("px")
@@ -12,7 +11,7 @@ test_that("run() a lot of times, with small timeouts", {
for (i in 1:100) {
tic <- Sys.time()
err <- tryCatch(
- run(px, c("sleep", "5"), timeout = 1/1000),
+ run(px, c("sleep", "5"), timeout = 1 / 1000),
error = identity
)
expect_s3_class(err, "system_command_timeout_error")
@@ -27,7 +26,7 @@ test_that("run() and kill while polling", {
for (i in 1:10) {
tic <- Sys.time()
err <- tryCatch(
- run(px, c("sleep", "5"), timeout = 1/2),
+ run(px, c("sleep", "5"), timeout = 1 / 2),
error = identity
)
expect_s3_class(err, "system_command_timeout_error")
diff --git a/tests/testthat/test-unix-sockets.R b/tests/testthat/test-unix-sockets.R
index 9f1a376d..b84d8603 100644
--- a/tests/testthat/test-unix-sockets.R
+++ b/tests/testthat/test-unix-sockets.R
@@ -1,4 +1,3 @@
-
test_that("CRUD", {
skip_on_cran()
@@ -32,7 +31,7 @@ test_that("CRUD", {
conn_accept_unix_socket(sock1)
expect_equal(conn_unix_socket_state(sock1), "connected_server")
- expect_error(conn_accept_unix_socket(sock1), "Socket is not listening")
+ expect_snapshot(error = TRUE, conn_accept_unix_socket(sock1))
pr <- poll(list(sock1, sock2), 1)
expect_equal(pr, list("timeout", "timeout"))
@@ -126,7 +125,7 @@ test_that("reading unaccepted server socket is error", {
list("connect")
)
- expect_error(conn_read_chars(sock1))
+ expect_snapshot(error = TRUE, conn_read_chars(sock1), variant = sysname())
close(sock1)
close(sock2)
@@ -147,7 +146,7 @@ test_that("writing unaccepted server socket is error", {
list("connect")
)
- expect_error(conn_write(sock1, "Hello\n"))
+ expect_snapshot(error = TRUE, conn_write(sock1, "Hello\n"))
close(sock1)
close(sock2)
@@ -180,6 +179,8 @@ test_that("here is no extra ready for poll(), without data", {
test_that("closing the other end finishes `poll()`, on macOS", {
skip_on_cran()
+ # seems fragile in covr
+ skip_on_covr()
sock <- tempfile()
on.exit(unlink(sock), add = TRUE)
@@ -225,15 +226,21 @@ test_that("errors", {
if (!is_windows()) {
sock <- file.path(tempdir(), strrep(basename(tempfile()), 1000))
- expect_error(conn_create_unix_socket(sock))
- expect_error(conn_create_unix_socket("/dev/null"))
- expect_error(conn_connect_unix_socket("/dev/null"))
+ expect_snapshot(
+ error = TRUE,
+ {
+ conn_create_unix_socket(sock)
+ conn_create_unix_socket("/dev/null")
+ conn_connect_unix_socket("/dev/null")
+ },
+ transform = transform_tempdir,
+ variant = sysname()
+ )
}
ff <- conn_create_fifo()
- expect_error(conn_accept_unix_socket(ff))
-
- expect_error(conn_unix_socket_state(ff))
+ expect_snapshot(error = TRUE, conn_accept_unix_socket(ff))
+ expect_snapshot(error = TRUE, conn_unix_socket_state(ff))
})
test_that("unix-sockets.h", {
diff --git a/tests/testthat/test-utf8.R b/tests/testthat/test-utf8.R
index a98bc8a4..0814fda0 100644
--- a/tests/testthat/test-utf8.R
+++ b/tests/testthat/test-utf8.R
@@ -1,4 +1,3 @@
-
test_that("UTF-8 executable name", {
skip_on_cran()
local_temp_dir()
@@ -40,16 +39,6 @@ test_that("UTF-8 directory name", {
expect_equal(out$status, 10)
})
-test_that("UTF-8 argument", {
- skip_other_platforms("windows")
- local_temp_dir()
- unc <- "\u00fa\u00e1\u00f6\u0151\u00e9\u0414\u041e\u0411\u0420\u041e"
- out <- run(get_tool("pxu"), c("writefile", "of", unc))
- outarg <- readBin("of", what = "raw", n = 200)
- exp <- iconv(unc, from = "UTF-8", to = "UTF-16LE", toRaw = TRUE)[[1]]
- expect_equal(exp, outarg)
-})
-
test_that("native program name is converted to UTF-8", {
skip_other_platforms("windows")
if (!l10n_info()$`Latin-1`) skip("Needs latin1 locale")
@@ -60,25 +49,6 @@ test_that("native program name is converted to UTF-8", {
expect_equal(out$status, 10)
})
-test_that("native args are converted to UTF-8", {
- skip_other_platforms("windows")
- if (!l10n_info()$`Latin-1`) skip("Needs latin1 locale")
- local_temp_dir()
- name <- enc2native("\u00fa\u00e1\u00f6")
-
- out <- run(get_tool("px"), c("writefile", "of", name))
- expect_equal(
- charToRaw(name),
- readBin("of", what = "raw", n = 100)
- )
-
- out2 <- run(get_tool("pxu"), c("writefile", "of2", name))
- expect_equal(
- iconv(name, to = "UTF-16LE", toRaw = TRUE)[[1]],
- readBin("of2", what = "raw", n = 100)
- )
-})
-
# TODO: more UTF-8 output
test_that("UTF-8 in stdout", {
diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R
index 0f2b8a00..9c1e0764 100644
--- a/tests/testthat/test-utils.R
+++ b/tests/testthat/test-utils.R
@@ -1,6 +1,4 @@
-
test_that("full_path gives correct values", {
-
skip_on_cran()
if (is_windows()) {
@@ -20,12 +18,17 @@ test_that("full_path gives correct values", {
expect_identical(full_path("a/../b/c"), file.path(getwd(), "b/c"))
expect_identical(
full_path(
- "../../../../../../../../../../../../../../../../../../../../../../../a"),
- file.path(drive, "a"))
+ "../../../../../../../../../../../../../../../../../../../../../../../a"
+ ),
+ file.path(drive, "a")
+ )
expect_identical(full_path("/../.././a"), file.path(drive, "a"))
expect_identical(full_path("/a/./b/../c"), file.path(drive, "a/c"))
- expect_identical(full_path("~nonexistent_user"), file.path(getwd(), "~nonexistent_user"))
+ expect_identical(
+ full_path("~nonexistent_user"),
+ file.path(getwd(), "~nonexistent_user")
+ )
expect_identical(
full_path("~/a/../b"),
# On Windows, path.expand() can return a path with backslashes
@@ -62,9 +65,11 @@ test_that("full_path gives correct values, windows", {
# Can't go .. to remove the server name
expect_identical(full_path("//a/b/../.."), "//a/")
expect_identical(full_path("//a/../b"), "//a/b")
- expect_error(full_path("//"))
- expect_error(full_path("///"))
- expect_error(full_path("///a"))
+ expect_snapshot(error = TRUE, {
+ full_path("//")
+ full_path("///")
+ full_path("///a")
+ })
})
test_that("full_path gives correct values, unix", {
@@ -89,7 +94,6 @@ test_that("do_echo_cmd", {
})
test_that("sh_quote_smart", {
-
cases <- list(
list(c("foo", "bar")),
list(character()),
@@ -114,7 +118,8 @@ test_that("base64", {
for (i in 5:32) {
mtcars2 <- unserialize(base64_decode(base64_encode(
- serialize(mtcars[1:i, ], NULL))))
- expect_identical(mtcars[1:i,], mtcars2)
+ serialize(mtcars[1:i, ], NULL)
+ )))
+ expect_identical(mtcars[1:i, ], mtcars2)
}
})
diff --git a/tests/testthat/test-wait.R b/tests/testthat/test-wait.R
index 17adb652..84c1dc1e 100644
--- a/tests/testthat/test-wait.R
+++ b/tests/testthat/test-wait.R
@@ -1,6 +1,4 @@
-
test_that("no deadlock when no stdout + wait", {
-
skip("failure would freeze")
p <- process$new("seq", c("1", "100000"))
@@ -8,7 +6,6 @@ test_that("no deadlock when no stdout + wait", {
})
test_that("wait with timeout", {
-
px <- get_tool("px")
p <- process$new(px, c("sleep", "3"))
expect_true(p$is_alive())
@@ -18,22 +15,23 @@ test_that("wait with timeout", {
t2 <- proc.time()
expect_true(p$is_alive())
- expect_true((t2 - t1)["elapsed"] > 50/1000)
- expect_true((t2 - t1)["elapsed"] < 3000/1000)
+ expect_true((t2 - t1)["elapsed"] > 50 / 1000)
+ expect_true((t2 - t1)["elapsed"] < 3000 / 1000)
p$kill()
expect_false(p$is_alive())
})
test_that("wait after process already exited", {
-
px <- get_tool("px")
- pxs <- replicate(20, process$new(px, c("outln", "foo", "outln", "bar")))
+ pxs <- replicate(20, process$new(px, c("outln", "foo", "outln", "bar")))
rm(pxs)
p <- process$new(
- px, c("outln", "foo", "outln", "bar", "outln", "foobar"))
+ px,
+ c("outln", "foo", "outln", "bar", "outln", "foobar")
+ )
on.exit(p$kill(), add = TRUE)
## Make sure it is done
diff --git a/tools/valgrind.supp b/tools/valgrind.supp
new file mode 100644
index 00000000..c043248c
--- /dev/null
+++ b/tools/valgrind.supp
@@ -0,0 +1,540 @@
+{
+ Suppression 1 for setenv in processx
+ Memcheck:Leak
+ match-leak-kinds: possible
+ fun:malloc
+ fun:tsearch
+ fun:__add_to_environ
+ fun:setenv
+ fun:do_setenv
+ fun:bcEval_loop
+ fun:bcEval
+ fun:bcEval
+ fun:Rf_eval
+ fun:R_execClosure
+ fun:applyClosure_core
+ fun:Rf_applyClosure
+ fun:Rf_eval
+ fun:forcePromise.part.0
+}
+{
+ Suppressions 2 for setenv in processx
+ Memcheck:Leak
+ match-leak-kinds: possible
+ fun:malloc
+ fun:tsearch
+ fun:__add_to_environ
+ fun:setenv
+ fun:Putenv
+ fun:process_Renviron
+ fun:process_system_Renviron
+ fun:Rf_initialize_R
+ fun:main
+}
+{
+ Suppression 3 for calloc in processx
+ Memcheck:Leak
+ match-leak-kinds: possible
+ fun:calloc
+ fun:UnknownInlinedFun
+ fun:allocate_dtv
+ fun:_dl_allocate_tls
+ fun:pthread_create@@GLIBC_2.34
+ fun:cli__start_thread
+ fun:clic_start_thread
+ fun:R_doDotCall
+ fun:do_dotcall
+ fun:bcEval_loop
+ fun:bcEval
+ fun:bcEval
+ fun:Rf_eval
+ fun:R_execClosure
+}
+{
+ Suppression 4 for calloc in processx
+ Memcheck:Leak
+ match-leak-kinds: possible
+ fun:calloc
+ fun:UnknownInlinedFun
+ fun:allocate_dtv
+ fun:_dl_allocate_tls
+ fun:pthread_create@@GLIBC_2.34
+ fun:blas_thread_init
+ fun:gotoblas_init
+ fun:call_init
+ fun:call_init
+ fun:_dl_init
+ obj:/usr/lib64/ld-linux-x86-64.so.2
+ obj:*
+ obj:*
+ obj:*
+}
+{
+ Suppression 5 for setenv in processx
+ Memcheck:Leak
+ match-leak-kinds: possible
+ fun:malloc
+ fun:tsearch
+ fun:__add_to_environ
+ fun:setenv
+ fun:do_setenv
+ fun:bcEval_loop
+ fun:bcEval
+ fun:bcEval
+ fun:Rf_eval
+ fun:R_execClosure
+ fun:applyClosure_core
+ fun:Rf_applyClosure
+ fun:Rf_eval
+ fun:do_docall
+}
+{
+ Suppression 6 in malloc in processx
+ Memcheck:Leak
+ match-leak-kinds: possible
+ fun:malloc
+ fun:__add_to_environ
+ fun:setenv
+ fun:do_setenv
+ fun:bcEval_loop
+ fun:bcEval
+ fun:bcEval
+ fun:Rf_eval
+ fun:R_execClosure
+ fun:applyClosure_core
+ fun:Rf_applyClosure
+ fun:Rf_eval
+ fun:do_docall
+ fun:bcEval_loop
+}
+{
+ Suppression 7 in malloc in processx
+ Memcheck:Leak
+ match-leak-kinds: possible
+ fun:malloc
+ fun:UnknownInlinedFun
+ fun:_dlfo_mappings_segment_allocate
+ fun:_dl_find_object_update_1
+ fun:_dl_find_object_update
+ fun:dl_open_worker_begin
+ fun:_dl_catch_exception
+ fun:dl_open_worker
+ fun:_dl_catch_exception
+ fun:_dl_open
+ fun:dlopen_doit
+ fun:_dl_catch_exception
+ fun:_dl_catch_error
+ fun:_dlerror_run
+ fun:dlopen@@GLIBC_2.34
+}
+{
+ Suppression 8 in malloc in processx
+ Memcheck:Leak
+ match-leak-kinds: possible
+ fun:malloc
+ fun:tsearch
+ fun:__add_to_environ
+ fun:setenv
+ fun:do_setenv
+ fun:bcEval_loop
+ fun:bcEval
+ fun:bcEval
+ fun:Rf_eval
+ fun:R_execClosure
+ fun:applyClosure_core
+ fun:Rf_applyClosure
+ fun:Rf_eval
+ fun:forcePromise.part.0
+}
+{
+ Suppression 9 in malloc in processx
+ Memcheck:Leak
+ match-leak-kinds: possible
+ fun:malloc
+ fun:tsearch
+ fun:__add_to_environ
+ fun:setenv
+ fun:Putenv
+ fun:process_Renviron
+ fun:process_system_Renviron
+ fun:Rf_initialize_R
+ fun:main
+}
+{
+ Suppression 10 in calloc in processx
+ Memcheck:Leak
+ match-leak-kinds: possible
+ fun:calloc
+ fun:UnknownInlinedFun
+ fun:allocate_dtv
+ fun:_dl_allocate_tls
+ fun:pthread_create@@GLIBC_2.34
+ fun:cli__start_thread
+ fun:clic_start_thread
+ fun:R_doDotCall
+ fun:do_dotcall
+ fun:bcEval_loop
+ fun:bcEval
+ fun:bcEval
+ fun:Rf_eval
+ fun:R_execClosure
+}
+{
+ Suppression 11 in calloc in processx
+ Memcheck:Leak
+ match-leak-kinds: possible
+ fun:calloc
+ fun:UnknownInlinedFun
+ fun:allocate_dtv
+ fun:_dl_allocate_tls
+ fun:pthread_create@@GLIBC_2.34
+ fun:blas_thread_init
+ fun:gotoblas_init
+ fun:call_init
+ fun:call_init
+ fun:_dl_init
+ obj:/usr/lib64/ld-linux-x86-64.so.2
+ obj:*
+ obj:*
+ obj:*
+}
+{
+ Suppression 12 in malloc in processx
+ Memcheck:Leak
+ match-leak-kinds: possible
+ fun:malloc
+ fun:tsearch
+ fun:__add_to_environ
+ fun:setenv
+ fun:do_setenv
+ fun:bcEval_loop
+ fun:bcEval
+ fun:bcEval
+ fun:Rf_eval
+ fun:R_execClosure
+ fun:applyClosure_core
+ fun:Rf_applyClosure
+ fun:Rf_eval
+ fun:do_docall
+}
+{
+ Suppression 13 in malloc in processx
+ Memcheck:Leak
+ match-leak-kinds: possible
+ fun:malloc
+ fun:__add_to_environ
+ fun:setenv
+ fun:do_setenv
+ fun:bcEval_loop
+ fun:bcEval
+ fun:bcEval
+ fun:Rf_eval
+ fun:R_execClosure
+ fun:applyClosure_core
+ fun:Rf_applyClosure
+ fun:Rf_eval
+ fun:do_docall
+ fun:bcEval_loop
+}
+{
+ Suppression 14 in malloc in processx
+ Memcheck:Leak
+ match-leak-kinds: possible
+ fun:malloc
+ fun:UnknownInlinedFun
+ fun:_dlfo_mappings_segment_allocate
+ fun:_dl_find_object_update_1
+ fun:_dl_find_object_update
+ fun:dl_open_worker_begin
+ fun:_dl_catch_exception
+ fun:dl_open_worker
+ fun:_dl_catch_exception
+ fun:_dl_open
+ fun:dlopen_doit
+ fun:_dl_catch_exception
+ fun:_dl_catch_error
+ fun:_dlerror_run
+ fun:dlopen@@GLIBC_2.34
+}
+{
+ Suppression 15 in malloc in processx
+ Memcheck:Leak
+ match-leak-kinds: possible
+ fun:malloc
+ fun:tsearch
+ fun:__add_to_environ
+ fun:setenv
+ fun:Putenv
+ fun:process_Renviron
+ fun:process_system_Renviron
+ fun:Rf_initialize_R
+ fun:main
+}
+{
+ Suppression 16 in malloc in processx
+ Memcheck:Leak
+ match-leak-kinds: possible
+ fun:malloc
+ fun:tsearch
+ fun:__add_to_environ
+ fun:setenv
+ fun:do_setenv
+ fun:bcEval_loop
+ fun:bcEval
+ fun:bcEval
+ fun:Rf_eval
+ fun:R_execClosure
+ fun:applyClosure_core
+ fun:Rf_applyClosure
+ fun:Rf_eval
+ fun:forcePromise.part.0
+}
+{
+ Suppression 17 in malloc in processx
+ Memcheck:Leak
+ match-leak-kinds: possible
+ fun:malloc
+ fun:tsearch
+ fun:__add_to_environ
+ fun:setenv
+ fun:Putenv
+ fun:process_Renviron
+ fun:process_system_Renviron
+ fun:Rf_initialize_R
+ fun:main
+}
+{
+ Suppression 18 in malloc in processx
+ Memcheck:Leak
+ match-leak-kinds: possible
+ fun:calloc
+ fun:UnknownInlinedFun
+ fun:allocate_dtv
+ fun:_dl_allocate_tls
+ fun:pthread_create@@GLIBC_2.34
+ fun:cli__start_thread
+ fun:clic_start_thread
+ fun:R_doDotCall
+ fun:do_dotcall
+ fun:bcEval_loop
+ fun:bcEval
+ fun:bcEval
+ fun:Rf_eval
+ fun:R_execClosure
+}
+{
+ Suppression 19 in calloc in processx
+ Memcheck:Leak
+ match-leak-kinds: possible
+ fun:calloc
+ fun:UnknownInlinedFun
+ fun:allocate_dtv
+ fun:_dl_allocate_tls
+ fun:pthread_create@@GLIBC_2.34
+ fun:blas_thread_init
+ fun:gotoblas_init
+ fun:call_init
+ fun:call_init
+ fun:_dl_init
+ obj:/usr/lib64/ld-linux-x86-64.so.2
+ obj:*
+ obj:*
+ obj:*
+}
+{
+ Suppression 20 in malloc in processx
+ Memcheck:Leak
+ match-leak-kinds: possible
+ fun:malloc
+ fun:tsearch
+ fun:__add_to_environ
+ fun:setenv
+ fun:do_setenv
+ fun:bcEval_loop
+ fun:bcEval
+ fun:bcEval
+ fun:Rf_eval
+ fun:R_execClosure
+ fun:applyClosure_core
+ fun:Rf_applyClosure
+ fun:Rf_eval
+ fun:do_docall
+}
+{
+ Suppression 21 in malloc in processx
+ Memcheck:Leak
+ match-leak-kinds: possible
+ fun:malloc
+ fun:__add_to_environ
+ fun:setenv
+ fun:do_setenv
+ fun:bcEval_loop
+ fun:bcEval
+ fun:bcEval
+ fun:Rf_eval
+ fun:R_execClosure
+ fun:applyClosure_core
+ fun:Rf_applyClosure
+ fun:Rf_eval
+ fun:do_docall
+ fun:bcEval_loop
+}
+{
+ Suppression 22 in malloc in processx
+ Memcheck:Leak
+ match-leak-kinds: possible
+ fun:malloc
+ fun:UnknownInlinedFun
+ fun:_dlfo_mappings_segment_allocate
+ fun:_dl_find_object_update_1
+ fun:_dl_find_object_update
+ fun:dl_open_worker_begin
+ fun:_dl_catch_exception
+ fun:dl_open_worker
+ fun:_dl_catch_exception
+ fun:_dl_open
+ fun:dlopen_doit
+ fun:_dl_catch_exception
+ fun:_dl_catch_error
+ fun:_dlerror_run
+ fun:dlopen@@GLIBC_2.34
+}
+{
+ Suppression 23 in calloc in processx
+ Memcheck:Leak
+ match-leak-kinds: possible
+ fun:calloc
+ fun:UnknownInlinedFun
+ fun:allocate_dtv
+ fun:_dl_allocate_tls
+ fun:pthread_create@@GLIBC_2.34
+ fun:cli__start_thread
+ fun:clic_start_thread
+ fun:R_doDotCall
+ fun:do_dotcall
+ fun:bcEval_loop
+ fun:bcEval
+ fun:bcEval
+ fun:Rf_eval
+ fun:R_execClosure
+}
+{
+ Suppression 24 in malloc in processx
+ Memcheck:Leak
+ match-leak-kinds: possible
+ fun:malloc
+ fun:__add_to_environ
+ fun:setenv
+ fun:do_setenv
+ fun:bcEval_loop
+ fun:bcEval
+ fun:bcEval
+ fun:Rf_eval
+ fun:forcePromise.part.0
+ fun:forcePromise
+ fun:Rf_eval
+ fun:bcEval_loop
+ fun:bcEval
+ fun:bcEval
+ fun:Rf_eval
+}
+{
+ Suppression 25 in malloc in processx
+ Memcheck:Leak
+ match-leak-kinds: possible
+ fun:malloc
+ fun:tsearch
+ fun:__add_to_environ
+ fun:setenv
+ fun:do_setenv
+ fun:bcEval_loop
+ fun:bcEval
+ fun:bcEval
+ fun:Rf_eval
+ fun:forcePromise.part.0
+ fun:forcePromise
+ fun:Rf_eval
+ fun:bcEval_loop
+ fun:bcEval
+ fun:bcEval
+}
+{
+ Suppression 26 in malloc in processx
+ Memcheck:Leak
+ match-leak-kinds: possible
+ fun:malloc
+ fun:__add_to_environ
+ fun:setenv
+ fun:do_setenv
+ fun:bcEval_loop
+ fun:bcEval
+ fun:bcEval
+ fun:Rf_eval
+ fun:forcePromise.part.0
+ fun:forcePromise
+ fun:Rf_eval
+ fun:bcEval_loop
+ fun:bcEval
+ fun:bcEval
+ fun:Rf_eval
+}
+{
+ Suppression 27 in malloc in processx
+ Memcheck:Leak
+ match-leak-kinds: possible
+ fun:malloc
+ fun:tsearch
+ fun:__add_to_environ
+ fun:setenv
+ fun:do_setenv
+ fun:bcEval_loop
+ fun:bcEval
+ fun:bcEval
+ fun:Rf_eval
+ fun:forcePromise.part.0
+ fun:forcePromise
+ fun:Rf_eval
+ fun:bcEval_loop
+ fun:bcEval
+ fun:bcEval
+}
+{
+ Suppression 28 in malloc in processx
+ Memcheck:Leak
+ match-leak-kinds: possible
+ fun:malloc
+ fun:__add_to_environ
+ fun:setenv
+ fun:do_setenv
+ fun:bcEval_loop
+ fun:bcEval
+ fun:bcEval
+ fun:Rf_eval
+ fun:forcePromise.part.0
+ fun:forcePromise
+ fun:Rf_eval
+ fun:bcEval_loop
+ fun:bcEval
+ fun:bcEval
+ fun:Rf_eval
+}
+{
+ Suppression 29 in malloc in processx
+ Memcheck:Leak
+ match-leak-kinds: possible
+ fun:malloc
+ fun:tsearch
+ fun:__add_to_environ
+ fun:setenv
+ fun:do_setenv
+ fun:bcEval_loop
+ fun:bcEval
+ fun:bcEval
+ fun:Rf_eval
+ fun:forcePromise.part.0
+ fun:forcePromise
+ fun:Rf_eval
+ fun:bcEval_loop
+ fun:bcEval
+ fun:bcEval
+}