[med-svn] [r-cran-withr] 01/05: New upstream version 2.0.0
Andreas Tille
tille at debian.org
Fri Sep 29 17:15:31 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 bee7ba2c58e3e930c2a287e23a4734530576ab91
Author: Andreas Tille <tille at debian.org>
Date: Fri Sep 29 19:10:39 2017 +0200
New upstream version 2.0.0
---
DESCRIPTION | 24 ++---
MD5 | 68 +++++++------
NAMESPACE | 18 ++++
NEWS.md | 8 ++
R/collate.R | 9 +-
R/defer.R | 116 ++++++++++++++++++++++
R/dir.R | 11 ++-
R/env.R | 15 ++-
R/libpaths.R | 20 +++-
R/local_.R | 37 +++++++
R/locale.R | 11 ++-
R/makevars.R | 26 +++--
R/options.R | 9 +-
R/par.R | 11 ++-
R/path.R | 13 ++-
R/seed.R | 51 ++++++++++
R/sink.R | 19 +++-
R/utils.R | 3 +
R/with.R | 36 +++----
R/with_.R | 40 +++++---
README.md | 31 +++---
man/defer.Rd | 64 ++++++++++++
man/with_.Rd | 26 +++--
man/with_collate.Rd | 6 +-
man/with_dir.Rd | 10 +-
man/with_envvar.Rd | 8 +-
man/with_libpaths.Rd | 8 +-
man/with_locale.Rd | 8 +-
man/with_makevars.Rd | 1 -
man/with_options.Rd | 8 +-
man/with_par.Rd | 10 +-
man/with_path.Rd | 8 +-
man/with_seed.Rd | 40 ++++++++
man/with_sink.Rd | 18 +++-
man/with_temp_libpaths.Rd | 8 +-
man/withr.Rd | 30 +++---
tests/testthat/test-local.R | 230 ++++++++++++++++++++++++++++++++++++++++++++
tests/testthat/test-with.R | 29 ++++--
tests/testthat/test-wrap.R | 11 +++
39 files changed, 911 insertions(+), 188 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
index e3ed752..0af96d3 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,10 +1,11 @@
Encoding: UTF-8
Package: withr
Title: Run Code 'With' Temporarily Modified Global State
-Version: 1.0.2
+Version: 2.0.0
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("Kirill", "M<U+00FC>ller", , "krlmlr+r at mailbox.org", role = "aut"),
+ person("Kevin", "Ushey", email = "kevinushey at gmail.com", role = c("aut")),
person("Hadley", "Wickham", , "hadley at rstudio.com", role = "aut"),
person("Winston", "Chang", role = "aut"),
person("RStudio", role = "cph"))
@@ -12,24 +13,25 @@ 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
+URL: http://github.com/r-lib/withr#readme
+BugReports: http://github.com/r-lib/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
+Collate: 'local_.R' 'with_.R' 'collate.R' 'defer.R' 'dir.R' 'env.R'
+ 'libpaths.R' 'locale.R' 'makevars.R' 'options.R' 'par.R'
+ 'path.R' 'seed.R' 'wrap.R' 'sink.R' 'utils.R' 'with.R'
+RoxygenNote: 6.0.1
NeedsCompilation: no
-Packaged: 2016-06-20 12:49:55 UTC; jhester
+Packaged: 2017-07-28 19:07:05 UTC; jhester
Author: Jim Hester [aut, cre],
- Kirill Müller [aut],
+ Kirill M<U+00FC>ller [aut],
+ Kevin Ushey [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
+Date/Publication: 2017-07-28 22:56:28 UTC
diff --git a/MD5 b/MD5
index acc5afe..574e621 100644
--- a/MD5
+++ b/MD5
@@ -1,33 +1,41 @@
-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
+fd74cea1fd50a9a3d9108f46a27998e4 *DESCRIPTION
+ce7ada706efffb6ef3de5e21eea9b858 *NAMESPACE
+bf8de701ddde07dbf362f934640cb83b *NEWS.md
+e1cbb655f59eff445b7950e74e535fd8 *R/collate.R
+b48f83bbc5eb3a4a67314f1b2a9596da *R/defer.R
+a2d830766da6848a85c7ddc774ccea71 *R/dir.R
+4b5c0d27740b8f7cf5c0b65ebeb432ac *R/env.R
+bbfed680ded5b3a3b556a87b8726962b *R/libpaths.R
+271a519efad71b85a7395505b7e6e616 *R/local_.R
+5df03f3868961416b20e8f3f4f1afe55 *R/locale.R
+35cfe7b2305b7d09f59d5fd0d911f0fc *R/makevars.R
+0ffde56e2ef1adc0b3ba462c78556212 *R/options.R
+188e3db591fcbb3744adbc9eac9ba076 *R/par.R
+25aa34b8e8e014b2e88e276602d05018 *R/path.R
+4e65a6d108fe5fbf81006a88ed992f18 *R/seed.R
+1939e43a0b29a1a8b446de3e0b33c233 *R/sink.R
+810b28c4a62bf4bde55c1e7524a43476 *R/utils.R
+7ee19bc605db4c27923365c3b406b071 *R/with.R
+11a3ff1b263fafab1bc53c61d18d0b81 *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
+caf782ce54b09e20a936a95d7e352770 *README.md
+6e9a4de3114c385196de87627f408e46 *man/defer.Rd
+d686b8ad2f1cfc8efa5cb931ae12e29d *man/with_.Rd
+0b6c47121a7acb7b87eaf5f9d6d265a8 *man/with_collate.Rd
+74cb44e3f20168431a97f46a5097691e *man/with_dir.Rd
+f706fb9a4d45de67f65232645167cdfc *man/with_envvar.Rd
+33dd1f8a28e5e60e36f6ae878a8d90fc *man/with_libpaths.Rd
+121950d339a504eb795b2f17825f07c7 *man/with_locale.Rd
+b72a85d8789a8b1741d045ac84e73600 *man/with_makevars.Rd
+22404976500007f821e53fdeb902bd28 *man/with_options.Rd
+647a83e43e39179fd36a59b3a975df90 *man/with_par.Rd
+a19218a6beea0af578cf251603767a18 *man/with_path.Rd
+007fd826d391517d74b124aff1e5c725 *man/with_seed.Rd
+93bdb881ffe7b342420ed0d58bb51535 *man/with_sink.Rd
+1145a6d406831f664c32ba9b19087f5c *man/with_temp_libpaths.Rd
+cf904d272c253c7b7a2246e72b6f83bd *man/withr.Rd
70c4d334a0974e15d0309c48ca52ca08 *tests/testthat.R
+d575d8af40350566635a5a45c5262de4 *tests/testthat/test-local.R
a71a65191ace70d64dd670ebf8f8bdb2 *tests/testthat/test-sink.R
-2f345097d2daa74e3415dd509f64c301 *tests/testthat/test-with.R
+7eb747a52816e57e84a0ada71fdfecee *tests/testthat/test-with.R
+0effd9528f896e3322dfeb26a0fdc7d5 *tests/testthat/test-wrap.R
diff --git a/NAMESPACE b/NAMESPACE
index 6abd5b4..d701544 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -1,5 +1,20 @@
# Generated by roxygen2: do not edit by hand
+S3method(print,later)
+export(defer)
+export(defer_parent)
+export(local_)
+export(local_collate)
+export(local_dir)
+export(local_envvar)
+export(local_libpaths)
+export(local_locale)
+export(local_message_sink)
+export(local_options)
+export(local_output_sink)
+export(local_par)
+export(local_path)
+export(local_temp_libpaths)
export(with_)
export(with_collate)
export(with_dir)
@@ -12,4 +27,7 @@ export(with_options)
export(with_output_sink)
export(with_par)
export(with_path)
+export(with_preserve_seed)
+export(with_seed)
export(with_temp_libpaths)
+importFrom(stats,runif)
diff --git a/NEWS.md b/NEWS.md
index 3ecc623..8b89e77 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,3 +1,11 @@
+# 2.0.0
+
+- Each `with_` function now has a `local_` variant, which reset at the end of
+ their local scope, generally at the end of the function body.
+
+- New functions `with_seed()` and `with_preserve_seed()` for running code with
+ a given random seed (#45, @krlmlr).
+
# 1.0.2
- `with_makevars()` gains an `assignment` argument to allow specifying
additional assignment types.
diff --git a/R/collate.R b/R/collate.R
index 09e06cb..5c7cfa1 100644
--- a/R/collate.R
+++ b/R/collate.R
@@ -7,9 +7,14 @@ 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.
+#' `LC_COLLATE` locale.
#'
#' @template with
-#' @param new \code{[character(1)]}\cr New collation order
+#' @param new `[character(1)]`\cr New collation order
+#' @param .local_envir `[environment]`\cr The environment to use for scoping.
#' @export
with_collate <- with_(set_collate)
+
+#' @rdname with_collate
+#' @export
+local_collate <- local_(set_collate)
diff --git a/R/defer.R b/R/defer.R
new file mode 100644
index 0000000..622daa5
--- /dev/null
+++ b/R/defer.R
@@ -0,0 +1,116 @@
+#' Defer Evaluation of an Expression
+#'
+#' Similar to [on.exit()], but allows one to attach
+#' an expression to be evaluated when exiting any frame currently
+#' on the stack. This provides a nice mechanism for scoping side
+#' effects for the duration of a function's execution.
+#'
+#' @param expr `[expression]`\cr An expression to be evaluated.
+#' @param envir `[environment]`\cr Attach exit handlers to this environment.
+#' Typically, this should be either the current environment or
+#' a parent frame (accessed through [parent.frame()]).
+#' @param priority `[character(1)]`\cr Specify whether this handler should
+#' be executed `"first"` or `"last"`, relative to any other
+#' registered handlers on this environment.
+#'
+#' @details
+#'
+#' `defer` works by attaching handlers to the requested environment (as an
+#' attribute called `"handlers"`), and registering an exit handler that
+#' executes the registered handler when the function associated with the
+#' requested environment finishes execution.
+#'
+#' @family scope-related functions
+#' @export
+#' @author Kevin Ushey
+#' @examples
+#' # define a 'scope' function that creates a file, and
+#' # removes it when the parent function has finished executing
+#' scope_file <- function(path) {
+#' file.create(path)
+#' defer_parent(unlink(path))
+#' }
+#'
+#' # create tempfile path
+#' path <- tempfile()
+#'
+#' # use 'scope_file' in a function
+#' local({
+#' scope_file(path)
+#' stopifnot(file.exists(path))
+#' })
+#'
+#' # file is deleted as we leave 'local' scope
+#' stopifnot(!file.exists(path))
+#'
+#' # investigate how 'defer' modifies the
+#' # executing function's environment
+#' local({
+#' scope_file(path)
+#' print(attributes(environment()))
+#' })
+defer <- function(expr, envir = parent.frame(), priority = c("first", "last")) {
+ if (identical(envir, .GlobalEnv))
+ stop("attempt to defer event on global environment")
+ priority <- match.arg(priority)
+ front <- priority == "first"
+ invisible(add_handler(envir, later(substitute(expr), parent.frame()), front))
+}
+
+#' @rdname defer
+#' @export
+defer_parent <- function(expr, priority = c("first", "last")) {
+ eval(substitute(
+ defer(expr, envir, priority),
+ list(expr = substitute(expr), envir = parent.frame(2), priority = priority)
+ ), envir = parent.frame())
+}
+
+
+## Handlers used for 'defer' calls. Attached as a list of expressions for the
+## 'handlers' attribute on the environment, with 'on.exit' called to ensure
+## those handlers get executed on exit.
+
+get_handlers <- function(envir) {
+ as.list(attr(envir, "handlers"))
+}
+
+set_handlers <- function(envir, handlers) {
+ has_handlers <- "handlers" %in% names(attributes(envir))
+ attr(envir, "handlers") <- handlers
+ if (!has_handlers) {
+ call <- make_call(execute_handlers, envir)
+
+ # We have to use do.call here instead of eval because of the way on.exit
+ # determines its evaluation context
+ # (https://stat.ethz.ch/pipermail/r-devel/2013-November/067867.html)
+ do.call(base::on.exit, list(substitute(call), TRUE), envir = envir)
+ }
+}
+
+execute_handlers <- function(envir) {
+ handlers <- get_handlers(envir)
+ for (handler in handlers)
+ tryCatch(eval(handler$expr, handler$envir), error = identity)
+}
+
+add_handler <- function(envir, handler, front) {
+
+ handlers <- if (front)
+ c(list(handler), get_handlers(envir))
+ else
+ c(get_handlers(envir), list(handler))
+
+ set_handlers(envir, handlers)
+ handler
+}
+
+later <- function(expr, envir = .GlobalEnv) {
+ `class<-`(list(expr = expr, envir = envir), "later")
+}
+
+#' @export
+print.later <- function(x, ...) {
+ fmt <- "<later>\n expr: %s\n envir: %s\n"
+ cat(sprintf(fmt, format(x$expr), format(x$envir)))
+}
diff --git a/R/dir.R b/R/dir.R
index b7c2a40..35d63b4 100644
--- a/R/dir.R
+++ b/R/dir.R
@@ -5,10 +5,15 @@ NULL
#' Working directory
#'
-#' Temorarily change the current working directory.
+#' Temporarily change the current working directory.
#'
#' @template with
-#' @param new \code{[character(1)]}\cr New working directory
-#' @seealso \code{\link{setwd}}
+#' @param new `[character(1)]`\cr New working directory
+#' @inheritParams with_collate
+#' @seealso [setwd()]
#' @export
with_dir <- with_(setwd)
+
+#' @rdname with_dir
+#' @export
+local_dir <- local_(setwd)
diff --git a/R/env.R b/R/env.R
index 75cf04f..81e0962 100644
--- a/R/env.R
+++ b/R/env.R
@@ -33,11 +33,16 @@ set_envvar <- function(envs, action = "replace") {
#' 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.
+#' @param new `[named character]`\cr New environment variables
+#' @param action should new values `"replace"`, `"prefix"` or
+#' `"suffix"` existing variables with the same name.
+#' @inheritParams with_collate
+#' @details if `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}}
+#' @seealso [Sys.setenv()]
#' @export
with_envvar <- with_(set_envvar)
+
+#' @rdname with_envvar
+#' @export
+local_envvar <- local_(set_envvar)
diff --git a/R/libpaths.R b/R/libpaths.R
index 20c5898..2fe1ddc 100644
--- a/R/libpaths.R
+++ b/R/libpaths.R
@@ -23,20 +23,30 @@ set_temp_libpath <- function() {
#' 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}}
+#' @param new `[character]`\cr New library paths
+#' @param action `[character(1)]`\cr should new values `"replace"`, `"prefix"` or
+#' `"suffix"` existing paths.
+#' @inheritParams with_collate
+#' @seealso [.libPaths()]
#' @family libpaths
#' @export
with_libpaths <- with_(set_libpaths, .libPaths)
+#' @rdname with_libpaths
+#' @export
+local_libpaths <- local_(set_libpaths, .libPaths)
+
#' Library paths
#'
#' Temporarily prepend a new temporary directory to the library paths.
#'
#' @template with
-#' @seealso \code{\link{.libPaths}}
+#' @seealso [.libPaths()]
+#' @inheritParams with_collate
#' @family libpaths
#' @export
with_temp_libpaths <- with_(set_temp_libpath, .libPaths)
+
+#' @rdname with_temp_libpaths
+#' @export
+local_temp_libpaths <- local_(set_temp_libpath, .libPaths)
diff --git a/R/local_.R b/R/local_.R
new file mode 100644
index 0000000..80cc33e
--- /dev/null
+++ b/R/local_.R
@@ -0,0 +1,37 @@
+#' @rdname with_
+#' @export
+local_ <- 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)
+ defer(.(reset)(old), envir = .local_envir)
+ old
+ }, 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) <- c(fun_args, alist(.local_envir = parent.frame()))
+
+ environment(fun) <- envir
+
+ fun
+}
diff --git a/R/locale.R b/R/locale.R
index 3f93724..d482a6f 100644
--- a/R/locale.R
+++ b/R/locale.R
@@ -17,10 +17,15 @@ set_locale <- function(cats) {
#'
#' Temporarily change locale settings.
#'
-#' Setting the \code{LC_ALL} category is currently not implemented.
+#' Setting the `LC_ALL` category is currently not implemented.
#'
#' @template with
-#' @param new \code{[named character]}\cr New locale settings
-#' @seealso \code{\link{Sys.setlocale}}
+#' @param new `[named character]`\cr New locale settings
+#' @inheritParams with_collate
+#' @seealso [Sys.setlocale()]
#' @export
with_locale <- with_(set_locale)
+
+#' @rdname with_locale
+#' @export
+local_locale <- local_(set_locale)
diff --git a/R/makevars.R b/R/makevars.R
index 94b6206..85e68a6 100644
--- a/R/makevars.R
+++ b/R/makevars.R
@@ -40,18 +40,18 @@ set_makevars <- function(variables,
#' Makevars variables
#'
-#' Temporarily change contents of an existing \code{Makevars} file.
+#' Temporarily change contents of an existing `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}.
+#' @details If no `Makevars` file exists or the fields in `new` do
+#' not exist in the existing `Makevars` file then the fields are added to
+#' the new file. Existing fields which are not included in `new` are
+#' appended unchanged. Fields which exist in `Makevars` and in `new`
+#' are modified to use the value in `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.
+#' @param new `[named character]`\cr New variables and their values
+#' @param path `[character(1)]`\cr location of existing `Makevars` file to modify.
+#' @param assignment `[character(1)]`\cr assignment type to use.
#' @export
with_makevars <- function(new, code, path = file.path("~", ".R", "Makevars"), assignment = c("=", ":=", "?=", "+=")) {
assignment <- match.arg(assignment)
@@ -62,3 +62,11 @@ with_makevars <- function(new, code, path = file.path("~", ".R", "Makevars"), as
force(code)
})
}
+
+local_makevars <- function(new, path = file.path("~", ".R", "Makevars"), assignment = c("=", ":=", "?=", "+="), .local_envir = parent.frame()) {
+ assignment <- match.arg(assignment)
+ makevars_file <- tempfile()
+ defer(unlink(makevars_file), envir = .local_envir)
+ local_envvar(c(R_MAKEVARS_USER = makevars_file), .local_envir = .local_envir)
+ set_makevars(new, path, makevars_file, assignment = assignment)
+}
diff --git a/R/options.R b/R/options.R
index 6baaabf..0d61935 100644
--- a/R/options.R
+++ b/R/options.R
@@ -11,7 +11,12 @@ set_options <- function(new_options) {
#' Temporarily change global options.
#'
#' @template with
-#' @param new \code{[named list]}\cr New options and their values
-#' @seealso \code{\link{options}}
+#' @param new `[named list]`\cr New options and their values
+#' @inheritParams with_collate
+#' @seealso [options()]
#' @export
with_options <- with_(set_options)
+
+#' @rdname with_options
+#' @export
+local_options <- local_(set_options)
diff --git a/R/par.R b/R/par.R
index 2e2a9cc..a9a1e17 100644
--- a/R/par.R
+++ b/R/par.R
@@ -8,8 +8,13 @@ NULL
#' 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}}
+#' @param new `[named list]`\cr New graphics parameters and their values
+#' @param no.readonly `[logical(1)]`\cr see [par()] documentation.
+#' @inheritParams with_collate
+#' @seealso [par()]
#' @export
with_par <- with_(graphics::par)
+
+#' @rdname with_par
+#' @export
+local_par <- local_(graphics::par)
diff --git a/R/path.R b/R/path.R
index c804e35..3d1800f 100644
--- a/R/path.R
+++ b/R/path.R
@@ -20,9 +20,14 @@ set_path <- function(path, action = "prefix") {
#' 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}}
+#' @param new `[character]`\cr New `PATH` entries
+#' @param action `[character(1)]`\cr Should new values `"replace"`, `"prefix"` or
+#' `"suffix"` existing paths
+#' @inheritParams with_collate
+#' @seealso [Sys.setenv()]
#' @export
with_path <- with_(set_path, function(old) set_path(old, "replace"))
+
+#' @rdname with_path
+#' @export
+local_path <- local_(set_path, function(old) set_path(old, "replace"))
diff --git a/R/seed.R b/R/seed.R
new file mode 100644
index 0000000..a4d5a17
--- /dev/null
+++ b/R/seed.R
@@ -0,0 +1,51 @@
+#' Random seed
+#'
+#' `with_seed()` runs code with a specific random seed and resets it afterwards.
+#'
+#' @template with
+#' @param seed `[integer(1)]`\cr The random seed to use to evaluate the code.
+#' @examples
+#' # Same random values:
+#' with_preserve_seed(runif(5))
+#' with_preserve_seed(runif(5))
+#'
+#' # Use a pseudorandom value as seed to advance the RNG and pick a different
+#' # value for the next call:
+#' with_seed(seed <- sample.int(.Machine$integer.max, 1L), runif(5))
+#' with_seed(seed, runif(5))
+#' with_seed(seed <- sample.int(.Machine$integer.max, 1L), runif(5))
+#' @export
+with_seed <- function(seed, code) {
+ force(seed)
+ with_preserve_seed({
+ set.seed(seed)
+ code
+ })
+}
+
+#' @rdname with_seed
+#' @description
+#' `with_preserve_seed()` runs code with the current random seed and resets it
+#' afterwards.
+#'
+#' @export
+with_preserve_seed <- function(code) {
+ old_seed <- get_valid_seed()
+ on.exit(assign(".Random.seed", old_seed, globalenv()), add = TRUE)
+ code
+}
+
+#' @importFrom stats runif
+get_valid_seed <- function() {
+ seed <- get_seed()
+ if (is.null(seed)) {
+ # Trigger initialisation of RNG
+ runif(1L)
+ seed <- get_seed()
+ }
+ seed
+}
+
+get_seed <- function() {
+ get0(".Random.seed", globalenv(), mode = "integer")
+}
diff --git a/R/sink.R b/R/sink.R
index 065fe4f..ff6ebb2 100644
--- a/R/sink.R
+++ b/R/sink.R
@@ -76,20 +76,29 @@ do_reset_message_sink <- function(sink_info) {
#' 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
+#' Temporarily divert output to a file via [sink()]. For
+#' sinks of type `message`, an error is raised if such a sink is already
#' active.
#'
#' @template with
-#' @param new \code{[character(1)|connection]}\cr
+#' @param new `[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.
+#' to. Passing `NULL` will throw an error.
#' @inheritParams base::sink
-#' @seealso \code{\link{sink}}
+#' @inheritParams with_collate
+#' @seealso [sink()]
#' @export
#' @name with_sink
with_output_sink <- with_(set_output_sink, reset_output_sink)
#' @rdname with_sink
#' @export
+local_output_sink <- local_(set_output_sink, reset_output_sink)
+
+#' @rdname with_sink
+#' @export
with_message_sink <- with_(set_message_sink, reset_message_sink)
+
+#' @rdname with_sink
+#' @export
+local_message_sink <- local_(set_message_sink, reset_message_sink)
diff --git a/R/utils.R b/R/utils.R
new file mode 100644
index 0000000..4e1255d
--- /dev/null
+++ b/R/utils.R
@@ -0,0 +1,3 @@
+make_call <- function(...) {
+ as.call(list(...))
+}
diff --git a/R/with.R b/R/with.R
index 6d8ac83..88f986f 100644
--- a/R/with.R
+++ b/R/with.R
@@ -1,37 +1,37 @@
#' Execute code in temporarily altered environment
#'
-#' All functions prefixed by \code{with_} work as follows. First, a particular
+#' All functions prefixed by `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.
+#' Then, custom code (passed via the `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
+#' `new` \tab `[various]` \tab Values for setting \cr
+#' `code` \tab `[any]` \tab Code to execute in the temporary environment \cr
+#' `...` \tab \tab Further arguments \cr
#' }
#' @section Usage pattern:
-#' \code{with_...(new, 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
+#' \item [with_collate()]: collation order
+#' \item [with_dir()]: working directory
+#' \item [with_envvar()]: environment variables
+#' \item [with_libpaths()]: library paths, replacing current libpaths
+#' \item [with_locale()]: any locale setting
+#' \item [with_makevars()]: Makevars variables
+#' \item [with_options()]: options
+#' \item [with_par()]: graphics parameters
+#' \item [with_path()]: `PATH` environment variable
+#' \item [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:
+#' All `with_` functions are created by a helper function,
+#' [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
diff --git a/R/with_.R b/R/with_.R
index b1bcf96..9afa5a9 100644
--- a/R/with_.R
+++ b/R/with_.R
@@ -1,26 +1,34 @@
-#' Create a new "with" function
+#' @include local_.R
+NULL
+
+#' Create a new "with" or "local" function
+#'
+#' These are constructors for `with_...` or `local_...` functions.
+#' They are only needed if you want to alter some global state which is not
+#' covered by the existing `with_...` functions, see \link{withr-package}
+#' for an overview.
#'
-#' 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.
+#' The `with_...` functions reset the state immediately after the
+#' `code` argument has been evaluated. The `local_...` functions
+#' reset their arguments after they go out of scope, usually at the end of the
+#' function body.
#'
-#' @param set \code{[function(...)]}\cr Function used to set the state.
-#' The function can have arbirarily many arguments, they will be replicated
+#' @param set `[function(...)]`\cr Function used to set the state.
+#' The function can have arbitrarily 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.
+#' @param reset `[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,
+#' be called as `reset(old)`.
+#' @param envir `[environment]`\cr Environment of the returned function.
+#' @return `[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.
+#' \item `new`: New state to use
+#' \item `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.
+#' If there are more arguments to the function passed in `set` they are
+#' added to the returned function. If `set` does not have arguments,
+#' the returned function only has a `code` argument.
#' @keywords internal
#' @examples
#' with_(setwd)
diff --git a/README.md b/README.md
index 63ce1e9..39aa61a 100644
--- a/README.md
+++ b/README.md
@@ -2,33 +2,32 @@
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) [](https://travis-ci.org/r-lib/withr) [](https://ci.appveyor.com/project/r-lib/withr) [](https://codecov.io/github/r-lib/withr?branch=master) [](http://www.r-pkg.o [...]
-A set of functions to run code 'with' safely and temporarily modified global state.
+A set of functions to run code 'with' safely and temporarily modified global state. There are two sets of functions, those prefixed with `with_` and those with `local_`. The former reset their state as soon as the `code` argument has been evaluated. The latter reset when they reach the end of their scope, usually at the end of a function body.
Many of these functions were originally a part of the [devtools](https://github.com/hadley/devtools) 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
+- `with_collate()` / `local_collate()` - collation order
+- `with_dir()` / `local_dir()` - working directory
+- `with_envvar()` / `local_envvar()` - environment variables
+- `with_libpaths()` / `local_libpaths()` - library paths
+- `with_locale()` / `local_locale()` - any locale setting
+- `with_makevars()` / `local_makevars()` - Makevars variables
+- `with_options()` / `local_options()` - options
+- `with_par()` / `local_par()` - graphics parameters
+- `with_path()` / `local_path()` - PATH environment variable
-There is also a `with_()` function to construct new `with_*` functions if needed.
+There are also `with_()` and `local_()` functions to construct new `with_*` and `local_*` functions if needed.
``` r
dir.create("test")
-#> Warning in dir.create("test"): 'test' already exists
getwd()
-#> [1] "/tmp/RtmpaPrDI5"
+#> [1] "/private/var/folders/dt/r5s12t392tb5sk181j3gs4zw0000gn/T/Rtmp8xR1aN"
with_dir("test", getwd())
-#> [1] "/tmp/RtmpaPrDI5/test"
+#> [1] "/private/var/folders/dt/r5s12t392tb5sk181j3gs4zw0000gn/T/Rtmp8xR1aN/test"
getwd()
-#> [1] "/tmp/RtmpaPrDI5"
+#> [1] "/private/var/folders/dt/r5s12t392tb5sk181j3gs4zw0000gn/T/Rtmp8xR1aN"
unlink("test")
Sys.getenv("HADLEY")
diff --git a/man/defer.Rd b/man/defer.Rd
new file mode 100644
index 0000000..8db4f8f
--- /dev/null
+++ b/man/defer.Rd
@@ -0,0 +1,64 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/defer.R
+\name{defer}
+\alias{defer}
+\alias{defer_parent}
+\title{Defer Evaluation of an Expression}
+\usage{
+defer(expr, envir = parent.frame(), priority = c("first", "last"))
+
+defer_parent(expr, priority = c("first", "last"))
+}
+\arguments{
+\item{expr}{\code{[expression]}\cr An expression to be evaluated.}
+
+\item{envir}{\code{[environment]}\cr Attach exit handlers to this environment.
+Typically, this should be either the current environment or
+a parent frame (accessed through \code{\link[=parent.frame]{parent.frame()}}).}
+
+\item{priority}{\code{[character(1)]}\cr Specify whether this handler should
+be executed \code{"first"} or \code{"last"}, relative to any other
+registered handlers on this environment.}
+}
+\description{
+Similar to \code{\link[=on.exit]{on.exit()}}, but allows one to attach
+an expression to be evaluated when exiting any frame currently
+on the stack. This provides a nice mechanism for scoping side
+effects for the duration of a function's execution.
+}
+\details{
+\code{defer} works by attaching handlers to the requested environment (as an
+attribute called \code{"handlers"}), and registering an exit handler that
+executes the registered handler when the function associated with the
+requested environment finishes execution.
+}
+\examples{
+# define a 'scope' function that creates a file, and
+# removes it when the parent function has finished executing
+scope_file <- function(path) {
+ file.create(path)
+ defer_parent(unlink(path))
+}
+
+# create tempfile path
+path <- tempfile()
+
+# use 'scope_file' in a function
+local({
+ scope_file(path)
+ stopifnot(file.exists(path))
+})
+
+# file is deleted as we leave 'local' scope
+stopifnot(!file.exists(path))
+
+# investigate how 'defer' modifies the
+# executing function's environment
+local({
+ scope_file(path)
+ print(attributes(environment()))
+})
+}
+\author{
+Kevin Ushey
+}
diff --git a/man/with_.Rd b/man/with_.Rd
index 768c4a6..246f32a 100644
--- a/man/with_.Rd
+++ b/man/with_.Rd
@@ -1,14 +1,17 @@
% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/with_.R
-\name{with_}
+% Please edit documentation in R/local_.R, R/with_.R
+\name{local_}
+\alias{local_}
\alias{with_}
-\title{Create a new "with" function}
+\title{Create a new "with" or "local" function}
\usage{
+local_(set, reset = set, envir = parent.frame())
+
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
+The function can have arbitrarily 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.
@@ -29,10 +32,16 @@ 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.
+These are constructors for \code{with_...} or \code{local_...} functions.
+They are 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.
+}
+\details{
+The \code{with_...} functions reset the state immediately after the
+\code{code} argument has been evaluated. The \code{local_...} functions
+reset their arguments after they go out of scope, usually at the end of the
+function body.
}
\examples{
with_(setwd)
@@ -51,4 +60,3 @@ reset_global_state <- function(state) {
with_(set_global_state, reset_global_state)
}
\keyword{internal}
-
diff --git a/man/with_collate.Rd b/man/with_collate.Rd
index 9f69bb1..5adc829 100644
--- a/man/with_collate.Rd
+++ b/man/with_collate.Rd
@@ -2,14 +2,19 @@
% Please edit documentation in R/collate.R
\name{with_collate}
\alias{with_collate}
+\alias{local_collate}
\title{Collation Order}
\usage{
with_collate(new, code)
+
+local_collate(new, code, .local_envir = parent.frame())
}
\arguments{
\item{new}{\code{[character(1)]}\cr New collation order}
\item{code}{\code{[any]}\cr Code to execute in the temporary environment}
+
+\item{.local_envir}{\code{[environment]}\cr The environment to use for scoping.}
}
\value{
\code{[any]}\cr The results of the evaluation of the \code{code}
@@ -22,4 +27,3 @@ Temporarily change collation order by changing the value of the
\seealso{
\code{\link{withr}} for examples
}
-
diff --git a/man/with_dir.Rd b/man/with_dir.Rd
index af8d373..cab09f0 100644
--- a/man/with_dir.Rd
+++ b/man/with_dir.Rd
@@ -2,25 +2,29 @@
% Please edit documentation in R/dir.R
\name{with_dir}
\alias{with_dir}
+\alias{local_dir}
\title{Working directory}
\usage{
with_dir(new, code)
+
+local_dir(new, code, .local_envir = parent.frame())
}
\arguments{
\item{new}{\code{[character(1)]}\cr New working directory}
\item{code}{\code{[any]}\cr Code to execute in the temporary environment}
+
+\item{.local_envir}{\code{[environment]}\cr The environment to use for scoping.}
}
\value{
\code{[any]}\cr The results of the evaluation of the \code{code}
argument.
}
\description{
-Temorarily change the current working directory.
+Temporarily change the current working directory.
}
\seealso{
\code{\link{withr}} for examples
-\code{\link{setwd}}
+\code{\link[=setwd]{setwd()}}
}
-
diff --git a/man/with_envvar.Rd b/man/with_envvar.Rd
index 29399b4..228f9cf 100644
--- a/man/with_envvar.Rd
+++ b/man/with_envvar.Rd
@@ -2,9 +2,12 @@
% Please edit documentation in R/env.R
\name{with_envvar}
\alias{with_envvar}
+\alias{local_envvar}
\title{Environment variables}
\usage{
with_envvar(new, code, action = "replace")
+
+local_envvar(new, code, action = "replace", .local_envir = parent.frame())
}
\arguments{
\item{new}{\code{[named character]}\cr New environment variables}
@@ -13,6 +16,8 @@ with_envvar(new, code, action = "replace")
\item{action}{should new values \code{"replace"}, \code{"prefix"} or
\code{"suffix"} existing variables with the same name.}
+
+\item{.local_envir}{\code{[environment]}\cr The environment to use for scoping.}
}
\value{
\code{[any]}\cr The results of the evaluation of the \code{code}
@@ -28,6 +33,5 @@ If there are any duplicated variable names only the last one is used.
\seealso{
\code{\link{withr}} for examples
-\code{\link{Sys.setenv}}
+\code{\link[=Sys.setenv]{Sys.setenv()}}
}
-
diff --git a/man/with_libpaths.Rd b/man/with_libpaths.Rd
index 84e863f..7b7dce0 100644
--- a/man/with_libpaths.Rd
+++ b/man/with_libpaths.Rd
@@ -2,9 +2,12 @@
% Please edit documentation in R/libpaths.R
\name{with_libpaths}
\alias{with_libpaths}
+\alias{local_libpaths}
\title{Library paths}
\usage{
with_libpaths(new, code, action = "replace")
+
+local_libpaths(new, code, action = "replace", .local_envir = parent.frame())
}
\arguments{
\item{new}{\code{[character]}\cr New library paths}
@@ -13,6 +16,8 @@ with_libpaths(new, code, action = "replace")
\item{action}{\code{[character(1)]}\cr should new values \code{"replace"}, \code{"prefix"} or
\code{"suffix"} existing paths.}
+
+\item{.local_envir}{\code{[environment]}\cr The environment to use for scoping.}
}
\value{
\code{[any]}\cr The results of the evaluation of the \code{code}
@@ -24,8 +29,7 @@ Temporarily change library paths.
\seealso{
\code{\link{withr}} for examples
-\code{\link{.libPaths}}
+\code{\link[=.libPaths]{.libPaths()}}
Other libpaths: \code{\link{with_temp_libpaths}}
}
-
diff --git a/man/with_locale.Rd b/man/with_locale.Rd
index c9ed3eb..949512a 100644
--- a/man/with_locale.Rd
+++ b/man/with_locale.Rd
@@ -2,14 +2,19 @@
% Please edit documentation in R/locale.R
\name{with_locale}
\alias{with_locale}
+\alias{local_locale}
\title{Locale settings}
\usage{
with_locale(new, code)
+
+local_locale(new, code, .local_envir = parent.frame())
}
\arguments{
\item{new}{\code{[named character]}\cr New locale settings}
\item{code}{\code{[any]}\cr Code to execute in the temporary environment}
+
+\item{.local_envir}{\code{[environment]}\cr The environment to use for scoping.}
}
\value{
\code{[any]}\cr The results of the evaluation of the \code{code}
@@ -24,6 +29,5 @@ Setting the \code{LC_ALL} category is currently not implemented.
\seealso{
\code{\link{withr}} for examples
-\code{\link{Sys.setlocale}}
+\code{\link[=Sys.setlocale]{Sys.setlocale()}}
}
-
diff --git a/man/with_makevars.Rd b/man/with_makevars.Rd
index 9dda5a1..02b0e1c 100644
--- a/man/with_makevars.Rd
+++ b/man/with_makevars.Rd
@@ -33,4 +33,3 @@ 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
index 9a39980..bc3fc90 100644
--- a/man/with_options.Rd
+++ b/man/with_options.Rd
@@ -2,14 +2,19 @@
% Please edit documentation in R/options.R
\name{with_options}
\alias{with_options}
+\alias{local_options}
\title{Options}
\usage{
with_options(new, code)
+
+local_options(new, code, .local_envir = parent.frame())
}
\arguments{
\item{new}{\code{[named list]}\cr New options and their values}
\item{code}{\code{[any]}\cr Code to execute in the temporary environment}
+
+\item{.local_envir}{\code{[environment]}\cr The environment to use for scoping.}
}
\value{
\code{[any]}\cr The results of the evaluation of the \code{code}
@@ -21,6 +26,5 @@ Temporarily change global options.
\seealso{
\code{\link{withr}} for examples
-\code{\link{options}}
+\code{\link[=options]{options()}}
}
-
diff --git a/man/with_par.Rd b/man/with_par.Rd
index 42a9156..91b5524 100644
--- a/man/with_par.Rd
+++ b/man/with_par.Rd
@@ -2,16 +2,21 @@
% Please edit documentation in R/par.R
\name{with_par}
\alias{with_par}
+\alias{local_par}
\title{Graphics parameters}
\usage{
with_par(new, code, no.readonly = FALSE)
+
+local_par(new, code, no.readonly = FALSE, .local_envir = parent.frame())
}
\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.}
+\item{no.readonly}{\code{[logical(1)]}\cr see \code{\link[=par]{par()}} documentation.}
+
+\item{.local_envir}{\code{[environment]}\cr The environment to use for scoping.}
}
\value{
\code{[any]}\cr The results of the evaluation of the \code{code}
@@ -23,6 +28,5 @@ Temporarily change graphics parameters.
\seealso{
\code{\link{withr}} for examples
-\code{\link{par}}
+\code{\link[=par]{par()}}
}
-
diff --git a/man/with_path.Rd b/man/with_path.Rd
index f9d8336..1c8cf40 100644
--- a/man/with_path.Rd
+++ b/man/with_path.Rd
@@ -2,9 +2,12 @@
% Please edit documentation in R/path.R
\name{with_path}
\alias{with_path}
+\alias{local_path}
\title{PATH environment variable}
\usage{
with_path(new, code, action = "prefix")
+
+local_path(new, code, action = "prefix", .local_envir = parent.frame())
}
\arguments{
\item{new}{\code{[character]}\cr New \code{PATH} entries}
@@ -13,6 +16,8 @@ with_path(new, code, action = "prefix")
\item{action}{\code{[character(1)]}\cr Should new values \code{"replace"}, \code{"prefix"} or
\code{"suffix"} existing paths}
+
+\item{.local_envir}{\code{[environment]}\cr The environment to use for scoping.}
}
\value{
\code{[any]}\cr The results of the evaluation of the \code{code}
@@ -24,6 +29,5 @@ Temporarily change the system search path.
\seealso{
\code{\link{withr}} for examples
-\code{\link{Sys.setenv}}
+\code{\link[=Sys.setenv]{Sys.setenv()}}
}
-
diff --git a/man/with_seed.Rd b/man/with_seed.Rd
new file mode 100644
index 0000000..4b3c5af
--- /dev/null
+++ b/man/with_seed.Rd
@@ -0,0 +1,40 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/seed.R
+\name{with_seed}
+\alias{with_seed}
+\alias{with_preserve_seed}
+\title{Random seed}
+\usage{
+with_seed(seed, code)
+
+with_preserve_seed(code)
+}
+\arguments{
+\item{seed}{\code{[integer(1)]}\cr The random seed to use to evaluate the code.}
+
+\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{
+\code{with_seed()} runs code with a specific random seed and resets it afterwards.
+
+\code{with_preserve_seed()} runs code with the current random seed and resets it
+afterwards.
+}
+\examples{
+# Same random values:
+with_preserve_seed(runif(5))
+with_preserve_seed(runif(5))
+
+# Use a pseudorandom value as seed to advance the RNG and pick a different
+# value for the next call:
+with_seed(seed <- sample.int(.Machine$integer.max, 1L), runif(5))
+with_seed(seed, runif(5))
+with_seed(seed <- sample.int(.Machine$integer.max, 1L), runif(5))
+}
+\seealso{
+\code{\link{withr}} for examples
+}
diff --git a/man/with_sink.Rd b/man/with_sink.Rd
index 02e50e8..1669ec8 100644
--- a/man/with_sink.Rd
+++ b/man/with_sink.Rd
@@ -1,14 +1,21 @@
% 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}
+\alias{with_output_sink}
+\alias{local_output_sink}
+\alias{with_message_sink}
+\alias{local_message_sink}
\title{Output redirection}
\usage{
with_output_sink(new, code, append = FALSE, split = FALSE)
+local_output_sink(new, code, append = FALSE, split = FALSE,
+ .local_envir = parent.frame())
+
with_message_sink(new, code, append = FALSE)
+
+local_message_sink(new, code, append = FALSE, .local_envir = parent.frame())
}
\arguments{
\item{new}{\code{[character(1)|connection]}\cr
@@ -23,19 +30,20 @@ to. Passing \code{NULL} will throw an error.}
\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}.}
+
+\item{.local_envir}{\code{[environment]}\cr The environment to use for scoping.}
}
\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
+Temporarily divert output to a file via \code{\link[=sink]{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}}
+\code{\link[=sink]{sink()}}
}
-
diff --git a/man/with_temp_libpaths.Rd b/man/with_temp_libpaths.Rd
index bb49374..007ce01 100644
--- a/man/with_temp_libpaths.Rd
+++ b/man/with_temp_libpaths.Rd
@@ -2,12 +2,17 @@
% Please edit documentation in R/libpaths.R
\name{with_temp_libpaths}
\alias{with_temp_libpaths}
+\alias{local_temp_libpaths}
\title{Library paths}
\usage{
with_temp_libpaths(code)
+
+local_temp_libpaths(code, .local_envir = parent.frame())
}
\arguments{
\item{code}{\code{[any]}\cr Code to execute in the temporary environment}
+
+\item{.local_envir}{\code{[environment]}\cr The environment to use for scoping.}
}
\value{
\code{[any]}\cr The results of the evaluation of the \code{code}
@@ -19,8 +24,7 @@ Temporarily prepend a new temporary directory to the library paths.
\seealso{
\code{\link{withr}} for examples
-\code{\link{.libPaths}}
+\code{\link[=.libPaths]{.libPaths()}}
Other libpaths: \code{\link{with_libpaths}}
}
-
diff --git a/man/withr.Rd b/man/withr.Rd
index 074884a..08a4af1 100644
--- a/man/withr.Rd
+++ b/man/withr.Rd
@@ -15,9 +15,9 @@ 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
+\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
}
}
@@ -29,29 +29,30 @@ state.
\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
+\item \code{\link[=with_collate]{with_collate()}}: collation order
+\item \code{\link[=with_dir]{with_dir()}}: working directory
+\item \code{\link[=with_envvar]{with_envvar()}}: environment variables
+\item \code{\link[=with_libpaths]{with_libpaths()}}: library paths, replacing current libpaths
+\item \code{\link[=with_locale]{with_locale()}}: any locale setting
+\item \code{\link[=with_makevars]{with_makevars()}}: Makevars variables
+\item \code{\link[=with_options]{with_options()}}: options
+\item \code{\link[=with_par]{with_par()}}: graphics parameters
+\item \code{\link[=with_path]{with_path()}}: \code{PATH} environment variable
+\item \code{\link[=with_sink]{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:
+\code{\link[=with_]{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())
@@ -65,4 +66,3 @@ with_envvar(c("A" = 1),
with_envvar(c("A" = 2), action = "suffix", Sys.getenv("A"))
)
}
-
diff --git a/tests/testthat/test-local.R b/tests/testthat/test-local.R
new file mode 100644
index 0000000..687c4db
--- /dev/null
+++ b/tests/testthat/test-local.R
@@ -0,0 +1,230 @@
+context("local")
+
+test_that("local_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 local_envvar (which calls set_envvar) to temporarily set it to 1
+ local({
+ local_envvar(c("set_env_testvar" = 1))
+ expect_identical("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("local_envar respects suffix and prefix", {
+ nested <- function(op1, op2) {
+ local({
+ local_envvar(c(A = 1), action = op1)
+ local({
+ local_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("local_options works", {
+ expect_false(getOption("scipen") == 999)
+ local({
+ local_options(c(scipen=999))
+ expect_equal(getOption("scipen"), 999)
+ })
+ expect_false(getOption("scipen") == 999)
+
+ expect_false(identical(getOption("zyxxyzyx"), "qwrbbl"))
+ local({
+ local_options(c(zyxxyzyx="qwrbbl"))
+ expect_equal(getOption("zyxxyzyx"), "qwrbbl")
+ })
+ expect_false(identical(getOption("zyxxyzyx"), "qwrbbl"))
+})
+
+test_that("local_libpaths works and resets library", {
+ lib <- .libPaths()
+ new_lib <- "."
+ local({
+ local_libpaths(new_lib)
+ expect_equal(normalizePath(new_lib), normalizePath(.libPaths()[[1L]]))
+ })
+ expect_equal(lib, .libPaths())
+})
+
+test_that("local_temp_libpaths works and resets library", {
+ lib <- .libPaths()
+ local({
+ local_temp_libpaths()
+ expect_equal(.libPaths()[-1], lib)
+ })
+ expect_equal(lib, .libPaths())
+})
+
+test_that("local_ works", {
+ res <- NULL
+ set <- function(new) {
+ res <<- c(res, 1L)
+ }
+ reset <- function(old) {
+ res <<- c(res, 3L)
+ }
+ local_res <- local_(set, reset)
+ local({
+ local_res(NULL)
+ res <<- c(res, 2L)
+ })
+ expect_equal(res, 1L:3L)
+})
+
+test_that("local_ works on functions without arguments", {
+ res <- NULL
+ set <- function() {
+ res <<- c(res, 1L)
+ }
+ reset <- function(x) {
+ res <<- c(res, 3L)
+ }
+ local_res <- local_(set, reset)
+ local({
+ local_res()
+ res <<- c(res, 2L)
+ })
+ expect_equal(res, 1L:3L)
+})
+
+test_that("local_path works and resets path", {
+ current <- normalizePath(get_path(), mustWork = FALSE)
+ new_path <- normalizePath(".")
+ local({
+ local_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("local_path with suffix action works and resets path", {
+ current <- normalizePath(get_path(), mustWork = FALSE)
+ new_path <- normalizePath(".")
+ local({
+ local_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("local_path with replace action works and resets path", {
+ current <- normalizePath(get_path(), mustWork = FALSE)
+ new_path <- normalizePath(".")
+ local({
+ local_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("local_libpaths works and resets library", {
+ lib <- .libPaths()
+ new_lib <- "."
+ local({
+ local_libpaths(new_lib)
+ expect_equal(normalizePath(new_lib), normalizePath(.libPaths()[[1L]], mustWork = FALSE))
+ })
+ expect_equal(lib, .libPaths())
+})
+
+test_that("local_locale works and resets locales", {
+ current <- Sys.getlocale("LC_CTYPE")
+ new <- "C"
+ local({
+ local_locale(c(LC_CTYPE = new))
+ expect_equal(new, Sys.getlocale("LC_CTYPE"))
+ })
+ expect_equal(current, Sys.getlocale("LC_CTYPE"))
+})
+
+test_that("local_locale fails with LC_ALL", {
+ local({
+ expect_error(local_locale(c(LC_ALL = "C")), "LC_ALL")
+ })
+})
+
+test_that("local_collate works and resets collate", {
+ current <- Sys.getlocale("LC_COLLATE")
+ new <- "C"
+ local({
+ local_collate(new)
+ expect_equal(new, Sys.getlocale("LC_COLLATE"))
+ })
+ expect_equal(current, Sys.getlocale("LC_COLLATE"))
+})
+
+test_that("local_makevars works and resets the Makevars file", {
+ current <- tempfile()
+ writeLines(con = current, c("CFLAGS=-03"), sep = "\n")
+ new <- c(CFLAGS = "-O0")
+ local({
+ local_makevars(new, path = current)
+ expect_equal("CFLAGS=-O0", readLines(Sys.getenv("R_MAKEVARS_USER")))
+ })
+ expect_equal("CFLAGS=-03", readLines(current))
+})
+
+test_that("local_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")
+ local({
+ local_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("local_makevars works with alternative assignments", {
+ current <- tempfile()
+ writeLines(con = current, c("CFLAGS=-03"), sep = "\n")
+ new <- c(CFLAGS = "-O0")
+ local({
+ local_makevars(new, path = current, assignment = "+=")
+ expect_equal("CFLAGS+=-O0", readLines(Sys.getenv("R_MAKEVARS_USER")))
+ })
+ expect_equal("CFLAGS=-03", readLines(current))
+})
+
+test_that("local_dir works as expected", {
+ old <- normalizePath(getwd())
+ local({
+ local_dir("..")
+ expect_equal(normalizePath(getwd()), normalizePath(file.path(old, "..")))
+ })
+ expect_equal(normalizePath(getwd()), normalizePath(old))
+})
+
+test_that("local_par works as expected", {
+ tmp <- tempfile()
+
+ pdf(tmp)
+ on.exit(unlink(tmp), add = TRUE)
+
+ old <- par("pty")
+ local({
+ local_par(list(pty = "s"))
+ expect_equal(par("pty"), "s")
+ })
+ expect_equal(par("pty"), old)
+ dev.off()
+})
diff --git a/tests/testthat/test-with.R b/tests/testthat/test-with.R
index 61d18bd..ff685f0 100644
--- a/tests/testthat/test-with.R
+++ b/tests/testthat/test-with.R
@@ -32,13 +32,13 @@ test_that("with_envar respects suffix and prefix", {
})
test_that("with_options works", {
- expect_that(getOption("scipen"), not(equals(999)))
+ expect_false(identical(getOption("scipen"), 999))
expect_equal(with_options(c(scipen=999), getOption("scipen")), 999)
- expect_that(getOption("scipen"), not(equals(999)))
+ expect_false(identical(getOption("scipen"), 999))
- expect_that(getOption("zyxxyzyx"), not(equals("qwrbbl")))
+ expect_false(identical(getOption("zyxxyzyx"), "qwrbbl"))
expect_equal(with_options(c(zyxxyzyx="qwrbbl"), getOption("zyxxyzyx")), "qwrbbl")
- expect_that(getOption("zyxxyzyx"), not(equals("qwrbbl")))
+ expect_false(identical(getOption("zyxxyzyx"), "qwrbbl"))
})
test_that("with_libpaths works and resets library", {
@@ -88,7 +88,7 @@ test_that("with_ works on functions without arguments", {
})
test_that("with_path works and resets path", {
- current <- normalizePath(get_path())
+ current <- normalizePath(get_path(), mustWork = FALSE)
new_path <- normalizePath(".")
with_path(
new_path,
@@ -101,7 +101,7 @@ test_that("with_path works and resets path", {
})
test_that("with_path with suffix action works and resets path", {
- current <- normalizePath(get_path())
+ current <- normalizePath(get_path(), mustWork = FALSE)
new_path <- normalizePath(".")
with_path(
new_path,
@@ -115,7 +115,7 @@ test_that("with_path with suffix action works and resets path", {
})
test_that("with_path with replace action works and resets path", {
- current <- normalizePath(get_path())
+ current <- normalizePath(get_path(), mustWork = FALSE)
new_path <- normalizePath(".")
with_path(
new_path,
@@ -252,3 +252,18 @@ test_that("with_par works as expected", {
expect_equal(par("pty"), old)
dev.off()
})
+
+test_that("with_seed works as expected", {
+ expect_identical(
+ with_preserve_seed(runif(10L)),
+ runif(10L))
+ expect_identical(
+ with_preserve_seed(runif(10L)),
+ with_preserve_seed(runif(10L)))
+ expect_identical(
+ with_seed(1L, runif(10L)),
+ with_seed(1L, runif(10L)))
+ expect_false(with_seed(1L, runif(1L)) == runif(1L))
+ expect_false(with_seed(sample.int(.Machine$integer.max, 1), runif(1L)) ==
+ with_seed(sample.int(.Machine$integer.max, 1), runif(1L)))
+})
diff --git a/tests/testthat/test-wrap.R b/tests/testthat/test-wrap.R
new file mode 100644
index 0000000..78716df
--- /dev/null
+++ b/tests/testthat/test-wrap.R
@@ -0,0 +1,11 @@
+context("wrap")
+
+
+test_that("wrap works", {
+ v <- c(0, 0, 0)
+ set <- function(x) v[2] <<- x
+ f <- wrap(set, v[1] <<- v[1] + 1, v[3] <<- v[3] + 3)
+ expect_equal(v, c(0, 0, 0))
+ f(2)
+ expect_equal(v, 1:3)
+})
--
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