[med-svn] [r-cran-withr] 03/05: New upstream version 1.0.2
Andreas Tille
tille at debian.org
Fri Sep 29 17:10:03 UTC 2017
This is an automated email from the git hooks/post-receive script.
tille pushed a commit to branch master
in repository r-cran-withr.
commit 7af768a8b69227e809b6080008d436804c62ee29
Author: Andreas Tille <tille at debian.org>
Date: Fri Sep 29 19:07:22 2017 +0200
New upstream version 1.0.2
---
DESCRIPTION | 35 +++++++
MD5 | 33 ++++++
NAMESPACE | 15 +++
NEWS.md | 11 ++
R/collate.R | 15 +++
R/dir.R | 14 +++
R/env.R | 43 ++++++++
R/libpaths.R | 42 ++++++++
R/locale.R | 26 +++++
R/makevars.R | 64 ++++++++++++
R/options.R | 17 +++
R/par.R | 15 +++
R/path.R | 28 +++++
R/sink.R | 95 +++++++++++++++++
R/with.R | 52 ++++++++++
R/with_.R | 90 ++++++++++++++++
R/wrap.R | 24 +++++
README.md | 50 +++++++++
debian/README.test | 8 --
debian/changelog | 5 -
debian/compat | 1 -
debian/control | 25 -----
debian/copyright | 31 ------
debian/docs | 3 -
debian/rules | 5 -
debian/source/format | 1 -
debian/tests/control | 3 -
debian/tests/run-unit-test | 13 ---
debian/watch | 2 -
man/with_.Rd | 54 ++++++++++
man/with_collate.Rd | 25 +++++
man/with_dir.Rd | 26 +++++
man/with_envvar.Rd | 33 ++++++
man/with_libpaths.Rd | 31 ++++++
man/with_locale.Rd | 29 ++++++
man/with_makevars.Rd | 36 +++++++
man/with_options.Rd | 26 +++++
man/with_par.Rd | 28 +++++
man/with_path.Rd | 29 ++++++
man/with_sink.Rd | 41 ++++++++
man/with_temp_libpaths.Rd | 26 +++++
man/withr.Rd | 68 ++++++++++++
tests/testthat.R | 4 +
tests/testthat/test-sink.R | 130 +++++++++++++++++++++++
tests/testthat/test-with.R | 254 +++++++++++++++++++++++++++++++++++++++++++++
45 files changed, 1509 insertions(+), 97 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
new file mode 100644
index 0000000..e3ed752
--- /dev/null
+++ b/DESCRIPTION
@@ -0,0 +1,35 @@
+Encoding: UTF-8
+Package: withr
+Title: Run Code 'With' Temporarily Modified Global State
+Version: 1.0.2
+Authors at R: c(
+ person("Jim", "Hester", , "james.f.hester at gmail.com", role = c("aut", "cre")),
+ person("Kirill", "Müller", , "krlmlr+r at mailbox.org", role = "aut"),
+ person("Hadley", "Wickham", , "hadley at rstudio.com", role = "aut"),
+ person("Winston", "Chang", role = "aut"),
+ person("RStudio", role = "cph"))
+Description: A set of functions to run code 'with' safely and temporarily
+ modified global state. Many of these functions were originally a part of the
+ 'devtools' package, this provides a simple package with limited dependencies
+ to provide access to these functions.
+URL: http://github.com/jimhester/withr
+BugReports: http://github.com/jimhester/withr/issues
+Depends: R (>= 3.0.2)
+License: GPL (>= 2)
+LazyData: true
+Imports: stats, graphics
+Suggests: testthat
+Collate: 'with_.R' 'collate.R' 'dir.R' 'env.R' 'libpaths.R' 'locale.R'
+ 'makevars.R' 'options.R' 'par.R' 'path.R' 'wrap.R' 'sink.R'
+ 'with.R'
+RoxygenNote: 5.0.1
+NeedsCompilation: no
+Packaged: 2016-06-20 12:49:55 UTC; jhester
+Author: Jim Hester [aut, cre],
+ Kirill Müller [aut],
+ Hadley Wickham [aut],
+ Winston Chang [aut],
+ RStudio [cph]
+Maintainer: Jim Hester <james.f.hester at gmail.com>
+Repository: CRAN
+Date/Publication: 2016-06-20 17:32:02
diff --git a/MD5 b/MD5
new file mode 100644
index 0000000..acc5afe
--- /dev/null
+++ b/MD5
@@ -0,0 +1,33 @@
+a07e772cc25d29736891b8273060dec5 *DESCRIPTION
+8c9b6c98df3a7ac762169c0fbe6985c1 *NAMESPACE
+f0e973cb622fc701d9c33c5438f7072c *NEWS.md
+b3ec11ee76b339c4d2ae9e409721039c *R/collate.R
+13ed0fd71ee35cae21d9da32ef81d00b *R/dir.R
+e202b586b599ebd825c856567615b8c7 *R/env.R
+a5ea25ec83c131d9f364d44be7ebe997 *R/libpaths.R
+d5e3df31efc160218e5e41f47d70f00a *R/locale.R
+ededa5297b84820d841825597d7a2340 *R/makevars.R
+3a7ad0bd8fc47af29778f0dcde2d8551 *R/options.R
+7ae96d23abe7df158000f77a73aa1580 *R/par.R
+a02e5528c7efb2d98360ecd6e19bb488 *R/path.R
+141667060bdebd7df4f64cf222926837 *R/sink.R
+e594acf46da18766818a47c92820882b *R/with.R
+3d3bf7e65f26dc616bc20d93b1b92ec9 *R/with_.R
+88e44ec61deb387dd1c2d8a607c420ee *R/wrap.R
+18c40f182effc974e243c3de3ec95913 *README.md
+29000dbdef2470c50ed7fcd428272c05 *man/with_.Rd
+e004bf86411e3021a37e3859625d5084 *man/with_collate.Rd
+c94a2337fbe854529f7d4126c1e2b07a *man/with_dir.Rd
+815437f9ada3c2a392240a5a68f06f63 *man/with_envvar.Rd
+7c812b458155b87f1454b21beba86ba5 *man/with_libpaths.Rd
+14e4745b18998007d2675ec056ba89e5 *man/with_locale.Rd
+8f182360b41388afa8d01b038c0985be *man/with_makevars.Rd
+049733066a626635021b6a2b09f61add *man/with_options.Rd
+b022e5b9b3c042adf806a00571d1c9b7 *man/with_par.Rd
+74bf724782cd546869a094bce6f2a157 *man/with_path.Rd
+aa43d30a4a0404881041b3c7b193a000 *man/with_sink.Rd
+8225733328b46b818df0e6b467f0434c *man/with_temp_libpaths.Rd
+dc4ff003917591c5db30c32a80f17c5c *man/withr.Rd
+70c4d334a0974e15d0309c48ca52ca08 *tests/testthat.R
+a71a65191ace70d64dd670ebf8f8bdb2 *tests/testthat/test-sink.R
+2f345097d2daa74e3415dd509f64c301 *tests/testthat/test-with.R
diff --git a/NAMESPACE b/NAMESPACE
new file mode 100644
index 0000000..6abd5b4
--- /dev/null
+++ b/NAMESPACE
@@ -0,0 +1,15 @@
+# Generated by roxygen2: do not edit by hand
+
+export(with_)
+export(with_collate)
+export(with_dir)
+export(with_envvar)
+export(with_libpaths)
+export(with_locale)
+export(with_makevars)
+export(with_message_sink)
+export(with_options)
+export(with_output_sink)
+export(with_par)
+export(with_path)
+export(with_temp_libpaths)
diff --git a/NEWS.md b/NEWS.md
new file mode 100644
index 0000000..3ecc623
--- /dev/null
+++ b/NEWS.md
@@ -0,0 +1,11 @@
+# 1.0.2
+- `with_makevars()` gains an `assignment` argument to allow specifying
+ additional assignment types.
+
+# 1.0.1
+- Relaxed R version requirement to 3.0.2 (#35, #39).
+- New `with_output_sink()` and `with_message_sink()` (#24).
+
+# 1.0.0
+
+First Public Release
diff --git a/R/collate.R b/R/collate.R
new file mode 100644
index 0000000..09e06cb
--- /dev/null
+++ b/R/collate.R
@@ -0,0 +1,15 @@
+#' @include with_.R
+
+# collate --------------------------------------------------------------------
+
+set_collate <- function(locale) set_locale(c(LC_COLLATE = locale))[[1]]
+
+#' Collation Order
+#'
+#' Temporarily change collation order by changing the value of the
+#' \code{LC_COLLATE} locale.
+#'
+#' @template with
+#' @param new \code{[character(1)]}\cr New collation order
+#' @export
+with_collate <- with_(set_collate)
diff --git a/R/dir.R b/R/dir.R
new file mode 100644
index 0000000..b7c2a40
--- /dev/null
+++ b/R/dir.R
@@ -0,0 +1,14 @@
+#' @include with_.R
+NULL
+
+# working directory ----------------------------------------------------------
+
+#' Working directory
+#'
+#' Temorarily change the current working directory.
+#'
+#' @template with
+#' @param new \code{[character(1)]}\cr New working directory
+#' @seealso \code{\link{setwd}}
+#' @export
+with_dir <- with_(setwd)
diff --git a/R/env.R b/R/env.R
new file mode 100644
index 0000000..75cf04f
--- /dev/null
+++ b/R/env.R
@@ -0,0 +1,43 @@
+# env ------------------------------------------------------------------------
+
+set_envvar <- function(envs, action = "replace") {
+ if (length(envs) == 0) return()
+
+ stopifnot(is.named(envs))
+ stopifnot(is.character(action), length(action) == 1)
+ action <- match.arg(action, c("replace", "prefix", "suffix"))
+
+ # if there are duplicated entries keep only the last one
+ envs <- envs[!duplicated(names(envs), fromLast = TRUE)]
+
+ old <- Sys.getenv(names(envs), names = TRUE, unset = NA)
+ set <- !is.na(envs)
+
+ both_set <- set & !is.na(old)
+ if (any(both_set)) {
+ if (action == "prefix") {
+ envs[both_set] <- paste(envs[both_set], old[both_set])
+ } else if (action == "suffix") {
+ envs[both_set] <- paste(old[both_set], envs[both_set])
+ }
+ }
+
+ if (any(set)) do.call("Sys.setenv", as.list(envs[set]))
+ if (any(!set)) Sys.unsetenv(names(envs)[!set])
+
+ invisible(old)
+}
+
+#' Environment variables
+#'
+#' Temporarily change system environment variables.
+#'
+#' @template with
+#' @param new \code{[named character]}\cr New environment variables
+#' @param action should new values \code{"replace"}, \code{"prefix"} or
+#' \code{"suffix"} existing variables with the same name.
+#' @details if \code{NA} is used those environment variables will be unset.
+#' If there are any duplicated variable names only the last one is used.
+#' @seealso \code{\link{Sys.setenv}}
+#' @export
+with_envvar <- with_(set_envvar)
diff --git a/R/libpaths.R b/R/libpaths.R
new file mode 100644
index 0000000..20c5898
--- /dev/null
+++ b/R/libpaths.R
@@ -0,0 +1,42 @@
+#' @include with_.R
+
+# lib ------------------------------------------------------------------------
+
+set_libpaths <- function(paths, action = "replace") {
+ paths <- normalizePath(paths, mustWork = TRUE)
+
+ old <- .libPaths()
+ paths <- merge_new(old, paths, action)
+
+ .libPaths(paths)
+ invisible(old)
+}
+
+set_temp_libpath <- function() {
+ paths <- tempfile("temp_libpath")
+ dir.create(paths)
+ set_libpaths(paths, action = "prefix")
+}
+
+#' Library paths
+#'
+#' Temporarily change library paths.
+#'
+#' @template with
+#' @param new \code{[character]}\cr New library paths
+#' @param action \code{[character(1)]}\cr should new values \code{"replace"}, \code{"prefix"} or
+#' \code{"suffix"} existing paths.
+#' @seealso \code{\link{.libPaths}}
+#' @family libpaths
+#' @export
+with_libpaths <- with_(set_libpaths, .libPaths)
+
+#' Library paths
+#'
+#' Temporarily prepend a new temporary directory to the library paths.
+#'
+#' @template with
+#' @seealso \code{\link{.libPaths}}
+#' @family libpaths
+#' @export
+with_temp_libpaths <- with_(set_temp_libpath, .libPaths)
diff --git a/R/locale.R b/R/locale.R
new file mode 100644
index 0000000..3f93724
--- /dev/null
+++ b/R/locale.R
@@ -0,0 +1,26 @@
+# locale ---------------------------------------------------------------------
+
+set_locale <- function(cats) {
+ stopifnot(is.named(cats), is.character(cats))
+
+ if ("LC_ALL" %in% names(cats)) {
+ stop("Setting LC_ALL category not implemented.", call. = FALSE)
+ }
+
+ old <- vapply(names(cats), Sys.getlocale, character(1))
+
+ mapply(Sys.setlocale, names(cats), cats)
+ invisible(old)
+}
+
+#' Locale settings
+#'
+#' Temporarily change locale settings.
+#'
+#' Setting the \code{LC_ALL} category is currently not implemented.
+#'
+#' @template with
+#' @param new \code{[named character]}\cr New locale settings
+#' @seealso \code{\link{Sys.setlocale}}
+#' @export
+with_locale <- with_(set_locale)
diff --git a/R/makevars.R b/R/makevars.R
new file mode 100644
index 0000000..94b6206
--- /dev/null
+++ b/R/makevars.R
@@ -0,0 +1,64 @@
+#' @include with_.R
+
+# Makevars --------------------------------------------------------------------
+
+set_makevars <- function(variables,
+ old_path = file.path("~", ".R", "Makevars"),
+ new_path = tempfile(),
+ assignment = c("=", ":=", "?=", "+=")) {
+ if (length(variables) == 0) {
+ return()
+ }
+ stopifnot(is.named(variables))
+
+ assignment <- match.arg(assignment)
+
+ old <- NULL
+ if (file.exists(old_path)) {
+ lines <- readLines(old_path)
+ old <- lines
+ for (var in names(variables)) {
+ loc <- grep(paste(c("^[[:space:]]*", var, "[[:space:]]*", "="), collapse = ""), lines)
+ if (length(loc) == 0) {
+ lines <- append(lines, paste(sep = assignment, var, variables[var]))
+ } else if(length(loc) == 1) {
+ lines[loc] <- paste(sep = assignment, var, variables[var])
+ } else {
+ stop("Multiple results for ", var, " found, something is wrong.", .call = FALSE)
+ }
+ }
+ } else {
+ lines <- paste(names(variables), variables, sep = assignment)
+ }
+
+ if (!identical(old, lines)) {
+ writeLines(con = new_path, lines)
+ }
+
+ old
+}
+
+#' Makevars variables
+#'
+#' Temporarily change contents of an existing \code{Makevars} file.
+#'
+#' @details If no \code{Makevars} file exists or the fields in \code{new} do
+#' not exist in the existing \code{Makevars} file then the fields are added to
+#' the new file. Existing fields which are not included in \code{new} are
+#' appended unchanged. Fields which exist in \code{Makevars} and in \code{new}
+#' are modified to use the value in \code{new}.
+#'
+#' @template with
+#' @param new \code{[named character]}\cr New variables and their values
+#' @param path \code{[character(1)]}\cr location of existing \code{Makevars} file to modify.
+#' @param assignment \code{[character(1)]}\cr assignment type to use.
+#' @export
+with_makevars <- function(new, code, path = file.path("~", ".R", "Makevars"), assignment = c("=", ":=", "?=", "+=")) {
+ assignment <- match.arg(assignment)
+ makevars_file <- tempfile()
+ on.exit(unlink(makevars_file), add = TRUE)
+ with_envvar(c(R_MAKEVARS_USER = makevars_file), {
+ set_makevars(new, path, makevars_file, assignment = assignment)
+ force(code)
+ })
+}
diff --git a/R/options.R b/R/options.R
new file mode 100644
index 0000000..6baaabf
--- /dev/null
+++ b/R/options.R
@@ -0,0 +1,17 @@
+#' @include with_.R
+
+# options --------------------------------------------------------------------
+
+set_options <- function(new_options) {
+ do.call(options, as.list(new_options))
+}
+
+#' Options
+#'
+#' Temporarily change global options.
+#'
+#' @template with
+#' @param new \code{[named list]}\cr New options and their values
+#' @seealso \code{\link{options}}
+#' @export
+with_options <- with_(set_options)
diff --git a/R/par.R b/R/par.R
new file mode 100644
index 0000000..2e2a9cc
--- /dev/null
+++ b/R/par.R
@@ -0,0 +1,15 @@
+#' @include with_.R
+NULL
+
+# par ------------------------------------------------------------------------
+
+#' Graphics parameters
+#'
+#' Temporarily change graphics parameters.
+#'
+#' @template with
+#' @param new \code{[named list]}\cr New graphics parameters and their values
+#' @param no.readonly \code{[logical(1)]}\cr see \code{\link{par}} documentation.
+#' @seealso \code{\link{par}}
+#' @export
+with_par <- with_(graphics::par)
diff --git a/R/path.R b/R/path.R
new file mode 100644
index 0000000..c804e35
--- /dev/null
+++ b/R/path.R
@@ -0,0 +1,28 @@
+# path -----------------------------------------------------------------------
+
+get_path <- function() {
+ strsplit(Sys.getenv("PATH"), .Platform$path.sep)[[1]]
+}
+
+set_path <- function(path, action = "prefix") {
+ path <- normalizePath(path, mustWork = FALSE)
+
+ old <- get_path()
+ path <- merge_new(old, path, action)
+
+ path <- paste(path, collapse = .Platform$path.sep)
+ Sys.setenv(PATH = path)
+ invisible(old)
+}
+
+#' PATH environment variable
+#'
+#' Temporarily change the system search path.
+#'
+#' @template with
+#' @param new \code{[character]}\cr New \code{PATH} entries
+#' @param action \code{[character(1)]}\cr Should new values \code{"replace"}, \code{"prefix"} or
+#' \code{"suffix"} existing paths
+#' @seealso \code{\link{Sys.setenv}}
+#' @export
+with_path <- with_(set_path, function(old) set_path(old, "replace"))
diff --git a/R/sink.R b/R/sink.R
new file mode 100644
index 0000000..065fe4f
--- /dev/null
+++ b/R/sink.R
@@ -0,0 +1,95 @@
+# sink -----------------------------------------------------------------------
+
+# FIXME: Use (a better version of) pryr:::partial2 when available
+output_sink <- function(file = NULL, append = FALSE, split = FALSE) {
+ sink(file = file, append = append, type = "output", split = split)
+}
+
+message_sink <- function(file = NULL, append = FALSE) {
+ sink(file = file, append = append, type = "message", split = FALSE)
+}
+
+#' @include wrap.R
+set_output_sink <- wrap(
+ output_sink,
+ if (is.null(file)) {
+ stop("file cannot be NULL", call. = FALSE)
+ },
+ list(n = sink.number()))
+
+set_message_sink <- wrap(
+ message_sink,
+ {
+ if (is.null(file)) {
+ stop("file cannot be NULL,", call. = FALSE)
+ }
+ if (sink.number(type = "message") != 2L) {
+ stop("Cannot establish message sink when another sink is active.",
+ call. = FALSE)
+ }
+ con <- if (is.character(file)) {
+ file <- file(file, if (append) "a" else "w")
+ }
+ },
+ {
+ list(n = sink.number(type = "message"), con = con)
+ })
+
+reset_output_sink <- function(sink_info) {
+ repeat {
+ n <- sink.number()
+ delta <- n - sink_info$n
+
+ if (delta >= 0L) {
+ sink()
+
+ if (delta > 0L) {
+ warning("Removing a different sink.", call. = FALSE)
+ } else {
+ return()
+ }
+ } else {
+ warning("Sink #", sink_info$n, " already removed.", call. = FALSE)
+ return()
+ }
+ }
+}
+
+reset_message_sink <- function(sink_info) {
+ if (!is.null(sink_info$con)) {
+ on.exit(close(sink_info$con), add = TRUE)
+ }
+
+ do_reset_message_sink(sink_info)
+}
+
+do_reset_message_sink <- function(sink_info) {
+ n <- sink.number(type = "message")
+ if (n == 2L) {
+ warning("No message sink to remove.", call. = FALSE)
+ } else if (n == sink_info$n) {
+ sink(type = "message")
+ } else {
+ warning("Not removing a different message sink.", call. = FALSE)
+ }
+}
+
+#' Output redirection
+#'
+#' Temporarily divert output to a file via \code{\link{sink}}. For
+#' sinks of type \code{message}, an error is raised if such a sink is already
+#' active.
+#'
+#' @template with
+#' @param new \code{[character(1)|connection]}\cr
+#' A writable \link{connection} or a character string naming the file to write
+#' to. Passing \code{NULL} will throw an error.
+#' @inheritParams base::sink
+#' @seealso \code{\link{sink}}
+#' @export
+#' @name with_sink
+with_output_sink <- with_(set_output_sink, reset_output_sink)
+
+#' @rdname with_sink
+#' @export
+with_message_sink <- with_(set_message_sink, reset_message_sink)
diff --git a/R/with.R b/R/with.R
new file mode 100644
index 0000000..6d8ac83
--- /dev/null
+++ b/R/with.R
@@ -0,0 +1,52 @@
+#' Execute code in temporarily altered environment
+#'
+#' All functions prefixed by \code{with_} work as follows. First, a particular
+#' aspect of the global environment is modified (see below for a list).
+#' Then, custom code (passed via the \code{code} argument) is executed.
+#' Upon completion or error, the global environment is restored to the previous
+#' state.
+#'
+#' @section Arguments pattern:
+#' \tabular{lll}{
+#' \code{new} \tab \code{[various]} \tab Values for setting \cr
+#' \code{code} \tab \code{[any]} \tab Code to execute in the temporary environment \cr
+#' \code{...} \tab \tab Further arguments \cr
+#' }
+#' @section Usage pattern:
+#' \code{with_...(new, code, ...)}
+#' @name withr
+#' @docType package
+#' @section withr functions:
+#' \itemize{
+#' \item \code{\link{with_collate}}: collation order
+#' \item \code{\link{with_dir}}: working directory
+#' \item \code{\link{with_envvar}}: environment variables
+#' \item \code{\link{with_libpaths}}: library paths, replacing current libpaths
+#' \item \code{\link{with_locale}}: any locale setting
+#' \item \code{\link{with_makevars}}: Makevars variables
+#' \item \code{\link{with_options}}: options
+#' \item \code{\link{with_par}}: graphics parameters
+#' \item \code{\link{with_path}}: \code{PATH} environment variable
+#' \item \code{\link{with_sink}}: output redirection
+#' }
+#' @section Creating new "with" functions:
+#' All \code{with_} functions are created by a helper function,
+#' \code{\link{with_}}. This functions accepts two arguments:
+#' a setter function and an optional resetter function. The setter function is
+#' expected to change the global state and return an "undo instruction".
+#' This undo instruction is then passed to the resetter function, which changes
+#' back the global state. In many cases, the setter function can be used
+#' naturally as resetter.
+#' @examples
+#' getwd()
+#' with_dir(tempdir(), getwd())
+#' getwd()
+#'
+#' Sys.getenv("HADLEY")
+#' with_envvar(c("HADLEY" = 2), Sys.getenv("HADLEY"))
+#' Sys.getenv("HADLEY")
+#'
+#' with_envvar(c("A" = 1),
+#' with_envvar(c("A" = 2), action = "suffix", Sys.getenv("A"))
+#' )
+NULL
diff --git a/R/with_.R b/R/with_.R
new file mode 100644
index 0000000..b1bcf96
--- /dev/null
+++ b/R/with_.R
@@ -0,0 +1,90 @@
+#' Create a new "with" function
+#'
+#' This function is a "constructor" for \code{with_...} functions. It
+#' is only needed if you want to alter some global state which is
+#' not covered by the existing \code{with_...} functions, see
+#' \link{withr-package} for an overview.
+#'
+#' @param set \code{[function(...)]}\cr Function used to set the state.
+#' The function can have arbirarily many arguments, they will be replicated
+#' in the formals of the returned function.
+#' @param reset \code{[function(x)]}\cr Function used to reset the state.
+#' The first argument can be named arbitrarily, further arguments with default
+#' values, or a "dots" argument, are supported but not used: The function will
+#' be called as \code{reset(old)}.
+#' @param envir \code{[environment]}\cr Environment of the returned function.
+#' @return \code{[function(new, code, ...)]} A function with at least two arguments,
+#' \itemize{
+#' \item \code{new}: New state to use
+#' \item \code{code}: Code to run in that state.
+#' }
+#' If there are more arguments to the function passed in \code{set} they are
+#' added to the returned function. If \code{set} does not have arguments,
+#' the returned function only has a \code{code} argument.
+#' @keywords internal
+#' @examples
+#' with_(setwd)
+#'
+#' global_stack <- list()
+#' set_global_state <- function(state, msg = "Changing global state.") {
+#' global_stack <- c(list(state), global_stack)
+#' message(msg)
+#' state
+#' }
+#' reset_global_state <- function(state) {
+#' old_state <- global_stack[[1]]
+#' global_stack <- global_stack[-1]
+#' stopifnot(identical(state, old_state))
+#' }
+#' with_(set_global_state, reset_global_state)
+#' @export
+with_ <- function(set, reset = set, envir = parent.frame()) {
+
+ fmls <- formals(set)
+
+ if (length(fmls) > 0L) {
+ # called pass all extra formals on
+ called_fmls <- stats::setNames(lapply(names(fmls), as.symbol), names(fmls))
+
+ # rename first formal to new
+ called_fmls[[1]] <- as.symbol("new")
+
+ fun_args <- c(alist(new =, code =), fmls[-1L])
+ } else {
+ # no formals -- only have code
+ called_fmls <- NULL
+
+ fun_args <- alist(code =)
+ }
+
+ set_call <- as.call(c(substitute(set), called_fmls))
+
+ fun <- eval(bquote(function(args) {
+ old <- .(set_call)
+ on.exit(.(reset)(old))
+ force(code)
+ }, as.environment(list(set_call = set_call,
+ reset = if (missing(reset)) substitute(set) else substitute(reset)))))
+
+ # substitute does not work on arguments, so we need to fix them manually
+ formals(fun) <- fun_args
+
+ environment(fun) <- envir
+
+ fun
+}
+
+merge_new <- function(old, new, action, merge_fun = c) {
+ action <- match.arg(action, c("replace", "prefix", "suffix"))
+
+ if (action == "suffix") {
+ new <- merge_fun(old, new)
+ } else if (action == "prefix") {
+ new <- merge_fun(new, old)
+ }
+ new
+}
+
+is.named <- function(x) {
+ !is.null(names(x)) && all(names(x) != "")
+}
diff --git a/R/wrap.R b/R/wrap.R
new file mode 100644
index 0000000..9d94548
--- /dev/null
+++ b/R/wrap.R
@@ -0,0 +1,24 @@
+wrap <- function(f, pre, post, envir = parent.frame()) {
+ fmls <- formals(f)
+
+ # called pass all extra formals on
+ called_fmls <- stats::setNames(lapply(names(fmls), as.symbol), names(fmls))
+
+ f_call <- as.call(c(substitute(f), called_fmls))
+ pre <- substitute(pre)
+ post <- substitute(post)
+
+ fun <- eval(bquote(function(args) {
+ .(pre)
+ .retval <- .(f_call)
+ .(post)
+ }, as.environment(list(f_call = f_call, pre = pre, post = post))))
+
+ # substitute does not work on arguments, so we need to fix them manually
+ formals(fun) <- fmls
+
+ environment(fun) <- envir
+
+ fun
+
+}
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..63ce1e9
--- /dev/null
+++ b/README.md
@@ -0,0 +1,50 @@
+<!-- README.md is generated from README.Rmd. Please edit that file -->
+Withr - Run Code 'With' Modified State
+======================================
+
+[](https://travis-ci.org/jimhester/withr) [](https://ci.appveyor.com/project/jimhester/withr) [](https://codecov.io/github/jimhester/withr?branch=master) [ package, this provides a simple package with limited dependencies to provide access to these functions.
+
+- `with_collate()` - collation order
+- `with_dir()` - working directory
+- `with_envvar()` - environment variables
+- `with_libpaths()` - library paths
+- `with_locale()` - any locale setting
+- `with_makevars()` - Makevars variables
+- `with_options()` - options
+- `with_par()` - graphics parameters
+- `with_path()` - PATH environment variable
+
+There is also a `with_()` function to construct new `with_*` functions if needed.
+
+``` r
+dir.create("test")
+#> Warning in dir.create("test"): 'test' already exists
+getwd()
+#> [1] "/tmp/RtmpaPrDI5"
+with_dir("test", getwd())
+#> [1] "/tmp/RtmpaPrDI5/test"
+getwd()
+#> [1] "/tmp/RtmpaPrDI5"
+unlink("test")
+
+Sys.getenv("HADLEY")
+#> [1] ""
+with_envvar(c("HADLEY" = 2), Sys.getenv("HADLEY"))
+#> [1] "2"
+Sys.getenv("HADLEY")
+#> [1] ""
+
+with_envvar(c("A" = 1),
+ with_envvar(c("A" = 2), action = "suffix", Sys.getenv("A"))
+)
+#> [1] "1 2"
+```
+
+See Also
+========
+
+- [Devtools](https://github.com/hadley/devtools)
diff --git a/debian/README.test b/debian/README.test
deleted file mode 100644
index 90657cf..0000000
--- a/debian/README.test
+++ /dev/null
@@ -1,8 +0,0 @@
-Notes on how this package can be tested.
-────────────────────────────────────────
-
-This package can be tested by running the provided test:
-
- sh run-unit-test
-
-in order to confirm its integrity.
diff --git a/debian/changelog b/debian/changelog
deleted file mode 100644
index 05eeec8..0000000
--- a/debian/changelog
+++ /dev/null
@@ -1,5 +0,0 @@
-r-cran-withr (1.0.2-1) unstable; urgency=medium
-
- * Initial release (closes: #846962)
-
- -- Andreas Tille <tille at debian.org> Sun, 04 Dec 2016 19:09:51 +0100
diff --git a/debian/compat b/debian/compat
deleted file mode 100644
index f599e28..0000000
--- a/debian/compat
+++ /dev/null
@@ -1 +0,0 @@
-10
diff --git a/debian/control b/debian/control
deleted file mode 100644
index dd9be45..0000000
--- a/debian/control
+++ /dev/null
@@ -1,25 +0,0 @@
-Source: r-cran-withr
-Maintainer: Debian Med Packaging Team <debian-med-packaging at lists.alioth.debian.org>
-Uploaders: Andreas Tille <tille at debian.org>
-Section: gnu-r
-Priority: optional
-Build-Depends: debhelper (>= 10),
- dh-r,
- r-base-dev
-Standards-Version: 3.9.8
-Vcs-Browser: https://anonscm.debian.org/viewvc/debian-med/trunk/packages/R/r-cran-withr/trunk/
-Vcs-Svn: svn://anonscm.debian.org/debian-med/trunk/packages/R/r-cran-withr/trunk/
-Homepage: https://cran.r-project.org/package=withr
-
-Package: r-cran-withr
-Architecture: all
-Depends: ${R:Depends},
- ${shlibs:Depends},
- ${misc:Depends}
-Recommends: ${R:Recommends}
-Suggests: ${R:Suggests}
-Description: GNU R package to run code 'With' temporarily modified global state
- A set of functions to run code 'with' safely and temporarily
- modified global state. Many of these functions were originally a part of the
- 'devtools' package, this provides a simple package with limited dependencies
- to provide access to these functions.
diff --git a/debian/copyright b/debian/copyright
deleted file mode 100644
index 65ec716..0000000
--- a/debian/copyright
+++ /dev/null
@@ -1,31 +0,0 @@
-Format: https://www.debian.org/doc/packaging-manuals/copyright-format/1.0/
-Upstream-Name: withr
-Upstream-Contact: Jim Hester <james.f.hester at gmail.com>
-Source: https://cran.r-project.org/package=withr
-
-Files: *
-Copyright: 2015-29016 Jim Hester, Kirill Müller, Hadley Wickham,
- Winston Chang, RStudio
-License: GPL-2+
-
-Files: debian/*
-Copyright: 2016 Andreas Tille <tille at debian.org>
-License: GPL-2+
-
-License: GPL-2+
- This program is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2 of the License, or
- (at your option) any later version.
- .
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
- .
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
- .
- On Debian systems, the complete text of the GNU General Public
- License can be found in `/usr/share/common-licenses/GPL-2'.
diff --git a/debian/docs b/debian/docs
deleted file mode 100644
index 960011c..0000000
--- a/debian/docs
+++ /dev/null
@@ -1,3 +0,0 @@
-tests
-debian/README.test
-debian/tests/run-unit-test
diff --git a/debian/rules b/debian/rules
deleted file mode 100755
index 529c38a..0000000
--- a/debian/rules
+++ /dev/null
@@ -1,5 +0,0 @@
-#!/usr/bin/make -f
-
-%:
- dh $@ --buildsystem R
-
diff --git a/debian/source/format b/debian/source/format
deleted file mode 100644
index 163aaf8..0000000
--- a/debian/source/format
+++ /dev/null
@@ -1 +0,0 @@
-3.0 (quilt)
diff --git a/debian/tests/control b/debian/tests/control
deleted file mode 100644
index b044b0c..0000000
--- a/debian/tests/control
+++ /dev/null
@@ -1,3 +0,0 @@
-Tests: run-unit-test
-Depends: @, r-cran-testthat
-Restrictions: allow-stderr
diff --git a/debian/tests/run-unit-test b/debian/tests/run-unit-test
deleted file mode 100644
index 52365ae..0000000
--- a/debian/tests/run-unit-test
+++ /dev/null
@@ -1,13 +0,0 @@
-#!/bin/sh -e
-
-oname=withr
-pkg=r-cran-`echo $oname | tr '[A-Z]' '[a-z]'`
-
-if [ "$ADTTMP" = "" ] ; then
- ADTTMP=`mktemp -d /tmp/${pkg}-test.XXXXXX`
- trap "rm -rf $ADTTMP" 0 INT QUIT ABRT PIPE TERM
-fi
-cd $ADTTMP
-cp -a /usr/share/doc/${pkg}/tests/* $ADTTMP
-find . -name "*.gz" -exec gunzip \{\} \;
-LC_ALL=C R --no-save < testthat.R
diff --git a/debian/watch b/debian/watch
deleted file mode 100644
index e83dcc5..0000000
--- a/debian/watch
+++ /dev/null
@@ -1,2 +0,0 @@
-version=4
-https://cran.r-project.org/src/contrib/withr_([-\d.]*)\.tar\.gz
diff --git a/man/with_.Rd b/man/with_.Rd
new file mode 100644
index 0000000..768c4a6
--- /dev/null
+++ b/man/with_.Rd
@@ -0,0 +1,54 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/with_.R
+\name{with_}
+\alias{with_}
+\title{Create a new "with" function}
+\usage{
+with_(set, reset = set, envir = parent.frame())
+}
+\arguments{
+\item{set}{\code{[function(...)]}\cr Function used to set the state.
+The function can have arbirarily many arguments, they will be replicated
+in the formals of the returned function.}
+
+\item{reset}{\code{[function(x)]}\cr Function used to reset the state.
+The first argument can be named arbitrarily, further arguments with default
+values, or a "dots" argument, are supported but not used: The function will
+be called as \code{reset(old)}.}
+
+\item{envir}{\code{[environment]}\cr Environment of the returned function.}
+}
+\value{
+\code{[function(new, code, ...)]} A function with at least two arguments,
+\itemize{
+\item \code{new}: New state to use
+\item \code{code}: Code to run in that state.
+}
+If there are more arguments to the function passed in \code{set} they are
+added to the returned function. If \code{set} does not have arguments,
+the returned function only has a \code{code} argument.
+}
+\description{
+This function is a "constructor" for \code{with_...} functions. It
+is only needed if you want to alter some global state which is
+not covered by the existing \code{with_...} functions, see
+\link{withr-package} for an overview.
+}
+\examples{
+with_(setwd)
+
+global_stack <- list()
+set_global_state <- function(state, msg = "Changing global state.") {
+ global_stack <- c(list(state), global_stack)
+ message(msg)
+ state
+}
+reset_global_state <- function(state) {
+ old_state <- global_stack[[1]]
+ global_stack <- global_stack[-1]
+ stopifnot(identical(state, old_state))
+}
+with_(set_global_state, reset_global_state)
+}
+\keyword{internal}
+
diff --git a/man/with_collate.Rd b/man/with_collate.Rd
new file mode 100644
index 0000000..9f69bb1
--- /dev/null
+++ b/man/with_collate.Rd
@@ -0,0 +1,25 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/collate.R
+\name{with_collate}
+\alias{with_collate}
+\title{Collation Order}
+\usage{
+with_collate(new, code)
+}
+\arguments{
+\item{new}{\code{[character(1)]}\cr New collation order}
+
+\item{code}{\code{[any]}\cr Code to execute in the temporary environment}
+}
+\value{
+\code{[any]}\cr The results of the evaluation of the \code{code}
+ argument.
+}
+\description{
+Temporarily change collation order by changing the value of the
+\code{LC_COLLATE} locale.
+}
+\seealso{
+\code{\link{withr}} for examples
+}
+
diff --git a/man/with_dir.Rd b/man/with_dir.Rd
new file mode 100644
index 0000000..af8d373
--- /dev/null
+++ b/man/with_dir.Rd
@@ -0,0 +1,26 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/dir.R
+\name{with_dir}
+\alias{with_dir}
+\title{Working directory}
+\usage{
+with_dir(new, code)
+}
+\arguments{
+\item{new}{\code{[character(1)]}\cr New working directory}
+
+\item{code}{\code{[any]}\cr Code to execute in the temporary environment}
+}
+\value{
+\code{[any]}\cr The results of the evaluation of the \code{code}
+ argument.
+}
+\description{
+Temorarily change the current working directory.
+}
+\seealso{
+\code{\link{withr}} for examples
+
+\code{\link{setwd}}
+}
+
diff --git a/man/with_envvar.Rd b/man/with_envvar.Rd
new file mode 100644
index 0000000..29399b4
--- /dev/null
+++ b/man/with_envvar.Rd
@@ -0,0 +1,33 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/env.R
+\name{with_envvar}
+\alias{with_envvar}
+\title{Environment variables}
+\usage{
+with_envvar(new, code, action = "replace")
+}
+\arguments{
+\item{new}{\code{[named character]}\cr New environment variables}
+
+\item{code}{\code{[any]}\cr Code to execute in the temporary environment}
+
+\item{action}{should new values \code{"replace"}, \code{"prefix"} or
+\code{"suffix"} existing variables with the same name.}
+}
+\value{
+\code{[any]}\cr The results of the evaluation of the \code{code}
+ argument.
+}
+\description{
+Temporarily change system environment variables.
+}
+\details{
+if \code{NA} is used those environment variables will be unset.
+If there are any duplicated variable names only the last one is used.
+}
+\seealso{
+\code{\link{withr}} for examples
+
+\code{\link{Sys.setenv}}
+}
+
diff --git a/man/with_libpaths.Rd b/man/with_libpaths.Rd
new file mode 100644
index 0000000..84e863f
--- /dev/null
+++ b/man/with_libpaths.Rd
@@ -0,0 +1,31 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/libpaths.R
+\name{with_libpaths}
+\alias{with_libpaths}
+\title{Library paths}
+\usage{
+with_libpaths(new, code, action = "replace")
+}
+\arguments{
+\item{new}{\code{[character]}\cr New library paths}
+
+\item{code}{\code{[any]}\cr Code to execute in the temporary environment}
+
+\item{action}{\code{[character(1)]}\cr should new values \code{"replace"}, \code{"prefix"} or
+\code{"suffix"} existing paths.}
+}
+\value{
+\code{[any]}\cr The results of the evaluation of the \code{code}
+ argument.
+}
+\description{
+Temporarily change library paths.
+}
+\seealso{
+\code{\link{withr}} for examples
+
+\code{\link{.libPaths}}
+
+Other libpaths: \code{\link{with_temp_libpaths}}
+}
+
diff --git a/man/with_locale.Rd b/man/with_locale.Rd
new file mode 100644
index 0000000..c9ed3eb
--- /dev/null
+++ b/man/with_locale.Rd
@@ -0,0 +1,29 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/locale.R
+\name{with_locale}
+\alias{with_locale}
+\title{Locale settings}
+\usage{
+with_locale(new, code)
+}
+\arguments{
+\item{new}{\code{[named character]}\cr New locale settings}
+
+\item{code}{\code{[any]}\cr Code to execute in the temporary environment}
+}
+\value{
+\code{[any]}\cr The results of the evaluation of the \code{code}
+ argument.
+}
+\description{
+Temporarily change locale settings.
+}
+\details{
+Setting the \code{LC_ALL} category is currently not implemented.
+}
+\seealso{
+\code{\link{withr}} for examples
+
+\code{\link{Sys.setlocale}}
+}
+
diff --git a/man/with_makevars.Rd b/man/with_makevars.Rd
new file mode 100644
index 0000000..9dda5a1
--- /dev/null
+++ b/man/with_makevars.Rd
@@ -0,0 +1,36 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/makevars.R
+\name{with_makevars}
+\alias{with_makevars}
+\title{Makevars variables}
+\usage{
+with_makevars(new, code, path = file.path("~", ".R", "Makevars"),
+ assignment = c("=", ":=", "?=", "+="))
+}
+\arguments{
+\item{new}{\code{[named character]}\cr New variables and their values}
+
+\item{code}{\code{[any]}\cr Code to execute in the temporary environment}
+
+\item{path}{\code{[character(1)]}\cr location of existing \code{Makevars} file to modify.}
+
+\item{assignment}{\code{[character(1)]}\cr assignment type to use.}
+}
+\value{
+\code{[any]}\cr The results of the evaluation of the \code{code}
+ argument.
+}
+\description{
+Temporarily change contents of an existing \code{Makevars} file.
+}
+\details{
+If no \code{Makevars} file exists or the fields in \code{new} do
+not exist in the existing \code{Makevars} file then the fields are added to
+the new file. Existing fields which are not included in \code{new} are
+appended unchanged. Fields which exist in \code{Makevars} and in \code{new}
+are modified to use the value in \code{new}.
+}
+\seealso{
+\code{\link{withr}} for examples
+}
+
diff --git a/man/with_options.Rd b/man/with_options.Rd
new file mode 100644
index 0000000..9a39980
--- /dev/null
+++ b/man/with_options.Rd
@@ -0,0 +1,26 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/options.R
+\name{with_options}
+\alias{with_options}
+\title{Options}
+\usage{
+with_options(new, code)
+}
+\arguments{
+\item{new}{\code{[named list]}\cr New options and their values}
+
+\item{code}{\code{[any]}\cr Code to execute in the temporary environment}
+}
+\value{
+\code{[any]}\cr The results of the evaluation of the \code{code}
+ argument.
+}
+\description{
+Temporarily change global options.
+}
+\seealso{
+\code{\link{withr}} for examples
+
+\code{\link{options}}
+}
+
diff --git a/man/with_par.Rd b/man/with_par.Rd
new file mode 100644
index 0000000..42a9156
--- /dev/null
+++ b/man/with_par.Rd
@@ -0,0 +1,28 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/par.R
+\name{with_par}
+\alias{with_par}
+\title{Graphics parameters}
+\usage{
+with_par(new, code, no.readonly = FALSE)
+}
+\arguments{
+\item{new}{\code{[named list]}\cr New graphics parameters and their values}
+
+\item{code}{\code{[any]}\cr Code to execute in the temporary environment}
+
+\item{no.readonly}{\code{[logical(1)]}\cr see \code{\link{par}} documentation.}
+}
+\value{
+\code{[any]}\cr The results of the evaluation of the \code{code}
+ argument.
+}
+\description{
+Temporarily change graphics parameters.
+}
+\seealso{
+\code{\link{withr}} for examples
+
+\code{\link{par}}
+}
+
diff --git a/man/with_path.Rd b/man/with_path.Rd
new file mode 100644
index 0000000..f9d8336
--- /dev/null
+++ b/man/with_path.Rd
@@ -0,0 +1,29 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/path.R
+\name{with_path}
+\alias{with_path}
+\title{PATH environment variable}
+\usage{
+with_path(new, code, action = "prefix")
+}
+\arguments{
+\item{new}{\code{[character]}\cr New \code{PATH} entries}
+
+\item{code}{\code{[any]}\cr Code to execute in the temporary environment}
+
+\item{action}{\code{[character(1)]}\cr Should new values \code{"replace"}, \code{"prefix"} or
+\code{"suffix"} existing paths}
+}
+\value{
+\code{[any]}\cr The results of the evaluation of the \code{code}
+ argument.
+}
+\description{
+Temporarily change the system search path.
+}
+\seealso{
+\code{\link{withr}} for examples
+
+\code{\link{Sys.setenv}}
+}
+
diff --git a/man/with_sink.Rd b/man/with_sink.Rd
new file mode 100644
index 0000000..02e50e8
--- /dev/null
+++ b/man/with_sink.Rd
@@ -0,0 +1,41 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/sink.R
+\name{with_sink}
+\alias{with_message_sink}
+\alias{with_output_sink}
+\alias{with_sink}
+\title{Output redirection}
+\usage{
+with_output_sink(new, code, append = FALSE, split = FALSE)
+
+with_message_sink(new, code, append = FALSE)
+}
+\arguments{
+\item{new}{\code{[character(1)|connection]}\cr
+A writable \link{connection} or a character string naming the file to write
+to. Passing \code{NULL} will throw an error.}
+
+\item{code}{\code{[any]}\cr Code to execute in the temporary environment}
+
+\item{append}{logical. If \code{TRUE}, output will be appended to
+ \code{file}; otherwise, it will overwrite the contents of
+ \code{file}.}
+
+\item{split}{logical: if \code{TRUE}, output will be sent to the new
+ sink and to the current output stream, like the Unix program \code{tee}.}
+}
+\value{
+\code{[any]}\cr The results of the evaluation of the \code{code}
+ argument.
+}
+\description{
+Temporarily divert output to a file via \code{\link{sink}}. For
+sinks of type \code{message}, an error is raised if such a sink is already
+active.
+}
+\seealso{
+\code{\link{withr}} for examples
+
+\code{\link{sink}}
+}
+
diff --git a/man/with_temp_libpaths.Rd b/man/with_temp_libpaths.Rd
new file mode 100644
index 0000000..bb49374
--- /dev/null
+++ b/man/with_temp_libpaths.Rd
@@ -0,0 +1,26 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/libpaths.R
+\name{with_temp_libpaths}
+\alias{with_temp_libpaths}
+\title{Library paths}
+\usage{
+with_temp_libpaths(code)
+}
+\arguments{
+\item{code}{\code{[any]}\cr Code to execute in the temporary environment}
+}
+\value{
+\code{[any]}\cr The results of the evaluation of the \code{code}
+ argument.
+}
+\description{
+Temporarily prepend a new temporary directory to the library paths.
+}
+\seealso{
+\code{\link{withr}} for examples
+
+\code{\link{.libPaths}}
+
+Other libpaths: \code{\link{with_libpaths}}
+}
+
diff --git a/man/withr.Rd b/man/withr.Rd
new file mode 100644
index 0000000..074884a
--- /dev/null
+++ b/man/withr.Rd
@@ -0,0 +1,68 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/with.R
+\docType{package}
+\name{withr}
+\alias{withr}
+\alias{withr-package}
+\title{Execute code in temporarily altered environment}
+\description{
+All functions prefixed by \code{with_} work as follows. First, a particular
+aspect of the global environment is modified (see below for a list).
+Then, custom code (passed via the \code{code} argument) is executed.
+Upon completion or error, the global environment is restored to the previous
+state.
+}
+\section{Arguments pattern}{
+
+\tabular{lll}{
+ \code{new} \tab \code{[various]} \tab Values for setting \cr
+ \code{code} \tab \code{[any]} \tab Code to execute in the temporary environment \cr
+ \code{...} \tab \tab Further arguments \cr
+}
+}
+
+\section{Usage pattern}{
+
+\code{with_...(new, code, ...)}
+}
+
+\section{withr functions}{
+
+\itemize{
+\item \code{\link{with_collate}}: collation order
+\item \code{\link{with_dir}}: working directory
+\item \code{\link{with_envvar}}: environment variables
+\item \code{\link{with_libpaths}}: library paths, replacing current libpaths
+\item \code{\link{with_locale}}: any locale setting
+\item \code{\link{with_makevars}}: Makevars variables
+\item \code{\link{with_options}}: options
+\item \code{\link{with_par}}: graphics parameters
+\item \code{\link{with_path}}: \code{PATH} environment variable
+\item \code{\link{with_sink}}: output redirection
+}
+}
+
+\section{Creating new "with" functions}{
+
+All \code{with_} functions are created by a helper function,
+\code{\link{with_}}. This functions accepts two arguments:
+a setter function and an optional resetter function. The setter function is
+expected to change the global state and return an "undo instruction".
+This undo instruction is then passed to the resetter function, which changes
+back the global state. In many cases, the setter function can be used
+naturally as resetter.
+}
+\examples{
+getwd()
+with_dir(tempdir(), getwd())
+getwd()
+
+Sys.getenv("HADLEY")
+with_envvar(c("HADLEY" = 2), Sys.getenv("HADLEY"))
+Sys.getenv("HADLEY")
+
+with_envvar(c("A" = 1),
+ with_envvar(c("A" = 2), action = "suffix", Sys.getenv("A"))
+)
+}
+
diff --git a/tests/testthat.R b/tests/testthat.R
new file mode 100644
index 0000000..a428539
--- /dev/null
+++ b/tests/testthat.R
@@ -0,0 +1,4 @@
+library(testthat)
+library(withr)
+
+test_check("withr")
diff --git a/tests/testthat/test-sink.R b/tests/testthat/test-sink.R
new file mode 100644
index 0000000..3eeaeb9
--- /dev/null
+++ b/tests/testthat/test-sink.R
@@ -0,0 +1,130 @@
+context("With sink")
+
+test_that("with_output_sink works as expected", {
+ tmp <- tempfile()
+ on.exit(unlink(tmp), add = TRUE)
+ tmp2 <- tempfile()
+ on.exit(unlink(tmp2), add = TRUE)
+ tmp3 <- tempfile()
+ on.exit(unlink(tmp3), add = TRUE)
+
+ expect_identical(sink.number(), 0L)
+
+ with_output_sink(tmp, {
+ expect_identical(sink.number(), 1L)
+ cat("output\n")
+ })
+ expect_identical(readLines(tmp), "output")
+
+ expect_identical(sink.number(), 0L)
+
+ with_output_sink(tmp, append = TRUE, {
+ expect_identical(sink.number(), 1L)
+ cat("output 2\n")
+ })
+ expect_identical(readLines(tmp), c("output", "output 2"))
+
+ expect_identical(sink.number(), 0L)
+
+ expect_warning(
+ with_output_sink(tmp, {
+ sink()
+ }),
+ "already removed"
+ )
+
+ expect_identical(sink.number(), 0L)
+
+ expect_error(
+ with_output_sink(NULL, {
+ NULL
+ }),
+ "cannot be NULL"
+ )
+
+ expect_identical(sink.number(), 0L)
+
+})
+
+# don't use test_that() here to avoid any message redirection
+local({
+ tmp <- tempfile()
+ on.exit(unlink(tmp), add = TRUE)
+ tmp2 <- tempfile()
+ on.exit(unlink(tmp2), add = TRUE)
+ tmp3 <- tempfile()
+ on.exit(unlink(tmp3), add = TRUE)
+
+
+
+ expect_identical(sink.number(type = "message"), 2L)
+
+ with_message_sink(tmp, {
+ expect_gt(sink.number(type = "message"), 2L)
+ message("message")
+ })
+ expect_identical(sink.number(type = "message"), 2L)
+ expect_identical(readLines(tmp), "message")
+
+ with_message_sink(tmp, append = TRUE, {
+ expect_gt(sink.number(type = "message"), 2L)
+ message("message 2")
+ })
+ expect_identical(sink.number(type = "message"), 2L)
+ expect_identical(readLines(tmp), c("message", "message 2"))
+
+ # Message and output sinks don't interfere
+ with_message_sink(tmp, {
+ sink(tmp2)
+ })
+
+ expect_identical(sink.number(type = "message"), 2L)
+ expect_identical(sink.number(), 1L)
+ sink()
+
+ con <- file(tmp2, "w")
+ on.exit(close(con), add = TRUE)
+ expect_warning(
+ with_message_sink(tmp, {
+ sink(con, type = "message")
+ }),
+ "Not removing a different"
+ )
+ expect_gt(sink.number(type = "message"), 2L)
+ sink(type = "message")
+
+
+ expect_warning(
+ with_message_sink(tmp, {
+ sink(type = "message")
+ }),
+ "No message sink to remove"
+ )
+
+ expect_identical(sink.number(type = "message"), 2L)
+
+ expect_warning(
+ with_message_sink(tmp, {
+ expect_error(
+ with_message_sink(tmp2, NULL),
+ "Cannot establish message sink when another sink is active."
+ )
+ }),
+ NA
+ )
+
+ expect_identical(sink.number(type = "message"), 2L)
+
+ expect_error(
+ with_message_sink(NULL, {
+ NULL
+ }),
+ "cannot be NULL"
+ )
+
+ expect_identical(sink.number(type = "message"), 2L)
+
+ # Enable to check that test actually reaches this point
+ #expect_true(FALSE)
+
+})
diff --git a/tests/testthat/test-with.R b/tests/testthat/test-with.R
new file mode 100644
index 0000000..61d18bd
--- /dev/null
+++ b/tests/testthat/test-with.R
@@ -0,0 +1,254 @@
+context("With")
+
+test_that("with_envvar sets and unsets variables", {
+
+ # Make sure the "set_env_testvar" environment var is not set.
+ Sys.unsetenv("set_env_testvar")
+ expect_false("set_env_testvar" %in% names(Sys.getenv()))
+
+ # Use with_envvar (which calls set_envvar) to temporarily set it to 1
+ expect_identical("1", with_envvar(c("set_env_testvar" = 1),
+ Sys.getenv("set_env_testvar")))
+
+ # set_env_testvar shouldn't stay in the list of environment vars
+ expect_false("set_env_testvar" %in% names(Sys.getenv()))
+})
+
+test_that("with_envar respects suffix and prefix", {
+ nested <- function(op1, op2) {
+ with_envvar(c(A = 1), action = op1,
+ with_envvar(c(A = 2), action = op2,
+ Sys.getenv("A")[[1]]
+ )
+ )
+ }
+
+ expect_equal(nested("replace", "suffix"), c("1 2"))
+ expect_equal(nested("replace", "prefix"), c("2 1"))
+ expect_equal(nested("prefix", "suffix"), c("1 2"))
+ expect_equal(nested("prefix", "prefix"), c("2 1"))
+ expect_equal(nested("suffix", "suffix"), c("1 2"))
+ expect_equal(nested("suffix", "prefix"), c("2 1"))
+})
+
+test_that("with_options works", {
+ expect_that(getOption("scipen"), not(equals(999)))
+ expect_equal(with_options(c(scipen=999), getOption("scipen")), 999)
+ expect_that(getOption("scipen"), not(equals(999)))
+
+ expect_that(getOption("zyxxyzyx"), not(equals("qwrbbl")))
+ expect_equal(with_options(c(zyxxyzyx="qwrbbl"), getOption("zyxxyzyx")), "qwrbbl")
+ expect_that(getOption("zyxxyzyx"), not(equals("qwrbbl")))
+})
+
+test_that("with_libpaths works and resets library", {
+ lib <- .libPaths()
+ new_lib <- "."
+ with_libpaths(
+ new_lib,
+ {
+ expect_equal(normalizePath(new_lib), normalizePath(.libPaths()[[1L]]))
+ }
+ )
+ expect_equal(lib, .libPaths())
+})
+
+test_that("with_temp_libpaths works and resets library", {
+ lib <- .libPaths()
+ with_temp_libpaths(
+ expect_equal(.libPaths()[-1], lib)
+ )
+ expect_equal(lib, .libPaths())
+})
+
+test_that("with_ works", {
+ res <- NULL
+ set <- function(new) {
+ res <<- c(res, 1L)
+ }
+ reset <- function(old) {
+ res <<- c(res, 3L)
+ }
+ with_res <- with_(set, reset)
+ with_res(NULL, res <- c(res, 2L))
+ expect_equal(res, 1L:3L)
+})
+
+test_that("with_ works on functions without arguments", {
+ res <- NULL
+ set <- function() {
+ res <<- c(res, 1L)
+ }
+ reset <- function(x) {
+ res <<- c(res, 3L)
+ }
+ with_res <- with_(set, reset)
+ with_res(res <- c(res, 2L))
+ expect_equal(res, 1L:3L)
+})
+
+test_that("with_path works and resets path", {
+ current <- normalizePath(get_path())
+ new_path <- normalizePath(".")
+ with_path(
+ new_path,
+ {
+ expect_equal(normalizePath(new_path), head(get_path(), n = 1))
+ expect_equal(length(get_path()), length(current) + 1L)
+ }
+ )
+ expect_equal(current, get_path())
+})
+
+test_that("with_path with suffix action works and resets path", {
+ current <- normalizePath(get_path())
+ new_path <- normalizePath(".")
+ with_path(
+ new_path,
+ action = "suffix",
+ {
+ expect_equal(normalizePath(new_path), tail(get_path(), n = 1))
+ expect_equal(length(get_path()), length(current) + 1L)
+ }
+ )
+ expect_equal(current, get_path())
+})
+
+test_that("with_path with replace action works and resets path", {
+ current <- normalizePath(get_path())
+ new_path <- normalizePath(".")
+ with_path(
+ new_path,
+ action = "replace",
+ {
+ expect_equal(normalizePath(new_path), get_path())
+ expect_equal(length(get_path()), 1L)
+ }
+ )
+ expect_equal(current, get_path())
+})
+
+test_that("with_libpaths works and resets library", {
+ lib <- .libPaths()
+ new_lib <- "."
+ with_libpaths(
+ new_lib,
+ {
+ expect_equal(normalizePath(new_lib), normalizePath(.libPaths()[[1L]]))
+ }
+ )
+ expect_equal(lib, .libPaths())
+})
+
+test_that("with_locale works and resets locales", {
+ current <- Sys.getlocale("LC_CTYPE")
+ new <- "C"
+ with_locale(
+ c(LC_CTYPE = new),
+ {
+ expect_equal(new, Sys.getlocale("LC_CTYPE"))
+ }
+ )
+ expect_equal(current, Sys.getlocale("LC_CTYPE"))
+})
+
+test_that("with_locale fails with LC_ALL", {
+ expect_error(with_locale(c(LC_ALL = "C"), NULL), "LC_ALL")
+})
+
+test_that("with_collate works and resets collate", {
+ current <- Sys.getlocale("LC_COLLATE")
+ new <- "C"
+ with_collate(
+ new,
+ {
+ expect_equal(new, Sys.getlocale("LC_COLLATE"))
+ }
+ )
+ expect_equal(current, Sys.getlocale("LC_COLLATE"))
+})
+
+test_that("with_makevars works and resets the Makevars file", {
+ current <- tempfile()
+ writeLines(con = current, c("CFLAGS=-03"), sep = "\n")
+ new <- c(CFLAGS = "-O0")
+ with_makevars(
+ new, path = current,
+ {
+ expect_equal("CFLAGS=-O0", readLines(Sys.getenv("R_MAKEVARS_USER")))
+ }
+ )
+ expect_equal("CFLAGS=-03", readLines(current))
+})
+
+test_that("with_makevars changes only the defined variables", {
+ current_name <- tempfile()
+ current <- c("CFLAGS=-03", "LDFLAGS=-lz")
+ writeLines(con = current_name, current, sep = "\n")
+ new <- c(CFLAGS = "-O0")
+ with_makevars(
+ new, path = current_name,
+ {
+ expect_equal(c("CFLAGS=-O0", "LDFLAGS=-lz"), readLines(Sys.getenv("R_MAKEVARS_USER")))
+ }
+ )
+ expect_equal(current, readLines(current_name))
+})
+
+test_that("with_makevars works with alternative assignments", {
+ current <- tempfile()
+ writeLines(con = current, c("CFLAGS=-03"), sep = "\n")
+ new <- c(CFLAGS = "-O0")
+ with_makevars(
+ new, path = current, assignment = "+=",
+ {
+ expect_equal("CFLAGS+=-O0", readLines(Sys.getenv("R_MAKEVARS_USER")))
+ }
+ )
+ expect_equal("CFLAGS=-03", readLines(current))
+})
+
+test_that("set_makevars works as expected", {
+ expect_equal(set_makevars(character(0)), NULL)
+
+ tmp_old <- tempfile()
+ tmp_new <- tempfile()
+
+ # empty old file
+ set_makevars(c(CFLAGS = "-O3"), tmp_old, tmp_new)
+ expect_equal(readLines(tmp_new), c("CFLAGS=-O3"))
+
+ # non-empty old file without new field
+ writeLines(con=tmp_old, c("LDFLAGS=-lz"))
+ set_makevars(c(CFLAGS = "-O3"), tmp_old, tmp_new)
+ expect_equal(readLines(tmp_new), c("LDFLAGS=-lz", "CFLAGS=-O3"))
+
+ # non-empty old file without multiple field definitions (error)
+ writeLines(con=tmp_old, c("CFLAGS=-O0", "CFLAGS=-O1"))
+ expect_error(set_makevars(c(CFLAGS = "-O3"), tmp_old, tmp_new))
+
+ unlink(tmp_old)
+ unlink(tmp_new)
+})
+
+test_that("with_dir works as expected", {
+ old <- normalizePath(getwd())
+ with_dir("..", {
+ expect_equal(normalizePath(getwd()), normalizePath(file.path(old, "..")))
+ })
+ expect_equal(normalizePath(getwd()), normalizePath(old))
+})
+
+test_that("with_par works as expected", {
+ tmp <- tempfile()
+
+ pdf(tmp)
+ on.exit(unlink(tmp), add = TRUE)
+
+ old <- par("pty")
+ with_par(list(pty = "s"), {
+ expect_equal(par("pty"), "s")
+ })
+ expect_equal(par("pty"), old)
+ dev.off()
+})
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/debian-med/r-cran-withr.git
More information about the debian-med-commit
mailing list