Commit fba621cc authored by Dirk Eddelbuettel's avatar Dirk Eddelbuettel

Import Upstream version 0.1.0

parents
Package: ellipsis
Version: 0.1.0
Title: Tools for Working with ...
Description: In S3 generics, it's useful to take ... so that methods can
have additional argument. But this flexibility comes at a cost: misspelled
arguments will be silently ignored. The ellipsis packages is an experiment
that allows a generic to warn if any arguments passed in ... are not
used.
Authors@R: c(
person("Hadley", "Wickham", , "hadley@rstudio.com", role = c("aut", "cre")),
person("RStudio", role = "cph")
)
License: GPL-3
Encoding: UTF-8
LazyData: true
RoxygenNote: 6.1.1
URL: https://github.com/hadley/ellipsis
BugReports: https://github.com/hadley/ellipsis/issues
Depends: R (>= 3.1)
Suggests: covr, testthat
NeedsCompilation: yes
Packaged: 2019-02-18 23:26:43 UTC; hadley
Author: Hadley Wickham [aut, cre],
RStudio [cph]
Maintainer: Hadley Wickham <hadley@rstudio.com>
Repository: CRAN
Date/Publication: 2019-02-19 05:30:03 UTC
fdaa3fa0eb86bd9e07d6e32b1f5f69b6 *DESCRIPTION
b48dd86d14fedfde9f8c9fc9d21f1e8b *NAMESPACE
07751b3bc55c4322091237c26a34fb75 *NEWS.md
fca1f10265a03c44972f17f114593bd7 *R/check.R
374f45ec1b86f974a0b3d0e3fdd305a5 *R/dots.R
ed931e7ac11b5ed796c86739a8d13eea *R/safe.R
b407937ffac45b3149bb51f199a5d885 *README.md
b56e1bb77bde5e80d0adac9bbb95cd62 *man/check_dots_unnamed.Rd
87cb0a82bc9cb4c97ca5d24d939cb95f *man/check_dots_used.Rd
95738d2ae11f3b13e875e21ac58f7a62 *man/safe_median.Rd
6a6a3e5960a075e7b1f50331f4d128c1 *src/dots.c
3c6d46acd9443e7755ec9294b8151d53 *src/init.c
d03f7b327e2ac7a03a1a7b095a590e62 *tests/testthat.R
6bbac15f374abe5e57791696ada30cc9 *tests/testthat/test-check.R
9fb33f388a456f8b6fd96d0e34a4209d *tests/testthat/test-dots.R
d317a67986a7d4ccd32f1fe43d581317 *tests/testthat/test-safe.R
# Generated by roxygen2: do not edit by hand
S3method(safe_median,numeric)
export(check_dots_unnamed)
export(check_dots_used)
export(safe_median)
useDynLib(ellipsis, .registration = TRUE)
# ellipsis 0.1.0
* New `check_dots_unnamed()` that checks that all components of `...` are
unnamed (#7).
* Fix a bug that caused `check_dots_used()` to emit many false positives (#8)
# ellipsis 0.0.2
* Fix a `PROTECT`ion error
#' Check that all dots have been used
#'
#' Automatically sets exit handler to run when function terminates, checking
#' that all elements of `...` have been evaluated.
#'
#' @param env Environment in which to look for `...` and to set up handler.
#' @export
#' @examples
#' f <- function(...) {
#' check_dots_used()
#' g(...)
#' }
#'
#' g <- function(x, y, ...) {
#' x + y
#' }
#' f(x = 1, y = 2)
#'
#' f(x = 1, y = 2, z = 3)
#' f(x = 1, y = 2, 3, 4, 5)
check_dots_used <- function(env = parent.frame()) {
exit_handler <- bquote(
on.exit({
.(check_dots)(environment())
}, add = TRUE)
)
eval_bare(exit_handler, env)
invisible()
}
check_dots <- function(env = parent.frame()) {
proms <- dots(env)
used <- vapply(proms, promise_forced, logical(1))
if (all(used)) {
return(invisible())
}
unnused <- names(proms)[!used]
warning(
"Some components of ... were not used: ",
paste0(unnused, collapse = ", "),
call. = FALSE,
immediate. = TRUE
)
}
#' Check that all dots are unnamed
#'
#' Named arguments in ... are often a sign of misspelled argument names.
#'
#' @param env Environment in which to look for ...
#' @export
#' @examples
#' f <- function(..., foofy = 8) {
#' check_dots_unnamed()
#' c(...)
#' }
#'
#' f(1, 2, 3, foofy = 4)
#' f(1, 2, 3, foof = 4)
check_dots_unnamed <- function(env = parent.frame()) {
proms <- dots(env, auto_name = FALSE)
unnamed <- is.na(names(proms))
if (all(unnamed)) {
return(invisible())
}
named <- names(proms)[!unnamed]
warning(
"Some components of ... had unexpected names: ",
paste0(named, collapse = ", "),
call. = FALSE,
immediate. = TRUE
)
}
NULL
#' @useDynLib ellipsis, .registration = TRUE
dots <- function(env = parent.frame(), auto_name = TRUE) {
.Call(ellipsis_dots, env, auto_name)
}
promise_forced <- function(x) {
.Call(ellipsis_promise_forced, x)
}
eval_bare <- function(expr, env) {
.Call(ellipsis_eval_bare, expr, env)
}
#' Safe version of median
#'
#' `safe_median()` works [stats::median()] but warns if some elements of `...`
#' are never used.
#'
#' @param x Numeric vector
#' @param ... Additional arguments passed on to methods.
#' @param na.rm For numeric method, should missing values be removed?
#' @export
#' @examples
#' x <- c(1:10, NA)
#' safe_median(x, na.mr = TRUE)
#' safe_median(x, na.rm = TRUE)
safe_median <- function(x, ...) {
check_dots_used()
UseMethod("safe_median")
}
#' @export
#' @rdname safe_median
safe_median.numeric <- function(x, ..., na.rm = TRUE) {
stats::median(x, na.rm = na.rm)
}
<!-- README.md is generated from README.Rmd. Please edit that file -->
# ellipsis
[![lifecycle](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](https://www.tidyverse.org/lifecycle/#experimental)
[![Travis build
status](https://travis-ci.org/hadley/ellipsis.svg?branch=master)](https://travis-ci.org/hadley/ellipsis)
[![Coverage
status](https://codecov.io/gh/hadley/ellipsis/branch/master/graph/badge.svg)](https://codecov.io/github/hadley/ellipsis?branch=master)
Adding `...` to an S3 generic allows methods to take additional
arguments, but it comes with a big downside: any misspelled or extraneous
arguments will be silently ignored. This package explores an approach to
making `...` safer, by supply a function that a generic can use to warn
if any elements of `...` were not evaluated.
In the long run, this code is likely to live elsewhere (maybe R-core
might be interested in making it part of base R). This repository tracks
the current state of the experiment.
Thanks to [Jenny Bryan](http://github.com/jennybc) for the idea, and
[Lionel Henry](http://github.com/lionel-) for the heart of the
implementation.
## Installation
``` r
devtools::install_github("hadley/ellipsis")
```
## Example
`safe_median()` works like `median()` but warns if any elements of `...`
are never evaluated
``` r
library(ellipsis)
x <- c(1:10, NA)
safe_median(x)
#> [1] 5.5
safe_median(x, TRUE)
#> Warning: Some components of ... were not used: ..1
#> [1] 5.5
safe_median(x, na.rm = TRUE)
#> [1] 5.5
safe_median(x, na.mr = TRUE)
#> Warning: Some components of ... were not used: na.mr
#> [1] 5.5
```
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/check.R
\name{check_dots_unnamed}
\alias{check_dots_unnamed}
\title{Check that all dots are unnamed}
\usage{
check_dots_unnamed(env = parent.frame())
}
\arguments{
\item{env}{Environment in which to look for ...}
}
\description{
Named arguments in ... are often a sign of misspelled argument names.
}
\examples{
f <- function(..., foofy = 8) {
check_dots_unnamed()
c(...)
}
f(1, 2, 3, foofy = 4)
f(1, 2, 3, foof = 4)
}
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/check.R
\name{check_dots_used}
\alias{check_dots_used}
\title{Check that all dots have been used}
\usage{
check_dots_used(env = parent.frame())
}
\arguments{
\item{env}{Environment in which to look for \code{...} and to set up handler.}
}
\description{
Automatically sets exit handler to run when function terminates, checking
that all elements of \code{...} have been evaluated.
}
\examples{
f <- function(...) {
check_dots_used()
g(...)
}
g <- function(x, y, ...) {
x + y
}
f(x = 1, y = 2)
f(x = 1, y = 2, z = 3)
f(x = 1, y = 2, 3, 4, 5)
}
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/safe.R
\name{safe_median}
\alias{safe_median}
\alias{safe_median.numeric}
\title{Safe version of median}
\usage{
safe_median(x, ...)
\method{safe_median}{numeric}(x, ..., na.rm = TRUE)
}
\arguments{
\item{x}{Numeric vector}
\item{...}{Additional arguments passed on to methods.}
\item{na.rm}{For numeric method, should missing values be removed?}
}
\description{
\code{safe_median()} works \code{\link[stats:median]{stats::median()}} but warns if some elements of \code{...}
are never used.
}
\examples{
x <- c(1:10, NA)
safe_median(x, na.mr = TRUE)
safe_median(x, na.rm = TRUE)
}
#define R_NO_REMAP
#define USE_RINTERNALS
#include <R.h>
#include <Rinternals.h>
#include <stdio.h>
SEXP ellipsis_dots(SEXP env, SEXP auto_name_) {
if (TYPEOF(env) != ENVSXP)
Rf_errorcall(R_NilValue, "`env` is a not an environment");
int auto_name = Rf_asLogical(auto_name_);
SEXP dots = PROTECT(Rf_findVarInFrame3(env, R_DotsSymbol, TRUE));
if (dots == R_UnboundValue)
Rf_errorcall(R_NilValue, "No ... found");
// Empty dots
if (dots == R_MissingArg) {
UNPROTECT(1);
return Rf_allocVector(VECSXP, 0);
}
int n = 0;
for(SEXP nxt = dots; nxt != R_NilValue; nxt = CDR(nxt)) {
n++;
}
SEXP out = PROTECT(Rf_allocVector(VECSXP, n));
SEXP names = PROTECT(Rf_allocVector(STRSXP, n));
Rf_setAttrib(out, R_NamesSymbol, names);
for (int i = 0; i < n; ++i) {
SET_VECTOR_ELT(out, i, CAR(dots));
SEXP name = TAG(dots);
if (TYPEOF(name) == SYMSXP) {
SET_STRING_ELT(names, i, PRINTNAME(name));
} else {
if (auto_name) {
char buffer[10];
snprintf(buffer, 10, "..%i", i + 1);
SET_STRING_ELT(names, i, Rf_mkChar(buffer));
} else {
SET_STRING_ELT(names, i, NA_STRING);
}
}
dots = CDR(dots);
}
UNPROTECT(3);
return out;
}
SEXP ellipsis_promise_forced(SEXP x) {
if (TYPEOF(x) != PROMSXP)
return Rf_ScalarLogical(TRUE);
SEXP value = PRVALUE(x);
return Rf_ScalarLogical(value != R_UnboundValue);
}
SEXP ellipsis_eval_bare(SEXP expr, SEXP env) {
return Rf_eval(expr, env);
}
#include <R.h>
#include <Rinternals.h>
#include <stdlib.h> // for NULL
#include <R_ext/Rdynload.h>
/* .Call calls */
extern SEXP ellipsis_promise_forced(SEXP);
extern SEXP ellipsis_dots(SEXP, SEXP);
extern SEXP ellipsis_eval_bare(SEXP, SEXP);
static const R_CallMethodDef CallEntries[] = {
{"ellipsis_dots", (DL_FUNC) &ellipsis_dots, 2},
{"ellipsis_promise_forced", (DL_FUNC) &ellipsis_promise_forced, 1},
{"ellipsis_eval_bare", (DL_FUNC) &ellipsis_eval_bare, 2},
{NULL, NULL, 0}
};
void R_init_ellipsis(DllInfo *dll)
{
R_registerRoutines(dll, NULL, CallEntries, NULL, NULL);
R_useDynamicSymbols(dll, FALSE);
}
library(testthat)
library(ellipsis)
test_check("ellipsis")
context("test-check")
test_that("can warn if dots named", {
f <- function(..., xyz = 1) {
check_dots_unnamed()
}
expect_warning(f(1, 2, 3), NA)
expect_warning(f(1, 2, 3, xyz = 4), NA)
expect_warning(f(1, 2, 3, xy = 4), "unexpected names")
})
context("test-dots")
capture_dots <- function(..., auto_name = TRUE) dots(auto_name = auto_name)
test_that("errors with bad inputs", {
expect_error(dots(), "No ... found")
expect_error(dots(1), "not an environment")
})
test_that("no dots yields empty list", {
expect_equal(capture_dots(), list())
})
test_that("captures names if present", {
expect_named(capture_dots(x = 1, y = 2), c("x", "y"))
})
test_that("constructs names if absent", {
expect_named(capture_dots(1, 2), c("..1", "..2"))
})
test_that("unless auto_name = FALSE", {
expect_named(capture_dots(x = 1, 2, auto_name = FALSE), c("x", NA))
})
context("test-safe")
test_that("warn if unused dots", {
expect_warning(safe_median(1:10), NA)
expect_warning(safe_median(1:10, na.rm = TRUE), NA)
expect_warning(safe_median(1:10, y = 1), "were not used")
})
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment