[med-svn] [r-cran-withr] 01/06: New upstream version 2.1.0
Andreas Tille
tille at debian.org
Thu Nov 9 12:34:11 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 27addf8f96e5500a47c4022aa1cd73100b46ec31
Author: Andreas Tille <tille at debian.org>
Date: Thu Nov 9 13:26:59 2017 +0100
New upstream version 2.1.0
---
DESCRIPTION | 24 ++--
MD5 | 60 ++++++----
NAMESPACE | 34 +++++-
NEWS.md | 19 ++++
R/connection.R | 39 +++++++
R/db.R | 50 ++++++++
R/defer.R | 26 ++---
R/devices.R | 163 ++++++++++++++++++++++++++
R/local_.R | 6 +-
R/namespace.R | 84 ++++++++++++++
R/seed.R | 5 +-
R/tempfile.R | 31 +++++
R/torture.R | 13 +++
R/utils.R | 4 +
R/with.R | 17 ++-
README.md | 36 +++---
man/defer.Rd | 12 +-
man/devices.Rd | 240 +++++++++++++++++++++++++++++++++++++++
man/with_collate.Rd | 2 +-
man/with_connection.Rd | 40 +++++++
man/with_db_connection.Rd | 46 ++++++++
man/with_dir.Rd | 2 +-
man/with_envvar.Rd | 2 +-
man/with_gctorture2.Rd | 29 +++++
man/with_libpaths.Rd | 2 +-
man/with_locale.Rd | 2 +-
man/with_options.Rd | 2 +-
man/with_package.Rd | 97 ++++++++++++++++
man/with_par.Rd | 2 +-
man/with_path.Rd | 2 +-
man/with_sink.Rd | 4 +-
man/with_temp_libpaths.Rd | 2 +-
man/with_tempfile.Rd | 37 ++++++
man/withr.Rd | 17 ++-
tests/testthat/test-connection.R | 51 +++++++++
tests/testthat/test-db.R | 72 ++++++++++++
tests/testthat/test-defer.R | 20 ++++
tests/testthat/test-devices.R | 68 +++++++++++
tests/testthat/test-namespace.R | 111 ++++++++++++++++++
tests/testthat/test-tempfile.R | 44 +++++++
40 files changed, 1425 insertions(+), 92 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
index 0af96d3..4211c02 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,13 +1,14 @@
Encoding: UTF-8
Package: withr
Title: Run Code 'With' Temporarily Modified Global State
-Version: 2.0.0
+Version: 2.1.0
Authors at R: c(
person("Jim", "Hester", , "james.f.hester at gmail.com", role = c("aut", "cre")),
- person("Kirill", "M<U+00FC>ller", , "krlmlr+r at mailbox.org", role = "aut"),
+ person("Kirill", "Mü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("Richard", "Cotton", role = c("ctb")),
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
@@ -18,20 +19,23 @@ BugReports: http://github.com/r-lib/withr/issues
Depends: R (>= 3.0.2)
License: GPL (>= 2)
LazyData: true
-Imports: stats, graphics
-Suggests: testthat
-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'
+Imports: stats, lattice, graphics, grDevices
+Suggests: testthat, covr, DBI, RSQLite, methods
RoxygenNote: 6.0.1
+Collate: 'local_.R' 'with_.R' 'collate.R' 'connection.R' 'db.R'
+ 'defer.R' 'wrap.R' 'devices.R' 'dir.R' 'env.R' 'libpaths.R'
+ 'locale.R' 'makevars.R' 'namespace.R' 'options.R' 'par.R'
+ 'path.R' 'seed.R' 'sink.R' 'tempfile.R' 'torture.R' 'utils.R'
+ 'with.R'
NeedsCompilation: no
-Packaged: 2017-07-28 19:07:05 UTC; jhester
+Packaged: 2017-11-01 15:24:18 UTC; jhester
Author: Jim Hester [aut, cre],
- Kirill M<U+00FC>ller [aut],
+ Kirill Müller [aut],
Kevin Ushey [aut],
Hadley Wickham [aut],
Winston Chang [aut],
+ Richard Cotton [ctb],
RStudio [cph]
Maintainer: Jim Hester <james.f.hester at gmail.com>
Repository: CRAN
-Date/Publication: 2017-07-28 22:56:28 UTC
+Date/Publication: 2017-11-01 15:52:18 UTC
diff --git a/MD5 b/MD5
index 574e621..f8696ec 100644
--- a/MD5
+++ b/MD5
@@ -1,41 +1,59 @@
-fd74cea1fd50a9a3d9108f46a27998e4 *DESCRIPTION
-ce7ada706efffb6ef3de5e21eea9b858 *NAMESPACE
-bf8de701ddde07dbf362f934640cb83b *NEWS.md
+b6b2b96cd51e2bef3378be4d6488ea61 *DESCRIPTION
+623a71222d1762b1832dece24ecfb76e *NAMESPACE
+cff7da751ab4a717a8a33dbce795e1d6 *NEWS.md
e1cbb655f59eff445b7950e74e535fd8 *R/collate.R
-b48f83bbc5eb3a4a67314f1b2a9596da *R/defer.R
+d21aa3dfe1f98bf20fcca6f3bace2cf9 *R/connection.R
+5367808d24945c8a3cfffd992a0a0f4b *R/db.R
+ba35bf8d7954ce170ed6046af5c0644a *R/defer.R
+b112ddd38b7d221237767da419766c0e *R/devices.R
a2d830766da6848a85c7ddc774ccea71 *R/dir.R
4b5c0d27740b8f7cf5c0b65ebeb432ac *R/env.R
bbfed680ded5b3a3b556a87b8726962b *R/libpaths.R
-271a519efad71b85a7395505b7e6e616 *R/local_.R
+5d19050a3db8359979ce44a699cde614 *R/local_.R
5df03f3868961416b20e8f3f4f1afe55 *R/locale.R
35cfe7b2305b7d09f59d5fd0d911f0fc *R/makevars.R
+01e0fd8d70b6ad11ded553539ea1000b *R/namespace.R
0ffde56e2ef1adc0b3ba462c78556212 *R/options.R
188e3db591fcbb3744adbc9eac9ba076 *R/par.R
25aa34b8e8e014b2e88e276602d05018 *R/path.R
-4e65a6d108fe5fbf81006a88ed992f18 *R/seed.R
+04c7d8612b078effbb76e6dbec2fe564 *R/seed.R
1939e43a0b29a1a8b446de3e0b33c233 *R/sink.R
-810b28c4a62bf4bde55c1e7524a43476 *R/utils.R
-7ee19bc605db4c27923365c3b406b071 *R/with.R
+dc01411e0ee843eebd65900889e03c91 *R/tempfile.R
+bd03783290e342d399ae55e4b96a5b2b *R/torture.R
+96b6a06d1a0f0b41dc52da05bdb80b83 *R/utils.R
+79d8537ea64031d18a07c7c594ae9f15 *R/with.R
11a3ff1b263fafab1bc53c61d18d0b81 *R/with_.R
88e44ec61deb387dd1c2d8a607c420ee *R/wrap.R
-caf782ce54b09e20a936a95d7e352770 *README.md
-6e9a4de3114c385196de87627f408e46 *man/defer.Rd
+1101d10acc3aed4269f1c217b609d308 *README.md
+ec146ff954b93557f07c608514109318 *man/defer.Rd
+5d7f68ad3e0895931de77ee9dd2f0196 *man/devices.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
+0b9c878587610015751f3fbbf64b4c09 *man/with_collate.Rd
+8ab578f58534056d1b9d11f44de62af4 *man/with_connection.Rd
+f4409fea8292158fa660931fd52cfa72 *man/with_db_connection.Rd
+b215321be57c6be7e0cda435ed396a67 *man/with_dir.Rd
+9b23b3d00276f924d91a40d0d6a09d32 *man/with_envvar.Rd
+2a33569b52280c025e40f0a8a00498ed *man/with_gctorture2.Rd
+7d6b9ba2e7eeecca182e147423e351ab *man/with_libpaths.Rd
+c163c7dedf9d85b0c54d9b17f385afd4 *man/with_locale.Rd
b72a85d8789a8b1741d045ac84e73600 *man/with_makevars.Rd
-22404976500007f821e53fdeb902bd28 *man/with_options.Rd
-647a83e43e39179fd36a59b3a975df90 *man/with_par.Rd
-a19218a6beea0af578cf251603767a18 *man/with_path.Rd
+7b6f676c325ff2822e64a6245c9a1f81 *man/with_options.Rd
+5b43ec495a4f914616c0cc4ec71b82f2 *man/with_package.Rd
+2f95ec870ee579deb0801fcecfe823f0 *man/with_par.Rd
+b98fbc3f8b613b49e76ad97be57a0aa1 *man/with_path.Rd
007fd826d391517d74b124aff1e5c725 *man/with_seed.Rd
-93bdb881ffe7b342420ed0d58bb51535 *man/with_sink.Rd
-1145a6d406831f664c32ba9b19087f5c *man/with_temp_libpaths.Rd
-cf904d272c253c7b7a2246e72b6f83bd *man/withr.Rd
+5ea9bddb1beb3dacf1380f7792b5cbc2 *man/with_sink.Rd
+65227756fd433ef3bf81eefdc021ee00 *man/with_temp_libpaths.Rd
+e29f4500358c94da6f964bb9f820c008 *man/with_tempfile.Rd
+aeceda0f70c58facc5a31a8093a72d22 *man/withr.Rd
70c4d334a0974e15d0309c48ca52ca08 *tests/testthat.R
+4219376f4cfaccbaeccc614ba9e9866c *tests/testthat/test-connection.R
+d2ed51542e4abe02bb3b1b3d8f5aec8d *tests/testthat/test-db.R
+5989fee73522cde134a8bf71815c7352 *tests/testthat/test-defer.R
+c5cae288b0b53b6ca2e48d021e2e5d28 *tests/testthat/test-devices.R
d575d8af40350566635a5a45c5262de4 *tests/testthat/test-local.R
+95249441369039d904fa844406f0e057 *tests/testthat/test-namespace.R
a71a65191ace70d64dd670ebf8f8bdb2 *tests/testthat/test-sink.R
+83c5918263499305b818480c00e86f3d *tests/testthat/test-tempfile.R
7eb747a52816e57e84a0ada71fdfecee *tests/testthat/test-with.R
0effd9528f896e3322dfeb26a0fdc7d5 *tests/testthat/test-wrap.R
diff --git a/NAMESPACE b/NAMESPACE
index d701544..e2448c6 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -1,33 +1,65 @@
# Generated by roxygen2: do not edit by hand
-S3method(print,later)
export(defer)
export(defer_parent)
export(local_)
+export(local_bmp)
+export(local_cairo_pdf)
+export(local_cairo_ps)
export(local_collate)
+export(local_connection)
+export(local_db_connection)
export(local_dir)
+export(local_environment)
export(local_envvar)
+export(local_jpeg)
export(local_libpaths)
export(local_locale)
export(local_message_sink)
+export(local_namespace)
export(local_options)
export(local_output_sink)
+export(local_package)
export(local_par)
export(local_path)
+export(local_pdf)
+export(local_png)
+export(local_postscript)
+export(local_svg)
export(local_temp_libpaths)
+export(local_tempfile)
+export(local_tiff)
+export(local_xfig)
export(with_)
+export(with_bmp)
+export(with_cairo_pdf)
+export(with_cairo_ps)
export(with_collate)
+export(with_connection)
+export(with_db_connection)
export(with_dir)
+export(with_environment)
export(with_envvar)
+export(with_jpeg)
export(with_libpaths)
export(with_locale)
export(with_makevars)
export(with_message_sink)
+export(with_namespace)
export(with_options)
export(with_output_sink)
+export(with_package)
export(with_par)
export(with_path)
+export(with_pdf)
+export(with_png)
+export(with_postscript)
export(with_preserve_seed)
export(with_seed)
+export(with_svg)
export(with_temp_libpaths)
+export(with_tempfile)
+export(with_tiff)
+export(with_xfig)
importFrom(stats,runif)
+importFrom(stats,setNames)
diff --git a/NEWS.md b/NEWS.md
index 8b89e77..5a00378 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,3 +1,22 @@
+# 2.1.0
+
+- `with_connection()` function to automatically close R file connections.
+
+- `with_db_connection()` function to automatically disconnect from DBI database
+ connections.
+
+- `with_gctorture2` command to run code with gctorture2, useful for testing
+ (#47).
+
+- `with_package()`, `with_namespace()` and `with_environment()` (and equivalent
+ locals) functions added, to run code with a modified object search path (#38,
+ #48).
+
+- Add `with_tempfile()` and `local_tempfile()` functions to create temporary
+ files which are cleanup up afterwards. (#32)
+
+- Remove the `code` argument from `local_` functions (#50).
+
# 2.0.0
- Each `with_` function now has a `local_` variant, which reset at the end of
diff --git a/R/connection.R b/R/connection.R
new file mode 100644
index 0000000..96062a1
--- /dev/null
+++ b/R/connection.R
@@ -0,0 +1,39 @@
+#' Connections which close themselves
+#'
+#' R file connections which are automatically closed.
+#'
+#' @template with
+#' @param con For `with_connection()` a named list with the connection(s) to
+#' create. For `local_connection()` the code to create a single connection,
+#' which is then returned.
+#' @param .local_envir `[environment]`\cr The environment to use for scoping.
+#' @importFrom stats setNames
+#' @examples
+#' with_connection(list(con = file("foo", "w")), {
+#' writeLines(c("foo", "bar"), con)
+#' })
+#'
+#' read_foo <- function() {
+#' readLines(local_connection(file("foo", "r")))
+#' }
+#' read_foo()
+#' @export
+with_connection <- function(con, code) {
+
+ stopifnot(all(is.named(con)))
+
+ nme <- tempfile()
+ (get("attach", baseenv()))(con, name = nme, warn.conflicts = FALSE)
+ on.exit({
+ for (connection in con) close(connection)
+ detach(nme, character.only = TRUE)
+ })
+ force(code)
+}
+
+#' @rdname with_connection
+#' @export
+local_connection <- function(con, .local_envir = parent.frame()) {
+ defer(close(con), envir = .local_envir)
+ con
+}
diff --git a/R/db.R b/R/db.R
new file mode 100644
index 0000000..5ac065c
--- /dev/null
+++ b/R/db.R
@@ -0,0 +1,50 @@
+#' DBMS Connections which disconnect themselves.
+#'
+#' Connections to Database Management Systems which automatically disconnect. In
+#' particular connections which are created with `DBI::dbConnect()` and closed
+#' with `DBI::dbDisconnect()`.
+#'
+#' @template with
+#' @param con For `with_db_connection()` a named list with the connection(s) to
+#' create. For `local_db_connection()` the code to create a single connection,
+#' which is then returned.
+#' @param .local_envir `[environment]`\cr The environment to use for scoping.
+#' @importFrom stats setNames
+#' @examples
+#' db <- tempfile()
+#' with_db_connection(
+#' list(con = DBI::dbConnect(RSQLite::SQLite(), db)), {
+#' DBI::dbWriteTable(con, "mtcars", mtcars)
+#' })
+#'
+#' head_db_table <- function(...) {
+#' con <- local_db_connection(DBI::dbConnect(RSQLite::SQLite(), db))
+#' head(DBI::dbReadTable(con, "mtcars"), ...)
+#' }
+#' head_db_table()
+#' unlink(db)
+#' @export
+with_db_connection <- function(con, code) {
+ requireNamespace("DBI")
+
+ stopifnot(all(is.named(con)))
+ stopifnot(all(vlapply(con, methods::is, "DBIConnection")))
+
+ nme <- tempfile()
+ (get("attach", baseenv()))(con, name = nme, warn.conflicts = FALSE)
+ on.exit({
+ for (connection in con) DBI::dbDisconnect(connection)
+ detach(nme, character.only = TRUE)
+ })
+ force(code)
+}
+
+#' @rdname with_db_connection
+#' @export
+local_db_connection <- function(con, .local_envir = parent.frame()) {
+ requireNamespace("DBI")
+ stopifnot(methods::is(con, "DBIConnection"))
+
+ defer(DBI::dbDisconnect(con), envir = .local_envir)
+ con
+}
diff --git a/R/defer.R b/R/defer.R
index 622daa5..92eb99c 100644
--- a/R/defer.R
+++ b/R/defer.R
@@ -20,13 +20,13 @@
#' executes the registered handler when the function associated with the
#' requested environment finishes execution.
#'
-#' @family scope-related functions
+#' @family local-related functions
#' @export
#' @author Kevin Ushey
#' @examples
-#' # define a 'scope' function that creates a file, and
+#' # define a 'local' function that creates a file, and
#' # removes it when the parent function has finished executing
-#' scope_file <- function(path) {
+#' local_file <- function(path) {
#' file.create(path)
#' defer_parent(unlink(path))
#' }
@@ -34,19 +34,19 @@
#' # create tempfile path
#' path <- tempfile()
#'
-#' # use 'scope_file' in a function
+#' # use 'local_file' in a function
#' local({
-#' scope_file(path)
+#' local_file(path)
#' stopifnot(file.exists(path))
#' })
#'
-#' # file is deleted as we leave 'local' scope
+#' # file is deleted as we leave 'local' local
#' stopifnot(!file.exists(path))
#'
#' # investigate how 'defer' modifies the
#' # executing function's environment
#' local({
-#' scope_file(path)
+#' local_file(path)
#' print(attributes(environment()))
#' })
defer <- function(expr, envir = parent.frame(), priority = c("first", "last")) {
@@ -54,7 +54,7 @@ defer <- function(expr, envir = parent.frame(), priority = c("first", "last")) {
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))
+ invisible(add_handler(envir, list(expr = substitute(expr), envir = parent.frame()), front))
}
#' @rdname defer
@@ -104,13 +104,3 @@ add_handler <- function(envir, handler, front) {
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/devices.R b/R/devices.R
new file mode 100644
index 0000000..440dad1
--- /dev/null
+++ b/R/devices.R
@@ -0,0 +1,163 @@
+#' @include wrap.R
+NULL
+
+# Internal *_dev functions ------------------------------------------------
+
+pdf_dev <- wrap(grDevices::pdf, NULL, grDevices::dev.cur())
+
+postscript_dev <- wrap(grDevices::postscript, NULL, grDevices::dev.cur())
+
+svg_dev <- wrap(grDevices::svg, NULL, grDevices::dev.cur())
+
+xfig_dev <- wrap(grDevices::xfig, NULL, grDevices::dev.cur())
+
+
+# These functions arguments differ between R versions, so just use ...
+
+cairo_pdf_dev <- function(filename, ...) {
+ grDevices::cairo_pdf(filename = filename, ...)
+ grDevices::dev.cur()
+}
+
+cairo_ps_dev <- function(filename, ...) {
+ grDevices::cairo_ps(filename = filename, ...)
+ grDevices::dev.cur()
+}
+
+# These functions arguments differ between unix and windows, so just use ...
+
+bmp_dev <- function(filename, ...) {
+ grDevices::bmp(filename = filename, ...)
+ grDevices::dev.cur()
+}
+
+tiff_dev <- function(filename, ...) {
+ grDevices::tiff(filename = filename, ...)
+ grDevices::dev.cur()
+}
+
+png_dev <- function(filename, ...) {
+ grDevices::png(filename = filename, ...)
+ grDevices::dev.cur()
+}
+
+jpeg_dev <- function(filename, ...) {
+ grDevices::jpeg(filename = filename, ...)
+ grDevices::dev.cur()
+}
+
+# User-level with_* fns ---------------------------------------------------
+
+#' Graphics devices
+#'
+#' Temporarily use a graphics device.
+#'
+#' @name devices
+#' @aliases with_dev with_device
+#' @template with
+#' @param new \code{[named character]}\cr New graphics device
+#' @param ... Additional arguments passed to the graphics device.
+#' @param .local_envir `[environment]`\cr The environment to use for scoping.
+#' @seealso \code{\link[grDevices]{Devices}}
+#' @examples
+#' # dimensions are in inches
+#' with_pdf(file.path(tempdir(), "test.pdf"), width = 7, height = 5,
+#' plot(runif(5))
+#' )
+#'
+#' # dimensions are in pixels
+#' with_png(file.path(tempdir(), "test.png"), width = 800, height = 600,
+#' plot(runif(5))
+#' )
+NULL
+
+#' @describeIn devices BMP device
+#' @export
+with_bmp <- with_(bmp_dev, grDevices::dev.off)
+
+#' @rdname devices
+#' @export
+local_bmp <- local_(bmp_dev, grDevices::dev.off)
+
+#' @describeIn devices CAIRO_PDF device
+#' @inheritParams grDevices::cairo_pdf
+#' @export
+with_cairo_pdf <- with_(cairo_pdf_dev, grDevices::dev.off)
+
+#' @rdname devices
+#' @export
+local_cairo_pdf <- local_(cairo_pdf_dev, grDevices::dev.off)
+
+#' @describeIn devices CAIRO_PS device
+#' @inheritParams grDevices::cairo_ps
+#' @export
+with_cairo_ps <- with_(cairo_ps_dev, grDevices::dev.off)
+
+#' @rdname devices
+#' @export
+local_cairo_ps <- local_(cairo_ps_dev, grDevices::dev.off)
+
+#' @describeIn devices PDF device
+#' @inheritParams grDevices::pdf
+#' @export
+with_pdf <- with_(pdf_dev, grDevices::dev.off)
+
+#' @rdname devices
+#' @export
+local_pdf <- local_(pdf_dev, grDevices::dev.off)
+
+#' @describeIn devices POSTSCRIPT device
+#' @inheritParams grDevices::postscript
+#' @param command the command to be used for \sQuote{printing}. Defaults
+#' to \code{"default"}, the value of option \code{"printcmd"}. The
+#' length limit is \code{2*PATH_MAX}, typically 8096 bytes on unix systems and
+#' 520 bytes on windows.
+#' @export
+with_postscript <- with_(postscript_dev, grDevices::dev.off)
+
+#' @rdname devices
+#' @export
+local_postscript <- local_(postscript_dev, grDevices::dev.off)
+
+#' @describeIn devices SVG device
+#' @inheritParams grDevices::svg
+#' @export
+with_svg <- with_(svg_dev, grDevices::dev.off)
+
+#' @rdname devices
+#' @export
+local_svg <- local_(svg_dev, grDevices::dev.off)
+
+#' @describeIn devices TIFF device
+#' @export
+with_tiff <- with_(tiff_dev, grDevices::dev.off)
+
+
+#' @rdname devices
+#' @export
+local_tiff <- local_(tiff_dev, grDevices::dev.off)
+
+#' @describeIn devices XFIG device
+#' @inheritParams grDevices::xfig
+#' @export
+with_xfig <- with_(xfig_dev, grDevices::dev.off)
+
+#' @rdname devices
+#' @export
+local_xfig <- local_(xfig_dev, grDevices::dev.off)
+
+#' @describeIn devices PNG device
+#' @export
+with_png <- with_(png_dev, grDevices::dev.off)
+
+#' @rdname devices
+#' @export
+local_png <- local_(png_dev, grDevices::dev.off)
+
+#' @describeIn devices JPEG device
+#' @export
+with_jpeg <- with_(jpeg_dev, grDevices::dev.off)
+
+#' @rdname devices
+#' @export
+local_jpeg <- local_(jpeg_dev, grDevices::dev.off)
diff --git a/R/local_.R b/R/local_.R
index 80cc33e..92b0ae8 100644
--- a/R/local_.R
+++ b/R/local_.R
@@ -11,12 +11,12 @@ local_ <- function(set, reset = set, envir = parent.frame()) {
# rename first formal to new
called_fmls[[1]] <- as.symbol("new")
- fun_args <- c(alist(new =, code =), fmls[-1L])
+ fun_args <- c(alist(new =), fmls[-1L])
} else {
- # no formals -- only have code
+ # no formals
called_fmls <- NULL
- fun_args <- alist(code =)
+ fun_args <- alist()
}
set_call <- as.call(c(substitute(set), called_fmls))
diff --git a/R/namespace.R b/R/namespace.R
new file mode 100644
index 0000000..2098e98
--- /dev/null
+++ b/R/namespace.R
@@ -0,0 +1,84 @@
+#' Execute code with a modified search path
+#'
+#' `with_package()` attaches a package to the search path, executes the code, then
+#' removes the package from the search path. The package namespace is _not_
+#' unloaded however. `with_namespace()` does the same thing, but attaches the
+#' package namespace to the search path, so all objects (even unexported ones) are also
+#' available on the search path.
+#' @param package \code{[character(1)]}\cr package name to load.
+#' @param env \code{[environment()]}\cr Environment to attach.
+#' @param .local_envir `[environment]`\cr The environment to use for scoping.
+#' @inheritParams defer
+#' @inheritParams base::library
+#' @template with
+#' @examples
+#' \dontrun{
+#' with_package("ggplot2", {
+#' ggplot(mtcars) + geom_point(aes(wt, hp))
+#' })
+#' }
+#' @export
+with_package <- function(package, code, help, pos = 2, lib.loc = NULL,
+ character.only = TRUE, logical.return = FALSE, warn.conflicts = TRUE,
+ quietly = TRUE, verbose = getOption("verbose")) {
+
+ suppressPackageStartupMessages(
+ (get("library"))(package, help = help, pos = pos, lib.loc = lib.loc,
+ character.only = character.only, logical.return = logical.return,
+ warn.conflicts = warn.conflicts, quietly = quietly, verbose = verbose))
+
+ on.exit(detach(paste0("package:", package), character.only = TRUE))
+ force(code)
+}
+
+#' @rdname with_package
+#' @export
+local_package <- function(package, help, pos = 2, lib.loc = NULL,
+ character.only = TRUE, logical.return = FALSE, warn.conflicts = TRUE,
+ quietly = TRUE, verbose = getOption("verbose"),
+ .local_envir = parent.frame()) {
+
+ suppressPackageStartupMessages(
+ (get("library"))(package, help = help, pos = pos, lib.loc = lib.loc,
+ character.only = character.only, logical.return = logical.return,
+ warn.conflicts = warn.conflicts, quietly = quietly, verbose = verbose))
+
+ defer(detach(paste0("package:", package), character.only = TRUE), envir = .local_envir)
+}
+
+#' @rdname with_package
+#' @export
+with_namespace <- function(package, code) {
+ ns <- asNamespace(package)
+ name <- format(ns)
+ (get("attach"))(ns, name = name)
+ on.exit(detach(name, character.only = TRUE))
+ force(code)
+}
+
+#' @rdname with_package
+#' @export
+local_namespace <- function(package, .local_envir = parent.frame()) {
+ ns <- asNamespace(package)
+ name <- format(ns)
+ (get("attach"))(ns, name = name)
+ defer(detach(name, character.only = TRUE), envir = .local_envir)
+}
+
+#' @rdname with_package
+#' @inheritParams base::attach
+#' @export
+with_environment <- function(env, code, pos = 2L, name = format(env),
+ warn.conflicts = FALSE) {
+ (get("attach"))(env, name = name)
+ on.exit(detach(name, character.only = TRUE))
+ force(code)
+}
+
+#' @rdname with_package
+#' @export
+local_environment <- function(env, pos = 2L, name = format(env),
+ warn.conflicts = FALSE, .local_envir = parent.frame()) {
+ (get("attach"))(env, name = name)
+ defer(detach(name, character.only = TRUE), envir = .local_envir)
+}
diff --git a/R/seed.R b/R/seed.R
index a4d5a17..43d16b3 100644
--- a/R/seed.R
+++ b/R/seed.R
@@ -47,5 +47,8 @@ get_valid_seed <- function() {
}
get_seed <- function() {
- get0(".Random.seed", globalenv(), mode = "integer")
+ if (!exists(".Random.seed", globalenv(), mode = "integer", inherits = FALSE)) {
+ return(NULL)
+ }
+ get(".Random.seed", globalenv(), mode = "integer", inherits = FALSE)
}
diff --git a/R/tempfile.R b/R/tempfile.R
new file mode 100644
index 0000000..148f0aa
--- /dev/null
+++ b/R/tempfile.R
@@ -0,0 +1,31 @@
+#' Temporary files
+#'
+#' Temporarily create a tempfile, which is automatically removed afterwards.
+#' @template with
+#' @param new `[character vector]`\cr Names of temporary file handles to create.
+#' @param envir `[environment]`\cr Environment in which to define the temporary files.
+#' @inheritParams base::tempfile
+#' @export
+with_tempfile <- function(new, code, envir = parent.frame(),
+ pattern = "file", tmpdir = tempdir(), fileext = "") {
+ env <- new.env(parent = envir)
+ for (f in new) {
+ assign(f,
+ tempfile(pattern = pattern, tmpdir = tmpdir, fileext = fileext),
+ envir = env)
+ }
+ on.exit(unlink(mget(new, envir = env)))
+ eval(substitute(code), envir = env)
+}
+
+#' @rdname with_tempfile
+#' @export
+local_tempfile <- function(new, envir = parent.frame(),
+ pattern = "file", tmpdir = tempdir(), fileext = "") {
+ for (f in new) {
+ assign(f,
+ tempfile(pattern = pattern, tmpdir = tmpdir, fileext = fileext),
+ envir = envir)
+ }
+ defer(unlink(mget(new, envir = envir)), envir = envir)
+}
diff --git a/R/torture.R b/R/torture.R
new file mode 100644
index 0000000..cb7e9a6
--- /dev/null
+++ b/R/torture.R
@@ -0,0 +1,13 @@
+#' Torture Garbage Collector
+#'
+#' Temporarily turn gctorture2 on.
+#'
+#' @template with
+#' @param new `[integer]`\cr run GC every 'step' allocations.
+#' @inheritParams base::gctorture
+#' @inheritParams local_
+with_gctorture2 <- with_(gctorture2)
+formals(with_gctorture2)[[3]] <- quote(new)
+
+local_gctorture2 <- local_(gctorture2)
+formals(local_gctorture2)[[2]] <- quote(new)
diff --git a/R/utils.R b/R/utils.R
index 4e1255d..99f723d 100644
--- a/R/utils.R
+++ b/R/utils.R
@@ -1,3 +1,7 @@
make_call <- function(...) {
as.call(list(...))
}
+
+vlapply <- function(X, FUN, ..., FUN.VALUE = logical(1)) {
+ vapply(X, FUN, ..., FUN.VALUE = FUN.VALUE)
+}
diff --git a/R/with.R b/R/with.R
index 88f986f..5088587 100644
--- a/R/with.R
+++ b/R/with.R
@@ -4,7 +4,9 @@
#' aspect of the global environment is modified (see below for a list).
#' Then, custom code (passed via the `code` argument) is executed.
#' Upon completion or error, the global environment is restored to the previous
-#' state.
+#' state. Each `with_` function has a `local_` variant, which instead resets
+#' the state when the current evaluation context ends (such as the end of a
+#' function).
#'
#' @section Arguments pattern:
#' \tabular{lll}{
@@ -42,11 +44,18 @@
#' with_dir(tempdir(), getwd())
#' getwd()
#'
-#' Sys.getenv("HADLEY")
-#' with_envvar(c("HADLEY" = 2), Sys.getenv("HADLEY"))
-#' Sys.getenv("HADLEY")
+#' Sys.getenv("WITHR")
+#' with_envvar(c("WITHR" = 2), Sys.getenv("WITHR"))
+#' Sys.getenv("WITHR")
#'
#' with_envvar(c("A" = 1),
#' with_envvar(c("A" = 2), action = "suffix", Sys.getenv("A"))
#' )
+#'
+#' # local variants are best used within other functions
+#' f <- function(x) {
+#' local_envvar(c("WITHR" = 2))
+#' Sys.getenv("WITHR")
+#' }
+#' Sys.getenv("WITHR")
NULL
diff --git a/README.md b/README.md
index 39aa61a..ad46153 100644
--- a/README.md
+++ b/README.md
@@ -1,8 +1,9 @@
+
<!-- README.md is generated from README.Rmd. Please edit that file -->
Withr - Run Code 'With' Modified State
======================================
-[](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 [...]
+[](https://travis-ci.org/r-lib/withr) [](https://ci.appveyor.com/project/jimhester/withr) [](https://codecov.io/github/r-lib/withr?branch=master) [](http://www.r- [...]
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.
@@ -17,24 +18,19 @@ Many of these functions were originally a part of the [devtools](https://github.
- `with_options()` / `local_options()` - options
- `with_par()` / `local_par()` - graphics parameters
- `with_path()` / `local_path()` - PATH environment variable
+- `with_*()` and `local_()` functions for the built in R devices, `bmp`, `cairo_pdf`, `cairo_ps`, `pdf`, `postscript`, `svg`, `tiff`, `xfig`, `png`, `jpeg`.
+- `with_connection()` / `local_connection()` - R connections.
+- `with_package()`, `with_namespace()` and `with_environment()` - to run code with modified object search paths.
+- `with_tempfile()` / `local_tempfile()` - Create and clean up a temp file.
There are also `with_()` and `local_()` functions to construct new `with_*` and `local_*` functions if needed.
``` r
-dir.create("test")
-getwd()
-#> [1] "/private/var/folders/dt/r5s12t392tb5sk181j3gs4zw0000gn/T/Rtmp8xR1aN"
-with_dir("test", getwd())
-#> [1] "/private/var/folders/dt/r5s12t392tb5sk181j3gs4zw0000gn/T/Rtmp8xR1aN/test"
-getwd()
-#> [1] "/private/var/folders/dt/r5s12t392tb5sk181j3gs4zw0000gn/T/Rtmp8xR1aN"
-unlink("test")
-
-Sys.getenv("HADLEY")
+Sys.getenv("WITHR")
#> [1] ""
-with_envvar(c("HADLEY" = 2), Sys.getenv("HADLEY"))
+with_envvar(c("WITHR" = 2), Sys.getenv("WITHR"))
#> [1] "2"
-Sys.getenv("HADLEY")
+Sys.getenv("WITHR")
#> [1] ""
with_envvar(c("A" = 1),
@@ -43,6 +39,20 @@ with_envvar(c("A" = 1),
#> [1] "1 2"
```
+local functions
+---------------
+
+These functions are variants of the corresponding `with_()` function, but rather than resetting the value at the end of the function call they reset when the current context goes out of scope. This is most useful for using within functions.
+
+``` r
+f <- function(x) {
+ local_envvar(c("WITHR" = 2))
+ Sys.getenv("WITHR")
+}
+Sys.getenv("WITHR")
+#> [1] ""
+```
+
See Also
========
diff --git a/man/defer.Rd b/man/defer.Rd
index 8db4f8f..b49a0d4 100644
--- a/man/defer.Rd
+++ b/man/defer.Rd
@@ -33,9 +33,9 @@ executes the registered handler when the function associated with the
requested environment finishes execution.
}
\examples{
-# define a 'scope' function that creates a file, and
+# define a 'local' function that creates a file, and
# removes it when the parent function has finished executing
-scope_file <- function(path) {
+local_file <- function(path) {
file.create(path)
defer_parent(unlink(path))
}
@@ -43,19 +43,19 @@ scope_file <- function(path) {
# create tempfile path
path <- tempfile()
-# use 'scope_file' in a function
+# use 'local_file' in a function
local({
- scope_file(path)
+ local_file(path)
stopifnot(file.exists(path))
})
-# file is deleted as we leave 'local' scope
+# file is deleted as we leave 'local' local
stopifnot(!file.exists(path))
# investigate how 'defer' modifies the
# executing function's environment
local({
- scope_file(path)
+ local_file(path)
print(attributes(environment()))
})
}
diff --git a/man/devices.Rd b/man/devices.Rd
new file mode 100644
index 0000000..2bee7c3
--- /dev/null
+++ b/man/devices.Rd
@@ -0,0 +1,240 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/devices.R
+\name{devices}
+\alias{devices}
+\alias{with_dev}
+\alias{with_device}
+\alias{with_bmp}
+\alias{local_bmp}
+\alias{with_cairo_pdf}
+\alias{local_cairo_pdf}
+\alias{with_cairo_ps}
+\alias{local_cairo_ps}
+\alias{with_pdf}
+\alias{local_pdf}
+\alias{with_postscript}
+\alias{local_postscript}
+\alias{with_svg}
+\alias{local_svg}
+\alias{with_tiff}
+\alias{local_tiff}
+\alias{with_xfig}
+\alias{local_xfig}
+\alias{with_png}
+\alias{local_png}
+\alias{with_jpeg}
+\alias{local_jpeg}
+\title{Graphics devices}
+\usage{
+with_bmp(new, code, ...)
+
+local_bmp(new, ..., .local_envir = parent.frame())
+
+with_cairo_pdf(new, code, ...)
+
+local_cairo_pdf(new, ..., .local_envir = parent.frame())
+
+with_cairo_ps(new, code, ...)
+
+local_cairo_ps(new, ..., .local_envir = parent.frame())
+
+with_pdf(new, code, width, height, onefile, family, title, fonts, version,
+ paper, encoding, bg, fg, pointsize, pagecentre, colormodel, useDingbats,
+ useKerning, fillOddEven, compress)
+
+local_pdf(new, width, height, onefile, family, title, fonts, version, paper,
+ encoding, bg, fg, pointsize, pagecentre, colormodel, useDingbats, useKerning,
+ fillOddEven, compress, .local_envir = parent.frame())
+
+with_postscript(new, code, onefile, family, title, fonts, encoding, bg, fg,
+ width, height, horizontal, pointsize, paper, pagecentre, print.it, command,
+ colormodel, useKerning, fillOddEven)
+
+local_postscript(new, onefile, family, title, fonts, encoding, bg, fg, width,
+ height, horizontal, pointsize, paper, pagecentre, print.it, command,
+ colormodel, useKerning, fillOddEven, .local_envir = parent.frame())
+
+with_svg(new, code, width = 7, height = 7, pointsize = 12,
+ onefile = FALSE, family = "sans", bg = "white",
+ antialias = c("default", "none", "gray", "subpixel"))
+
+local_svg(new, width = 7, height = 7, pointsize = 12, onefile = FALSE,
+ family = "sans", bg = "white", antialias = c("default", "none", "gray",
+ "subpixel"), .local_envir = parent.frame())
+
+with_tiff(new, code, ...)
+
+local_tiff(new, ..., .local_envir = parent.frame())
+
+with_xfig(new, code, onefile = FALSE, encoding = "none",
+ paper = "default", horizontal = TRUE, width = 0, height = 0,
+ family = "Helvetica", pointsize = 12, bg = "transparent",
+ fg = "black", pagecentre = TRUE, defaultfont = FALSE,
+ textspecial = FALSE)
+
+local_xfig(new, onefile = FALSE, encoding = "none", paper = "default",
+ horizontal = TRUE, width = 0, height = 0, family = "Helvetica",
+ pointsize = 12, bg = "transparent", fg = "black", pagecentre = TRUE,
+ defaultfont = FALSE, textspecial = FALSE, .local_envir = parent.frame())
+
+with_png(new, code, ...)
+
+local_png(new, ..., .local_envir = parent.frame())
+
+with_jpeg(new, code, ...)
+
+local_jpeg(new, ..., .local_envir = parent.frame())
+}
+\arguments{
+\item{new}{\code{[named character]}\cr New graphics device}
+
+\item{code}{\code{[any]}\cr Code to execute in the temporary environment}
+
+\item{...}{Additional arguments passed to the graphics device.}
+
+\item{.local_envir}{\code{[environment]}\cr The environment to use for scoping.}
+
+\item{width}{the width of the device in inches.}
+
+\item{height}{the height of the device in inches.}
+
+\item{onefile}{should all plots appear in one file or in separate files?}
+
+\item{family}{one of the device-independent font families,
+ \code{"sans"}, \code{"serif"} and \code{"mono"}, or a character
+ string specify a font family to be searched for in a
+ system-dependent way.
+ See, the \sQuote{Cairo fonts} section in the help for \code{\link{X11}}.
+ }
+
+\item{title}{title string to embed as the \samp{/Title} field in the
+ file. Defaults to \code{"R Graphics Output"}.}
+
+\item{fonts}{a character vector specifying \R graphics font family
+ names for additional fonts which will be included in the PDF file.
+ Defaults to \code{NULL}.}
+
+\item{version}{a string describing the PDF version that will be
+ required to view the output. This is a minimum, and will be
+ increased (with a warning) if necessary. Defaults to \code{"1.4"},
+ but see \sQuote{Details}.}
+
+\item{paper}{the target paper size. The choices are
+ \code{"a4"}, \code{"letter"}, \code{"legal"} (or \code{"us"}) and
+ \code{"executive"} (and these can be capitalized), or \code{"a4r"}
+ and \code{"USr"} for rotated (\sQuote{landscape}).
+ The default is \code{"special"}, which means that the \code{width}
+ and \code{height} specify the paper size. A further choice is
+ \code{"default"}; if this is selected, the
+ papersize is taken from the option \code{"papersize"}
+ if that is set and as \code{"a4"} if it is unset or empty.
+ Defaults to \code{"special"}.
+ }
+
+\item{encoding}{the name of an encoding file. See
+ \code{\link{postscript}} for details. Defaults to \code{"default"}.}
+
+\item{bg}{the initial background colour: can be overridden by setting
+ par("bg").}
+
+\item{fg}{the initial foreground color to be used. Defaults to
+ \code{"black"}.}
+
+\item{pointsize}{the default pointsize of plotted text (in big points).}
+
+\item{pagecentre}{logical: should the device region be centred on the
+ page? -- is only relevant for \code{paper != "special"}.
+ Defaults to \code{TRUE}.}
+
+\item{colormodel}{a character string describing the color model:
+ currently allowed values are \code{"srgb"}, \code{"gray"} (or
+ \code{"grey"}) and \code{"cmyk"}. Defaults to \code{"srgb"}. See section
+ \sQuote{Color models}.}
+
+\item{useDingbats}{logical. Should small circles be rendered
+ \emph{via} the Dingbats font? Defaults to \code{TRUE}, which produces
+ smaller and better output. Setting this to \code{FALSE} can work
+ around font display problems in broken PDF viewers: although this
+ font is one of the 14 guaranteed to be available in all PDF viewers,
+ that guarantee is not always honoured.
+ See the \sQuote{Note} for a possible fix for some viewers.
+ }
+
+\item{useKerning}{logical. Should kerning corrections be included in
+ setting text and calculating string widths? Defaults to \code{TRUE}.}
+
+\item{fillOddEven}{logical controlling the polygon fill mode: see
+ \code{\link{polygon}} for details. Defaults to \code{FALSE}.}
+
+\item{compress}{logical. Should PDF streams be generated with Flate
+ compression? Defaults to \code{TRUE}.}
+
+\item{horizontal}{the orientation of the printed image, a logical.
+ Defaults to true, that is landscape orientation on paper sizes
+ with width less than height.}
+
+\item{print.it}{logical: should the file be printed when the device is
+ closed? (This only applies if \code{file} is a real file name.)
+ Defaults to false.}
+
+\item{command}{the command to be used for \sQuote{printing}. Defaults
+to \code{"default"}, the value of option \code{"printcmd"}. The
+length limit is \code{2*PATH_MAX}, typically 8096 bytes on unix systems and
+520 bytes on windows.}
+
+\item{antialias}{string, the type of anti-aliasing (if any) to be used;
+ defaults to \code{"default"}.}
+
+\item{defaultfont}{logical: should the device use xfig's default
+ font?}
+
+\item{textspecial}{logical: should the device set the textspecial flag
+ for all text elements. This is useful when generating pstex from xfig
+ figures.}
+}
+\value{
+\code{[any]}\cr The results of the evaluation of the \code{code}
+ argument.
+}
+\description{
+Temporarily use a graphics device.
+}
+\section{Functions}{
+\itemize{
+\item \code{with_bmp}: BMP device
+
+\item \code{with_cairo_pdf}: CAIRO_PDF device
+
+\item \code{with_cairo_ps}: CAIRO_PS device
+
+\item \code{with_pdf}: PDF device
+
+\item \code{with_postscript}: POSTSCRIPT device
+
+\item \code{with_svg}: SVG device
+
+\item \code{with_tiff}: TIFF device
+
+\item \code{with_xfig}: XFIG device
+
+\item \code{with_png}: PNG device
+
+\item \code{with_jpeg}: JPEG device
+}}
+
+\examples{
+# dimensions are in inches
+with_pdf(file.path(tempdir(), "test.pdf"), width = 7, height = 5,
+ plot(runif(5))
+)
+
+# dimensions are in pixels
+with_png(file.path(tempdir(), "test.png"), width = 800, height = 600,
+ plot(runif(5))
+)
+}
+\seealso{
+\code{\link{withr}} for examples
+
+\code{\link[grDevices]{Devices}}
+}
diff --git a/man/with_collate.Rd b/man/with_collate.Rd
index 5adc829..ed7a56a 100644
--- a/man/with_collate.Rd
+++ b/man/with_collate.Rd
@@ -7,7 +7,7 @@
\usage{
with_collate(new, code)
-local_collate(new, code, .local_envir = parent.frame())
+local_collate(new, .local_envir = parent.frame())
}
\arguments{
\item{new}{\code{[character(1)]}\cr New collation order}
diff --git a/man/with_connection.Rd b/man/with_connection.Rd
new file mode 100644
index 0000000..18fbb5f
--- /dev/null
+++ b/man/with_connection.Rd
@@ -0,0 +1,40 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/connection.R
+\name{with_connection}
+\alias{with_connection}
+\alias{local_connection}
+\title{Connections which close themselves}
+\usage{
+with_connection(con, code)
+
+local_connection(con, .local_envir = parent.frame())
+}
+\arguments{
+\item{con}{For \code{with_connection()} a named list with the connection(s) to
+create. For \code{local_connection()} the code to create a single connection,
+which is then returned.}
+
+\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{
+R file connections which are automatically closed.
+}
+\examples{
+with_connection(list(con = file("foo", "w")), {
+ writeLines(c("foo", "bar"), con)
+})
+
+read_foo <- function() {
+ readLines(local_connection(file("foo", "r")))
+}
+read_foo()
+}
+\seealso{
+\code{\link{withr}} for examples
+}
diff --git a/man/with_db_connection.Rd b/man/with_db_connection.Rd
new file mode 100644
index 0000000..29e2d77
--- /dev/null
+++ b/man/with_db_connection.Rd
@@ -0,0 +1,46 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/db.R
+\name{with_db_connection}
+\alias{with_db_connection}
+\alias{local_db_connection}
+\title{DBMS Connections which disconnect themselves.}
+\usage{
+with_db_connection(con, code)
+
+local_db_connection(con, .local_envir = parent.frame())
+}
+\arguments{
+\item{con}{For \code{with_db_connection()} a named list with the connection(s) to
+create. For \code{local_db_connection()} the code to create a single connection,
+which is then returned.}
+
+\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{
+Connections to Database Management Systems which automatically disconnect. In
+particular connections which are created with \code{DBI::dbConnect()} and closed
+with \code{DBI::dbDisconnect()}.
+}
+\examples{
+db <- tempfile()
+with_db_connection(
+ list(con = DBI::dbConnect(RSQLite::SQLite(), db)), {
+ DBI::dbWriteTable(con, "mtcars", mtcars)
+})
+
+head_db_table <- function(...) {
+ con <- local_db_connection(DBI::dbConnect(RSQLite::SQLite(), db))
+ head(DBI::dbReadTable(con, "mtcars"), ...)
+}
+head_db_table()
+unlink(db)
+}
+\seealso{
+\code{\link{withr}} for examples
+}
diff --git a/man/with_dir.Rd b/man/with_dir.Rd
index cab09f0..b56729c 100644
--- a/man/with_dir.Rd
+++ b/man/with_dir.Rd
@@ -7,7 +7,7 @@
\usage{
with_dir(new, code)
-local_dir(new, code, .local_envir = parent.frame())
+local_dir(new, .local_envir = parent.frame())
}
\arguments{
\item{new}{\code{[character(1)]}\cr New working directory}
diff --git a/man/with_envvar.Rd b/man/with_envvar.Rd
index 228f9cf..2ae7090 100644
--- a/man/with_envvar.Rd
+++ b/man/with_envvar.Rd
@@ -7,7 +7,7 @@
\usage{
with_envvar(new, code, action = "replace")
-local_envvar(new, code, action = "replace", .local_envir = parent.frame())
+local_envvar(new, action = "replace", .local_envir = parent.frame())
}
\arguments{
\item{new}{\code{[named character]}\cr New environment variables}
diff --git a/man/with_gctorture2.Rd b/man/with_gctorture2.Rd
new file mode 100644
index 0000000..3b6722f
--- /dev/null
+++ b/man/with_gctorture2.Rd
@@ -0,0 +1,29 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/torture.R
+\name{with_gctorture2}
+\alias{with_gctorture2}
+\title{Torture Garbage Collector}
+\usage{
+with_gctorture2(new, code, wait = new, inhibit_release = FALSE)
+}
+\arguments{
+\item{new}{\code{[integer]}\cr run GC every 'step' allocations.}
+
+\item{code}{\code{[any]}\cr Code to execute in the temporary environment}
+
+\item{wait}{integer; number of allocations to wait before starting
+ GC torture.}
+
+\item{inhibit_release}{logical; do not release free objects for
+ re-use: use with caution.}
+}
+\value{
+\code{[any]}\cr The results of the evaluation of the \code{code}
+ argument.
+}
+\description{
+Temporarily turn gctorture2 on.
+}
+\seealso{
+\code{\link{withr}} for examples
+}
diff --git a/man/with_libpaths.Rd b/man/with_libpaths.Rd
index 7b7dce0..3ca8392 100644
--- a/man/with_libpaths.Rd
+++ b/man/with_libpaths.Rd
@@ -7,7 +7,7 @@
\usage{
with_libpaths(new, code, action = "replace")
-local_libpaths(new, code, action = "replace", .local_envir = parent.frame())
+local_libpaths(new, action = "replace", .local_envir = parent.frame())
}
\arguments{
\item{new}{\code{[character]}\cr New library paths}
diff --git a/man/with_locale.Rd b/man/with_locale.Rd
index 949512a..97b89c2 100644
--- a/man/with_locale.Rd
+++ b/man/with_locale.Rd
@@ -7,7 +7,7 @@
\usage{
with_locale(new, code)
-local_locale(new, code, .local_envir = parent.frame())
+local_locale(new, .local_envir = parent.frame())
}
\arguments{
\item{new}{\code{[named character]}\cr New locale settings}
diff --git a/man/with_options.Rd b/man/with_options.Rd
index bc3fc90..68a2cad 100644
--- a/man/with_options.Rd
+++ b/man/with_options.Rd
@@ -7,7 +7,7 @@
\usage{
with_options(new, code)
-local_options(new, code, .local_envir = parent.frame())
+local_options(new, .local_envir = parent.frame())
}
\arguments{
\item{new}{\code{[named list]}\cr New options and their values}
diff --git a/man/with_package.Rd b/man/with_package.Rd
new file mode 100644
index 0000000..6e37fea
--- /dev/null
+++ b/man/with_package.Rd
@@ -0,0 +1,97 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/namespace.R
+\name{with_package}
+\alias{with_package}
+\alias{local_package}
+\alias{with_namespace}
+\alias{local_namespace}
+\alias{with_environment}
+\alias{local_environment}
+\title{Execute code with a modified search path}
+\usage{
+with_package(package, code, help, pos = 2, lib.loc = NULL,
+ character.only = TRUE, logical.return = FALSE, warn.conflicts = TRUE,
+ quietly = TRUE, verbose = getOption("verbose"))
+
+local_package(package, help, pos = 2, lib.loc = NULL,
+ character.only = TRUE, logical.return = FALSE, warn.conflicts = TRUE,
+ quietly = TRUE, verbose = getOption("verbose"),
+ .local_envir = parent.frame())
+
+with_namespace(package, code)
+
+local_namespace(package, .local_envir = parent.frame())
+
+with_environment(env, code, pos = 2L, name = format(env),
+ warn.conflicts = FALSE)
+
+local_environment(env, pos = 2L, name = format(env),
+ warn.conflicts = FALSE, .local_envir = parent.frame())
+}
+\arguments{
+\item{package}{\code{[character(1)]}\cr package name to load.}
+
+\item{code}{\code{[any]}\cr Code to execute in the temporary environment}
+
+\item{help}{the name of a package, given as a \link{name} or
+ literal character string, or a character string, depending on
+ whether \code{character.only} is \code{FALSE} (default) or
+ \code{TRUE}).}
+
+\item{pos}{the position on the search list at which to attach the
+ loaded namespace. Can also be the name of a position on the current
+ search list as given by \code{\link{search}()}.}
+
+\item{lib.loc}{a character vector describing the location of \R
+ library trees to search through, or \code{NULL}. The default value
+ of \code{NULL} corresponds to all libraries currently known to
+ \code{\link{.libPaths}()}.
+ Non-existent library trees are silently ignored.}
+
+\item{character.only}{a logical indicating whether \code{package} or
+ \code{help} can be assumed to be character strings.}
+
+\item{logical.return}{logical. If it is \code{TRUE}, \code{FALSE} or
+ \code{TRUE} is returned to indicate success.}
+
+\item{warn.conflicts}{logical. If \code{TRUE}, warnings are
+ printed about \code{\link{conflicts}} from attaching the new
+ package. A conflict is a function masking a function,
+ or a non-function masking a non-function.
+ }
+
+\item{quietly}{a logical. If \code{TRUE}, no message confirming
+ package attaching is printed, and most often, no errors/warnings are
+ printed if package attaching fails.}
+
+\item{verbose}{a logical. If \code{TRUE}, additional diagnostics are
+ printed.}
+
+\item{.local_envir}{\code{[environment]}\cr The environment to use for scoping.}
+
+\item{env}{\code{[environment()]}\cr Environment to attach.}
+
+\item{name}{name to use for the attached database. Names starting with
+ \code{package:} are reserved for \code{\link{library}}.}
+}
+\value{
+\code{[any]}\cr The results of the evaluation of the \code{code}
+ argument.
+}
+\description{
+\code{with_package()} attaches a package to the search path, executes the code, then
+removes the package from the search path. The package namespace is \emph{not}
+unloaded however. \code{with_namespace()} does the same thing, but attaches the
+package namespace to the search path, so all objects (even unexported ones) are also
+available on the search path.
+}
+\examples{
+\dontrun{
+with_package("ggplot2", {
+ ggplot(mtcars) + geom_point(aes(wt, hp))
+})
+}
+}
+\seealso{
+\code{\link{withr}} for examples
+}
diff --git a/man/with_par.Rd b/man/with_par.Rd
index 91b5524..7317ced 100644
--- a/man/with_par.Rd
+++ b/man/with_par.Rd
@@ -7,7 +7,7 @@
\usage{
with_par(new, code, no.readonly = FALSE)
-local_par(new, code, no.readonly = FALSE, .local_envir = parent.frame())
+local_par(new, no.readonly = FALSE, .local_envir = parent.frame())
}
\arguments{
\item{new}{\code{[named list]}\cr New graphics parameters and their values}
diff --git a/man/with_path.Rd b/man/with_path.Rd
index 1c8cf40..0a1aaa6 100644
--- a/man/with_path.Rd
+++ b/man/with_path.Rd
@@ -7,7 +7,7 @@
\usage{
with_path(new, code, action = "prefix")
-local_path(new, code, action = "prefix", .local_envir = parent.frame())
+local_path(new, action = "prefix", .local_envir = parent.frame())
}
\arguments{
\item{new}{\code{[character]}\cr New \code{PATH} entries}
diff --git a/man/with_sink.Rd b/man/with_sink.Rd
index 1669ec8..6fe418f 100644
--- a/man/with_sink.Rd
+++ b/man/with_sink.Rd
@@ -10,12 +10,12 @@
\usage{
with_output_sink(new, code, append = FALSE, split = FALSE)
-local_output_sink(new, code, append = FALSE, split = FALSE,
+local_output_sink(new, 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())
+local_message_sink(new, append = FALSE, .local_envir = parent.frame())
}
\arguments{
\item{new}{\code{[character(1)|connection]}\cr
diff --git a/man/with_temp_libpaths.Rd b/man/with_temp_libpaths.Rd
index 007ce01..ba673c5 100644
--- a/man/with_temp_libpaths.Rd
+++ b/man/with_temp_libpaths.Rd
@@ -7,7 +7,7 @@
\usage{
with_temp_libpaths(code)
-local_temp_libpaths(code, .local_envir = parent.frame())
+local_temp_libpaths(.local_envir = parent.frame())
}
\arguments{
\item{code}{\code{[any]}\cr Code to execute in the temporary environment}
diff --git a/man/with_tempfile.Rd b/man/with_tempfile.Rd
new file mode 100644
index 0000000..8ec08b3
--- /dev/null
+++ b/man/with_tempfile.Rd
@@ -0,0 +1,37 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/tempfile.R
+\name{with_tempfile}
+\alias{with_tempfile}
+\alias{local_tempfile}
+\title{Temporary files}
+\usage{
+with_tempfile(new, code, envir = parent.frame(), pattern = "file",
+ tmpdir = tempdir(), fileext = "")
+
+local_tempfile(new, envir = parent.frame(), pattern = "file",
+ tmpdir = tempdir(), fileext = "")
+}
+\arguments{
+\item{new}{\code{[character vector]}\cr Names of temporary file handles to create.}
+
+\item{code}{\code{[any]}\cr Code to execute in the temporary environment}
+
+\item{envir}{\code{[environment]}\cr Environment in which to define the temporary files.}
+
+\item{pattern}{a non-empty character vector giving the initial part
+ of the name.}
+
+\item{tmpdir}{a non-empty character vector giving the directory name}
+
+\item{fileext}{a non-empty character vector giving the file extension}
+}
+\value{
+\code{[any]}\cr The results of the evaluation of the \code{code}
+ argument.
+}
+\description{
+Temporarily create a tempfile, which is automatically removed afterwards.
+}
+\seealso{
+\code{\link{withr}} for examples
+}
diff --git a/man/withr.Rd b/man/withr.Rd
index 08a4af1..49b4719 100644
--- a/man/withr.Rd
+++ b/man/withr.Rd
@@ -10,7 +10,9 @@ 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.
+state. Each \code{with_} function has a \code{local_} variant, which instead resets
+the state when the current evaluation context ends (such as the end of a
+function).
}
\section{Arguments pattern}{
@@ -58,11 +60,18 @@ getwd()
with_dir(tempdir(), getwd())
getwd()
-Sys.getenv("HADLEY")
-with_envvar(c("HADLEY" = 2), Sys.getenv("HADLEY"))
-Sys.getenv("HADLEY")
+Sys.getenv("WITHR")
+with_envvar(c("WITHR" = 2), Sys.getenv("WITHR"))
+Sys.getenv("WITHR")
with_envvar(c("A" = 1),
with_envvar(c("A" = 2), action = "suffix", Sys.getenv("A"))
)
+
+# local variants are best used within other functions
+f <- function(x) {
+ local_envvar(c("WITHR" = 2))
+ Sys.getenv("WITHR")
+}
+Sys.getenv("WITHR")
}
diff --git a/tests/testthat/test-connection.R b/tests/testthat/test-connection.R
new file mode 100644
index 0000000..ae789b4
--- /dev/null
+++ b/tests/testthat/test-connection.R
@@ -0,0 +1,51 @@
+context("connection")
+
+describe("with_connection", {
+ it("errors if connection is not named", {
+ expect_error({
+ with_connection(list(TRUE), TRUE)
+ }, "all(is.named(con)) is not TRUE", fixed = TRUE)
+ })
+
+ it("creates a single connection", {
+ tmp <- tempfile()
+ on.exit(unlink(tmp))
+ expect_false(exists("con"))
+ with_connection(list(con = file(tmp, "w")), {
+ writeLines(c("foo", "bar"), con)
+ })
+ expect_false(exists("con"))
+ expect_equal(readLines(tmp), c("foo", "bar"))
+ })
+
+ it("creates multiple connections", {
+ tmp <- tempfile()
+ tmp2 <- tempfile()
+ on.exit(unlink(c(tmp, tmp2)))
+ expect_false(exists("con"))
+ expect_false(exists("con2"))
+ with_connection(list(con = file(tmp, "w"), con2 = file(tmp2, "w")), {
+ writeLines(c("foo", "bar"), con)
+ writeLines(c("baz", "qux"), con2)
+ })
+ expect_false(exists("con"))
+ expect_false(exists("con2"))
+ expect_equal(readLines(tmp), c("foo", "bar"))
+ expect_equal(readLines(tmp2), c("baz", "qux"))
+ })
+})
+
+describe("local_connection", {
+ it("creates a single connection", {
+ tmp <- tempfile()
+ on.exit(unlink(tmp))
+ expect_false(exists("con"))
+
+ (function() {
+ con <- local_connection(file(tmp, "w"))
+ writeLines(c("foo", "bar"), con)
+ })()
+ expect_false(exists("con"))
+ expect_equal(readLines(tmp), c("foo", "bar"))
+ })
+})
diff --git a/tests/testthat/test-db.R b/tests/testthat/test-db.R
new file mode 100644
index 0000000..1039ac7
--- /dev/null
+++ b/tests/testthat/test-db.R
@@ -0,0 +1,72 @@
+context("db")
+
+describe("with_db_connection", {
+ #it("errors if connection is not named", {
+ #expect_error({
+ #with_db_connection(list(TRUE), TRUE)
+ #}, "all(is.named(con)) is not TRUE", fixed = TRUE)
+ #})
+
+ #it("errors if connection is not a DBI connection", {
+ #expect_error({
+ #with_db_connection(list(con = TRUE), TRUE)
+ #}, "all(vlapply(con, methods::is, \"DBIConnection\")) is not TRUE", fixed = TRUE)
+ #})
+
+ it("creates a single connection", {
+ db <- tempfile()
+ on.exit(unlink(db))
+ expect_false(exists("con"))
+ with_db_connection(
+ list(con = DBI::dbConnect(RSQLite::SQLite(), db)), {
+ DBI::dbWriteTable(con, "test", data.frame(a = 1:2, b = 3:4))
+ })
+ expect_false(exists("con"))
+ con2 <- DBI::dbConnect(RSQLite::SQLite(), db)
+ on.exit(DBI::dbDisconnect(con2), add = TRUE)
+ expect_equal(DBI::dbReadTable(con2, "test"), data.frame(a = 1:2, b = 3:4))
+ })
+
+ it("creates multiple connections", {
+ db <- tempfile()
+ db2 <- tempfile()
+ on.exit(unlink(c(db, db2)))
+ expect_false(exists("con"))
+ expect_false(exists("con2"))
+ with_db_connection(
+ list(con = DBI::dbConnect(RSQLite::SQLite(), db),
+ con2 = DBI::dbConnect(RSQLite::SQLite(), db2)), {
+ DBI::dbWriteTable(con, "test", data.frame(a = 1:2, b = 3:4))
+ DBI::dbWriteTable(con2, "test", data.frame(c = 5:6, d = 7:8))
+ })
+ expect_false(exists("con"))
+ expect_false(exists("con2"))
+ con3 <- DBI::dbConnect(RSQLite::SQLite(), db)
+ con4 <- DBI::dbConnect(RSQLite::SQLite(), db2)
+
+ on.exit({
+ DBI::dbDisconnect(con3)
+ DBI::dbDisconnect(con4)
+ }, add = TRUE)
+
+ expect_equal(DBI::dbReadTable(con3, "test"), data.frame(a = 1:2, b = 3:4))
+ expect_equal(DBI::dbReadTable(con4, "test"), data.frame(c = 5:6, d = 7:8))
+ })
+})
+
+describe("local_db_connection", {
+ it("creates a single connection", {
+ db <- tempfile()
+ on.exit(unlink(db))
+ expect_false(exists("con"))
+
+ (function() {
+ con <- local_db_connection(DBI::dbConnect(RSQLite::SQLite(), db))
+ DBI::dbWriteTable(con, "test", data.frame(a = 1:2, b = 3:4))
+ })()
+ expect_false(exists("con"))
+ con2 <- DBI::dbConnect(RSQLite::SQLite(), db)
+ on.exit(DBI::dbDisconnect(con2), add = TRUE)
+ expect_equal(DBI::dbReadTable(con2, "test"), data.frame(a = 1:2, b = 3:4))
+ })
+})
diff --git a/tests/testthat/test-defer.R b/tests/testthat/test-defer.R
new file mode 100644
index 0000000..252974e
--- /dev/null
+++ b/tests/testthat/test-defer.R
@@ -0,0 +1,20 @@
+context("defer")
+
+test_that("defer_parent works", {
+ local_file <- function(path) {
+ file.create(path)
+ defer_parent(unlink(path))
+ }
+
+ # create tempfile path
+ path <- tempfile()
+
+ # use 'local_file' in a function
+ local({
+ local_file(path)
+ stopifnot(file.exists(path))
+ })
+
+ # file is deleted as we leave 'local' scope
+ expect_false(file.exists(path))
+})
diff --git a/tests/testthat/test-devices.R b/tests/testthat/test-devices.R
new file mode 100644
index 0000000..2815d33
--- /dev/null
+++ b/tests/testthat/test-devices.R
@@ -0,0 +1,68 @@
+context("devices")
+
+test_that("with_*device* functions create a plot file", {
+ # A plot
+ p <- lattice::xyplot(y ~ x, data.frame(x = -2:2, y = dnorm(-2:2)))
+
+ # A directory to store the plots
+ plot_dir <- tempfile("withr-test-plots-")
+ dir.create(plot_dir)
+
+ fn_names <- c("with_bmp", "with_cairo_pdf", "with_cairo_ps", "with_jpeg",
+ "with_pdf", "with_png", "with_svg", "with_tiff", "with_xfig")
+
+ fns <- mget(fn_names, envir = asNamespace("withr"))
+ extensions <- c("bmp", "pdf", "ps", "jpg", "pdf", "png", "svg", "tiff", "xfig")
+ for (i in seq_along(fns)) {
+ filename <- file.path(plot_dir, paste0("test-", fn_names[i], ".", extensions[i]))
+ info <- paste0("function = ", fn_names[i], "; filename = ", filename)
+ if (fn_names[i] == "with_xfig") {
+ # grDevices::xfig weirdly gives a warning with the default inputs
+ expect_warning(
+ fns[[i]](filename, print(p)),
+ "will only return the last plot"
+ )
+ } else {
+ expect_silent(fns[[i]](filename, print(p)))
+ }
+ expect_true(file.exists(filename), info = info)
+ expect_gt(file.info(filename)$size, 0, label = info)
+ }
+
+ unlink(plot_dir)
+})
+
+test_that("local_device functions create a plot file", {
+ # A plot
+ p <- lattice::xyplot(y ~ x, data.frame(x = -2:2, y = dnorm(-2:2)))
+
+ # A directory to store the plots
+ plot_dir <- tempfile("withr-test-plots-local-")
+ dir.create(plot_dir)
+
+ fn_names <- c("local_bmp", "local_cairo_pdf", "local_cairo_ps", "local_jpeg",
+ "local_pdf", "local_png", "local_svg", "local_tiff", "local_xfig")
+
+ fns <- mget(fn_names, envir = asNamespace("withr"))
+ extensions <- c("bmp", "pdf", "ps", "jpg", "pdf", "png", "svg", "tiff", "xfig")
+
+ for (i in seq_along(fns)) {
+ filename <- file.path(plot_dir, paste0("test-", fn_names[i], ".", extensions[i]))
+ info <- paste0("function = ", fn_names[i], "; filename = ", filename)
+ (function(i) {
+ if (fn_names[i] == "local_xfig") {
+ # grDevices::xfig weirdly gives a warning with the default inputs
+ expect_warning(
+ fns[[i]](filename),
+ "will only return the last plot")
+ } else {
+ expect_silent(fns[[i]](filename))
+ }
+ print(p)
+ })(i)
+ expect_true(file.exists(filename), info = info)
+ expect_gt(file.info(filename)$size, 0, label = info)
+ }
+
+ unlink(plot_dir)
+})
diff --git a/tests/testthat/test-namespace.R b/tests/testthat/test-namespace.R
new file mode 100644
index 0000000..fb2d338
--- /dev/null
+++ b/tests/testthat/test-namespace.R
@@ -0,0 +1,111 @@
+context("namespace")
+
+test_that("with_package works", {
+
+ # tools package not attached to the search path
+ expect_false("package:tools" %in% search())
+
+ with_package("tools",
+
+ # SIGINT is an exported object in tools
+ expect_equal(SIGINT, 2))
+
+ # tools package still not attached to the search path
+ expect_false("package:tools" %in% search())
+})
+
+test_that("local_package works", {
+
+ # tools package not attached to the search path
+ expect_false("package:tools" %in% search())
+
+ f <- function() {
+ local_package("tools")
+
+ # SIGINT is an exported object in tools
+ expect_equal(SIGINT, 2)
+ }
+
+ f()
+
+ # tools package still not attached to the search path
+ expect_false("package:tools" %in% search())
+})
+
+test_that("with_namespace works", {
+
+ # tools package not attached to the search path
+ expect_false("<environment: namespace:tools>" %in% search())
+
+ with_namespace("tools", {
+
+ expect_true("<environment: namespace:tools>" %in% search())
+
+ # .check_packages is a non-exported object in tools
+ expect_true(is.function(.check_packages))
+ })
+
+ # tools namespace still not attached to the search path
+ expect_false("<environment: namespace:tools>" %in% search())
+})
+
+test_that("local_namespace works", {
+
+ # tools package not attached to the search path
+ expect_false("<environment: namespace:tools>" %in% search())
+
+ f <- function() {
+ local_namespace("tools")
+
+ expect_true("<environment: namespace:tools>" %in% search())
+
+ # .check_packages is a non-exported object in tools
+ expect_true(is.function(.check_packages))
+ }
+
+ f()
+
+ # tools namespace still not attached to the search path
+ expect_false("<environment: namespace:tools>" %in% search())
+})
+
+test_that("with_environment works", {
+
+ e <- new.env()
+ e$a <- 1
+
+ # environment not attached to the search path
+ expect_false(format(e) %in% search())
+
+ with_environment(e, {
+
+ # environment attached to the search path
+ expect_true(format(e) %in% search())
+ expect_equal(a, 1)
+ })
+
+ # environment not attached to the search path
+ expect_false(format(e) %in% search())
+})
+
+test_that("local_environment works", {
+
+ e <- new.env()
+ e$a <- 1
+
+ # environment not attached to the search path
+ expect_false(format(e) %in% search())
+
+ f <- function() {
+ local_environment(e)
+
+ # environment attached to the search path
+ expect_true(format(e) %in% search())
+ expect_equal(a, 1)
+ }
+
+ f()
+
+ # environment not attached to the search path
+ expect_false(format(e) %in% search())
+})
diff --git a/tests/testthat/test-tempfile.R b/tests/testthat/test-tempfile.R
new file mode 100644
index 0000000..f85676d
--- /dev/null
+++ b/tests/testthat/test-tempfile.R
@@ -0,0 +1,44 @@
+context("tempfile")
+
+test_that("with_tempfile works", {
+
+ f1 <- character()
+ f2 <- character()
+
+ with_tempfile("file1", {
+ writeLines("foo", file1)
+ expect_equal(readLines(file1), "foo")
+ with_tempfile("file2", {
+ writeLines("bar", file2)
+ expect_equal(readLines(file1), "foo")
+ expect_equal(readLines(file2), "bar")
+
+ f2 <<- file2
+ })
+ expect_false(file.exists(f2))
+ f1 <<- file1
+ })
+ expect_false(file.exists(f1))
+})
+
+test_that("local_tempfile works", {
+
+ f1 <- character()
+ f2 <- character()
+
+ f <- function() {
+ local_tempfile("file1")
+ writeLines("foo", file1)
+ expect_equal(readLines(file1), "foo")
+ local_tempfile("file2")
+ writeLines("bar", file2)
+ expect_equal(readLines(file1), "foo")
+ expect_equal(readLines(file2), "bar")
+ f1 <<- file1
+ f2 <<- file2
+ }
+ f()
+
+ expect_false(file.exists(f1))
+ expect_false(file.exists(f2))
+})
--
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