diff --git a/.Rbuildignore b/.Rbuildignore new file mode 100644 index 0000000..dcafd07 --- /dev/null +++ b/.Rbuildignore @@ -0,0 +1,13 @@ +^testhelper\.Rproj$ +^\.Rproj\.user$ +^LICENSE\.md$ +^README\.Rmd$ +^cran-comments\.md$ +^\.github$ +inst/figs/ +^_pkgdown\.yml$ +^docs$ +^pkgdown$ +.env +inst/slides/ +man-roxygen diff --git a/.github/.gitignore b/.github/.gitignore new file mode 100644 index 0000000..2d19fc7 --- /dev/null +++ b/.github/.gitignore @@ -0,0 +1 @@ +*.html diff --git a/.github/CODE_OF_CONDUCT.md b/.github/CODE_OF_CONDUCT.md new file mode 100644 index 0000000..3ac34c8 --- /dev/null +++ b/.github/CODE_OF_CONDUCT.md @@ -0,0 +1,126 @@ +# Contributor Covenant Code of Conduct + +## Our Pledge + +We as members, contributors, and leaders pledge to make participation in our +community a harassment-free experience for everyone, regardless of age, body +size, visible or invisible disability, ethnicity, sex characteristics, gender +identity and expression, level of experience, education, socio-economic status, +nationality, personal appearance, race, caste, color, religion, or sexual +identity and orientation. + +We pledge to act and interact in ways that contribute to an open, welcoming, +diverse, inclusive, and healthy community. + +## Our Standards + +Examples of behavior that contributes to a positive environment for our +community include: + +* Demonstrating empathy and kindness toward other people +* Being respectful of differing opinions, viewpoints, and experiences +* Giving and gracefully accepting constructive feedback +* Accepting responsibility and apologizing to those affected by our mistakes, + and learning from the experience +* Focusing on what is best not just for us as individuals, but for the overall + community + +Examples of unacceptable behavior include: + +* The use of sexualized language or imagery, and sexual attention or advances of + any kind +* Trolling, insulting or derogatory comments, and personal or political attacks +* Public or private harassment +* Publishing others' private information, such as a physical or email address, + without their explicit permission +* Other conduct which could reasonably be considered inappropriate in a + professional setting + +## Enforcement Responsibilities + +Community leaders are responsible for clarifying and enforcing our standards of +acceptable behavior and will take appropriate and fair corrective action in +response to any behavior that they deem inappropriate, threatening, offensive, +or harmful. + +Community leaders have the right and responsibility to remove, edit, or reject +comments, commits, code, wiki edits, issues, and other contributions that are +not aligned to this Code of Conduct, and will communicate reasons for moderation +decisions when appropriate. + +## Scope + +This Code of Conduct applies within all community spaces, and also applies when +an individual is officially representing the community in public spaces. +Examples of representing our community include using an official e-mail address, +posting via an official social media account, or acting as an appointed +representative at an online or offline event. + +## Enforcement + +Instances of abusive, harassing, or otherwise unacceptable behavior may be +reported to the community leaders responsible for enforcement at codeofconduct@posit.co. +All complaints will be reviewed and investigated promptly and fairly. + +All community leaders are obligated to respect the privacy and security of the +reporter of any incident. + +## Enforcement Guidelines + +Community leaders will follow these Community Impact Guidelines in determining +the consequences for any action they deem in violation of this Code of Conduct: + +### 1. Correction + +**Community Impact**: Use of inappropriate language or other behavior deemed +unprofessional or unwelcome in the community. + +**Consequence**: A private, written warning from community leaders, providing +clarity around the nature of the violation and an explanation of why the +behavior was inappropriate. A public apology may be requested. + +### 2. Warning + +**Community Impact**: A violation through a single incident or series of +actions. + +**Consequence**: A warning with consequences for continued behavior. No +interaction with the people involved, including unsolicited interaction with +those enforcing the Code of Conduct, for a specified period of time. This +includes avoiding interactions in community spaces as well as external channels +like social media. Violating these terms may lead to a temporary or permanent +ban. + +### 3. Temporary Ban + +**Community Impact**: A serious violation of community standards, including +sustained inappropriate behavior. + +**Consequence**: A temporary ban from any sort of interaction or public +communication with the community for a specified period of time. No public or +private interaction with the people involved, including unsolicited interaction +with those enforcing the Code of Conduct, is allowed during this period. +Violating these terms may lead to a permanent ban. + +### 4. Permanent Ban + +**Community Impact**: Demonstrating a pattern of violation of community +standards, including sustained inappropriate behavior, harassment of an +individual, or aggression toward or disparagement of classes of individuals. + +**Consequence**: A permanent ban from any sort of public interaction within the +community. + +## Attribution + +This Code of Conduct is adapted from the [Contributor Covenant][homepage], +version 2.1, available at +. + +Community Impact Guidelines were inspired by +[Mozilla's code of conduct enforcement ladder][https://github.com/mozilla/inclusion]. + +For answers to common questions about this code of conduct, see the FAQ at +. Translations are available at . + +[homepage]: https://www.contributor-covenant.org diff --git a/.github/CONTRIBUTING.md b/.github/CONTRIBUTING.md new file mode 100644 index 0000000..94500a4 --- /dev/null +++ b/.github/CONTRIBUTING.md @@ -0,0 +1,47 @@ +# Contributing to testhelper + +This outlines how to propose a change to testhelper. +For a detailed discussion on contributing to this and other tidyverse packages, please see the [development contributing guide](https://rstd.io/tidy-contrib) and our [code review principles](https://code-review.tidyverse.org/). + +## Fixing typos + +You can fix typos, spelling mistakes, or grammatical errors in the documentation directly using the GitHub web interface, as long as the changes are made in the _source_ file. +This generally means you'll need to edit [roxygen2 comments](https://roxygen2.r-lib.org/articles/roxygen2.html) in an `.R`, not a `.Rd` file. +You can find the `.R` file that generates the `.Rd` by reading the comment in the first line. + +## Bigger changes + +If you want to make a bigger change, it's a good idea to first file an issue and make sure someone from the team agrees that it’s needed. +If you’ve found a bug, please file an issue that illustrates the bug with a minimal +[reprex](https://www.tidyverse.org/help/#reprex) (this will also help you write a unit test, if needed). +See our guide on [how to create a great issue](https://code-review.tidyverse.org/issues/) for more advice. + +### Pull request process + +* Fork the package and clone onto your computer. If you haven't done this before, we recommend using `usethis::create_from_github("simonpcouch/testhelper", fork = TRUE)`. + +* Install all development dependencies with `devtools::install_dev_deps()`, and then make sure the package passes R CMD check by running `devtools::check()`. + If R CMD check doesn't pass cleanly, it's a good idea to ask for help before continuing. +* Create a Git branch for your pull request (PR). We recommend using `usethis::pr_init("brief-description-of-change")`. + +* Make your changes, commit to git, and then create a PR by running `usethis::pr_push()`, and following the prompts in your browser. + The title of your PR should briefly describe the change. + The body of your PR should contain `Fixes #issue-number`. + +* For user-facing changes, add a bullet to the top of `NEWS.md` (i.e. just below the first header). Follow the style described in . + +### Code style + +* New code should follow the tidyverse [style guide](https://style.tidyverse.org). + You can use the [styler](https://CRAN.R-project.org/package=styler) package to apply these styles, but please don't restyle code that has nothing to do with your PR. + +* We use [roxygen2](https://cran.r-project.org/package=roxygen2), with [Markdown syntax](https://cran.r-project.org/web/packages/roxygen2/vignettes/rd-formatting.html), for documentation. + +* We use [testthat](https://cran.r-project.org/package=testthat) for unit tests. + Contributions with test cases included are easier to accept. + +## Code of Conduct + +Please note that the testhelper project is released with a +[Contributor Code of Conduct](CODE_OF_CONDUCT.md). By contributing to this +project you agree to abide by its terms. diff --git a/.github/ISSUE_TEMPLATE/issue_template.md b/.github/ISSUE_TEMPLATE/issue_template.md new file mode 100644 index 0000000..d7c9eba --- /dev/null +++ b/.github/ISSUE_TEMPLATE/issue_template.md @@ -0,0 +1,16 @@ +--- +name: Bug report or feature request +about: Describe a bug you've seen or make a case for a new feature +--- + +Please briefly describe your problem and what output you expect. If you have a question, please don't use this form. Instead, ask on or . + +Please include a minimal reproducible example (AKA a reprex). If you've never heard of a [reprex](http://reprex.tidyverse.org/) before, start by reading . + +For more advice on how to write a great issue, see . + +Brief description of the problem + +```r +# insert reprex here +``` diff --git a/.github/SUPPORT.md b/.github/SUPPORT.md new file mode 100644 index 0000000..f5dcc68 --- /dev/null +++ b/.github/SUPPORT.md @@ -0,0 +1,35 @@ +# Getting help with testhelper + +Thanks for using testhelper! +Before filing an issue, there are a few places to explore and pieces to put together to make the process as smooth as possible. + +## Make a reprex + +Start by making a minimal **repr**oducible **ex**ample using the [reprex](https://reprex.tidyverse.org/) package. +If you haven't heard of or used reprex before, you're in for a treat! +Seriously, reprex will make all of your R-question-asking endeavors easier (which is a pretty incredible ROI for the five to ten minutes it'll take you to learn what it's all about). +For additional reprex pointers, check out the [Get help!](https://www.tidyverse.org/help/) section of the tidyverse site. + +## Where to ask? + +Armed with your reprex, the next step is to figure out [where to ask](https://www.tidyverse.org/help/#where-to-ask). + +* If it's a question: start with [community.rstudio.com](https://community.rstudio.com/), and/or StackOverflow. There are more people there to answer questions. + +* If it's a bug: you're in the right place, [file an issue](https://github.com/simonpcouch/testhelper/issues/new). + +* If you're not sure: let the community help you figure it out! + If your problem _is_ a bug or a feature request, you can easily return here and report it. + +Before opening a new issue, be sure to [search issues and pull requests](https://github.com/simonpcouch/testhelper/issues) to make sure the bug hasn't been reported and/or already fixed in the development version. +By default, the search will be pre-populated with `is:issue is:open`. +You can [edit the qualifiers](https://help.github.com/articles/searching-issues-and-pull-requests/) (e.g. `is:pr`, `is:closed`) as needed. +For example, you'd simply remove `is:open` to search _all_ issues in the repo, open or closed. + +## What happens next? + +To be as efficient as possible, development of tidyverse packages tends to be very bursty, so you shouldn't worry if you don't get an immediate response. +Typically we don't look at a repo until a sufficient quantity of issues accumulates, then there’s a burst of intense activity as we focus our efforts. +That makes development more efficient because it avoids expensive context switching between problems, at the cost of taking longer to get back to you. +This process makes a good reprex particularly important because it might be multiple months between your initial report and when we start working on it. +If we can’t reproduce the bug, we can’t fix it! diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml new file mode 100644 index 0000000..4bbce75 --- /dev/null +++ b/.github/workflows/pkgdown.yaml @@ -0,0 +1,50 @@ +# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples +# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help +on: + push: + branches: [main, master] + pull_request: + branches: [main, master] + release: + types: [published] + workflow_dispatch: + +name: pkgdown.yaml + +permissions: read-all + +jobs: + pkgdown: + runs-on: ubuntu-latest + # Only restrict concurrency for non-PR jobs + concurrency: + group: pkgdown-${{ github.event_name != 'pull_request' || github.run_id }} + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + permissions: + contents: write + steps: + - uses: actions/checkout@v4 + + - uses: r-lib/actions/setup-pandoc@v2 + + - uses: r-lib/actions/setup-r@v2 + with: + use-public-rspm: true + + - uses: r-lib/actions/setup-r-dependencies@v2 + with: + extra-packages: any::pkgdown, local::. + needs: website + + - name: Build site + run: pkgdown::build_site_github_pages(new_process = FALSE, install = FALSE) + shell: Rscript {0} + + - name: Deploy to GitHub pages 🚀 + if: github.event_name != 'pull_request' + uses: JamesIves/github-pages-deploy-action@v4.5.0 + with: + clean: false + branch: gh-pages + folder: docs diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..e29b5d9 --- /dev/null +++ b/.gitignore @@ -0,0 +1,10 @@ +.Rproj.user +.Rhistory +.Rdata +.httr-oauth +.DS_Store +.quarto +.env +docs +inst/slides/ +inst/doc diff --git a/DESCRIPTION b/DESCRIPTION new file mode 100644 index 0000000..44aa3db --- /dev/null +++ b/DESCRIPTION @@ -0,0 +1,31 @@ +Package: testhelper +Title: LLM-assisted unit testing +Version: 0.0.1 +Authors@R: + person("Simon", "Couch", , "simon.couch@posit.co", role = c("aut", "cre"), + comment = c(ORCID = "0000-0001-5676-5107")) +Description: Supplies an addin that writes 'testthat' unit tests for selected R + code. +License: MIT + file LICENSE +Config/testthat/edition: 3 +Encoding: UTF-8 +Roxygen: list(markdown = TRUE) +RoxygenNote: 7.3.2 +URL: https://github.com/simonpcouch/testhelper, https://simonpcouch.github.io/testhelper/ +BugReports: https://github.com/simonpcouch/testhelper/issues +Imports: + cli, + coro, + elmer, + rlang, + rstudioapi, + usethis +Suggests: + gt, + knitr, + rmarkdown, + testthat (>= 3.0.0), + tibble, + withr +Remotes: + hadley/elmer diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..327bff0 --- /dev/null +++ b/LICENSE @@ -0,0 +1,2 @@ +YEAR: 2024 +COPYRIGHT HOLDER: testhelper authors diff --git a/LICENSE.md b/LICENSE.md new file mode 100644 index 0000000..acbdb17 --- /dev/null +++ b/LICENSE.md @@ -0,0 +1,21 @@ +# MIT License + +Copyright (c) 2024 testhelper authors + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/NAMESPACE b/NAMESPACE new file mode 100644 index 0000000..496bdc8 --- /dev/null +++ b/NAMESPACE @@ -0,0 +1,10 @@ +# Generated by roxygen2: do not edit by hand + +export(test_helper) +export(test_this) +import(rlang) +importFrom(cli,cli_abort) +importFrom(cli,cli_inform) +importFrom(cli,cli_warn) +importFrom(cli,qty) +importFrom(elmer,content_image_url) diff --git a/R/import-standalone-obj-type.R b/R/import-standalone-obj-type.R new file mode 100644 index 0000000..47268d6 --- /dev/null +++ b/R/import-standalone-obj-type.R @@ -0,0 +1,364 @@ +# Standalone file: do not edit by hand +# Source: https://github.com/r-lib/rlang/blob/HEAD/R/standalone-obj-type.R +# Generated by: usethis::use_standalone("r-lib/rlang", "obj-type") +# ---------------------------------------------------------------------- +# +# --- +# repo: r-lib/rlang +# file: standalone-obj-type.R +# last-updated: 2024-02-14 +# license: https://unlicense.org +# imports: rlang (>= 1.1.0) +# --- +# +# ## Changelog +# +# 2024-02-14: +# - `obj_type_friendly()` now works for S7 objects. +# +# 2023-05-01: +# - `obj_type_friendly()` now only displays the first class of S3 objects. +# +# 2023-03-30: +# - `stop_input_type()` now handles `I()` input literally in `arg`. +# +# 2022-10-04: +# - `obj_type_friendly(value = TRUE)` now shows numeric scalars +# literally. +# - `stop_friendly_type()` now takes `show_value`, passed to +# `obj_type_friendly()` as the `value` argument. +# +# 2022-10-03: +# - Added `allow_na` and `allow_null` arguments. +# - `NULL` is now backticked. +# - Better friendly type for infinities and `NaN`. +# +# 2022-09-16: +# - Unprefixed usage of rlang functions with `rlang::` to +# avoid onLoad issues when called from rlang (#1482). +# +# 2022-08-11: +# - Prefixed usage of rlang functions with `rlang::`. +# +# 2022-06-22: +# - `friendly_type_of()` is now `obj_type_friendly()`. +# - Added `obj_type_oo()`. +# +# 2021-12-20: +# - Added support for scalar values and empty vectors. +# - Added `stop_input_type()` +# +# 2021-06-30: +# - Added support for missing arguments. +# +# 2021-04-19: +# - Added support for matrices and arrays (#141). +# - Added documentation. +# - Added changelog. +# +# nocov start + +#' Return English-friendly type +#' @param x Any R object. +#' @param value Whether to describe the value of `x`. Special values +#' like `NA` or `""` are always described. +#' @param length Whether to mention the length of vectors and lists. +#' @return A string describing the type. Starts with an indefinite +#' article, e.g. "an integer vector". +#' @noRd +obj_type_friendly <- function(x, value = TRUE) { + if (is_missing(x)) { + return("absent") + } + + if (is.object(x)) { + if (inherits(x, "quosure")) { + type <- "quosure" + } else { + type <- class(x)[[1L]] + } + return(sprintf("a <%s> object", type)) + } + + if (!is_vector(x)) { + return(.rlang_as_friendly_type(typeof(x))) + } + + n_dim <- length(dim(x)) + + if (!n_dim) { + if (!is_list(x) && length(x) == 1) { + if (is_na(x)) { + return(switch( + typeof(x), + logical = "`NA`", + integer = "an integer `NA`", + double = + if (is.nan(x)) { + "`NaN`" + } else { + "a numeric `NA`" + }, + complex = "a complex `NA`", + character = "a character `NA`", + .rlang_stop_unexpected_typeof(x) + )) + } + + show_infinites <- function(x) { + if (x > 0) { + "`Inf`" + } else { + "`-Inf`" + } + } + str_encode <- function(x, width = 30, ...) { + if (nchar(x) > width) { + x <- substr(x, 1, width - 3) + x <- paste0(x, "...") + } + encodeString(x, ...) + } + + if (value) { + if (is.numeric(x) && is.infinite(x)) { + return(show_infinites(x)) + } + + if (is.numeric(x) || is.complex(x)) { + number <- as.character(round(x, 2)) + what <- if (is.complex(x)) "the complex number" else "the number" + return(paste(what, number)) + } + + return(switch( + typeof(x), + logical = if (x) "`TRUE`" else "`FALSE`", + character = { + what <- if (nzchar(x)) "the string" else "the empty string" + paste(what, str_encode(x, quote = "\"")) + }, + raw = paste("the raw value", as.character(x)), + .rlang_stop_unexpected_typeof(x) + )) + } + + return(switch( + typeof(x), + logical = "a logical value", + integer = "an integer", + double = if (is.infinite(x)) show_infinites(x) else "a number", + complex = "a complex number", + character = if (nzchar(x)) "a string" else "\"\"", + raw = "a raw value", + .rlang_stop_unexpected_typeof(x) + )) + } + + if (length(x) == 0) { + return(switch( + typeof(x), + logical = "an empty logical vector", + integer = "an empty integer vector", + double = "an empty numeric vector", + complex = "an empty complex vector", + character = "an empty character vector", + raw = "an empty raw vector", + list = "an empty list", + .rlang_stop_unexpected_typeof(x) + )) + } + } + + vec_type_friendly(x) +} + +vec_type_friendly <- function(x, length = FALSE) { + if (!is_vector(x)) { + abort("`x` must be a vector.") + } + type <- typeof(x) + n_dim <- length(dim(x)) + + add_length <- function(type) { + if (length && !n_dim) { + paste0(type, sprintf(" of length %s", length(x))) + } else { + type + } + } + + if (type == "list") { + if (n_dim < 2) { + return(add_length("a list")) + } else if (is.data.frame(x)) { + return("a data frame") + } else if (n_dim == 2) { + return("a list matrix") + } else { + return("a list array") + } + } + + type <- switch( + type, + logical = "a logical %s", + integer = "an integer %s", + numeric = , + double = "a double %s", + complex = "a complex %s", + character = "a character %s", + raw = "a raw %s", + type = paste0("a ", type, " %s") + ) + + if (n_dim < 2) { + kind <- "vector" + } else if (n_dim == 2) { + kind <- "matrix" + } else { + kind <- "array" + } + out <- sprintf(type, kind) + + if (n_dim >= 2) { + out + } else { + add_length(out) + } +} + +.rlang_as_friendly_type <- function(type) { + switch( + type, + + list = "a list", + + NULL = "`NULL`", + environment = "an environment", + externalptr = "a pointer", + weakref = "a weak reference", + S4 = "an S4 object", + + name = , + symbol = "a symbol", + language = "a call", + pairlist = "a pairlist node", + expression = "an expression vector", + + char = "an internal string", + promise = "an internal promise", + ... = "an internal dots object", + any = "an internal `any` object", + bytecode = "an internal bytecode object", + + primitive = , + builtin = , + special = "a primitive function", + closure = "a function", + + type + ) +} + +.rlang_stop_unexpected_typeof <- function(x, call = caller_env()) { + abort( + sprintf("Unexpected type <%s>.", typeof(x)), + call = call + ) +} + +#' Return OO type +#' @param x Any R object. +#' @return One of `"bare"` (for non-OO objects), `"S3"`, `"S4"`, +#' `"R6"`, or `"S7"`. +#' @noRd +obj_type_oo <- function(x) { + if (!is.object(x)) { + return("bare") + } + + class <- inherits(x, c("R6", "S7_object"), which = TRUE) + + if (class[[1]]) { + "R6" + } else if (class[[2]]) { + "S7" + } else if (isS4(x)) { + "S4" + } else { + "S3" + } +} + +#' @param x The object type which does not conform to `what`. Its +#' `obj_type_friendly()` is taken and mentioned in the error message. +#' @param what The friendly expected type as a string. Can be a +#' character vector of expected types, in which case the error +#' message mentions all of them in an "or" enumeration. +#' @param show_value Passed to `value` argument of `obj_type_friendly()`. +#' @param ... Arguments passed to [abort()]. +#' @inheritParams args_error_context +#' @noRd +stop_input_type <- function(x, + what, + ..., + allow_na = FALSE, + allow_null = FALSE, + show_value = TRUE, + arg = caller_arg(x), + call = caller_env()) { + # From standalone-cli.R + cli <- env_get_list( + nms = c("format_arg", "format_code"), + last = topenv(), + default = function(x) sprintf("`%s`", x), + inherit = TRUE + ) + + if (allow_na) { + what <- c(what, cli$format_code("NA")) + } + if (allow_null) { + what <- c(what, cli$format_code("NULL")) + } + if (length(what)) { + what <- oxford_comma(what) + } + if (inherits(arg, "AsIs")) { + format_arg <- identity + } else { + format_arg <- cli$format_arg + } + + message <- sprintf( + "%s must be %s, not %s.", + format_arg(arg), + what, + obj_type_friendly(x, value = show_value) + ) + + abort(message, ..., call = call, arg = arg) +} + +oxford_comma <- function(chr, sep = ", ", final = "or") { + n <- length(chr) + + if (n < 2) { + return(chr) + } + + head <- chr[seq_len(n - 1)] + last <- chr[n] + + head <- paste(head, collapse = sep) + + # Write a or b. But a, b, or c. + if (n > 2) { + paste0(head, sep, final, " ", last) + } else { + paste0(head, " ", final, " ", last) + } +} + +# nocov end diff --git a/R/import-standalone-types-check.R b/R/import-standalone-types-check.R new file mode 100644 index 0000000..ef8c5a1 --- /dev/null +++ b/R/import-standalone-types-check.R @@ -0,0 +1,554 @@ +# Standalone file: do not edit by hand +# Source: https://github.com/r-lib/rlang/blob/HEAD/R/standalone-types-check.R +# Generated by: usethis::use_standalone("r-lib/rlang", "types-check") +# ---------------------------------------------------------------------- +# +# --- +# repo: r-lib/rlang +# file: standalone-types-check.R +# last-updated: 2023-03-13 +# license: https://unlicense.org +# dependencies: standalone-obj-type.R +# imports: rlang (>= 1.1.0) +# --- +# +# ## Changelog +# +# 2024-08-15: +# - `check_character()` gains an `allow_na` argument (@martaalcalde, #1724) +# +# 2023-03-13: +# - Improved error messages of number checkers (@teunbrand) +# - Added `allow_infinite` argument to `check_number_whole()` (@mgirlich). +# - Added `check_data_frame()` (@mgirlich). +# +# 2023-03-07: +# - Added dependency on rlang (>= 1.1.0). +# +# 2023-02-15: +# - Added `check_logical()`. +# +# - `check_bool()`, `check_number_whole()`, and +# `check_number_decimal()` are now implemented in C. +# +# - For efficiency, `check_number_whole()` and +# `check_number_decimal()` now take a `NULL` default for `min` and +# `max`. This makes it possible to bypass unnecessary type-checking +# and comparisons in the default case of no bounds checks. +# +# 2022-10-07: +# - `check_number_whole()` and `_decimal()` no longer treat +# non-numeric types such as factors or dates as numbers. Numeric +# types are detected with `is.numeric()`. +# +# 2022-10-04: +# - Added `check_name()` that forbids the empty string. +# `check_string()` allows the empty string by default. +# +# 2022-09-28: +# - Removed `what` arguments. +# - Added `allow_na` and `allow_null` arguments. +# - Added `allow_decimal` and `allow_infinite` arguments. +# - Improved errors with absent arguments. +# +# +# 2022-09-16: +# - Unprefixed usage of rlang functions with `rlang::` to +# avoid onLoad issues when called from rlang (#1482). +# +# 2022-08-11: +# - Added changelog. +# +# nocov start + +# Scalars ----------------------------------------------------------------- + +.standalone_types_check_dot_call <- .Call + +check_bool <- function(x, + ..., + allow_na = FALSE, + allow_null = FALSE, + arg = caller_arg(x), + call = caller_env()) { + if (!missing(x) && .standalone_types_check_dot_call(ffi_standalone_is_bool_1.0.7, x, allow_na, allow_null)) { + return(invisible(NULL)) + } + + stop_input_type( + x, + c("`TRUE`", "`FALSE`"), + ..., + allow_na = allow_na, + allow_null = allow_null, + arg = arg, + call = call + ) +} + +check_string <- function(x, + ..., + allow_empty = TRUE, + allow_na = FALSE, + allow_null = FALSE, + arg = caller_arg(x), + call = caller_env()) { + if (!missing(x)) { + is_string <- .rlang_check_is_string( + x, + allow_empty = allow_empty, + allow_na = allow_na, + allow_null = allow_null + ) + if (is_string) { + return(invisible(NULL)) + } + } + + stop_input_type( + x, + "a single string", + ..., + allow_na = allow_na, + allow_null = allow_null, + arg = arg, + call = call + ) +} + +.rlang_check_is_string <- function(x, + allow_empty, + allow_na, + allow_null) { + if (is_string(x)) { + if (allow_empty || !is_string(x, "")) { + return(TRUE) + } + } + + if (allow_null && is_null(x)) { + return(TRUE) + } + + if (allow_na && (identical(x, NA) || identical(x, na_chr))) { + return(TRUE) + } + + FALSE +} + +check_name <- function(x, + ..., + allow_null = FALSE, + arg = caller_arg(x), + call = caller_env()) { + if (!missing(x)) { + is_string <- .rlang_check_is_string( + x, + allow_empty = FALSE, + allow_na = FALSE, + allow_null = allow_null + ) + if (is_string) { + return(invisible(NULL)) + } + } + + stop_input_type( + x, + "a valid name", + ..., + allow_na = FALSE, + allow_null = allow_null, + arg = arg, + call = call + ) +} + +IS_NUMBER_true <- 0 +IS_NUMBER_false <- 1 +IS_NUMBER_oob <- 2 + +check_number_decimal <- function(x, + ..., + min = NULL, + max = NULL, + allow_infinite = TRUE, + allow_na = FALSE, + allow_null = FALSE, + arg = caller_arg(x), + call = caller_env()) { + if (missing(x)) { + exit_code <- IS_NUMBER_false + } else if (0 == (exit_code <- .standalone_types_check_dot_call( + ffi_standalone_check_number_1.0.7, + x, + allow_decimal = TRUE, + min, + max, + allow_infinite, + allow_na, + allow_null + ))) { + return(invisible(NULL)) + } + + .stop_not_number( + x, + ..., + exit_code = exit_code, + allow_decimal = TRUE, + min = min, + max = max, + allow_na = allow_na, + allow_null = allow_null, + arg = arg, + call = call + ) +} + +check_number_whole <- function(x, + ..., + min = NULL, + max = NULL, + allow_infinite = FALSE, + allow_na = FALSE, + allow_null = FALSE, + arg = caller_arg(x), + call = caller_env()) { + if (missing(x)) { + exit_code <- IS_NUMBER_false + } else if (0 == (exit_code <- .standalone_types_check_dot_call( + ffi_standalone_check_number_1.0.7, + x, + allow_decimal = FALSE, + min, + max, + allow_infinite, + allow_na, + allow_null + ))) { + return(invisible(NULL)) + } + + .stop_not_number( + x, + ..., + exit_code = exit_code, + allow_decimal = FALSE, + min = min, + max = max, + allow_na = allow_na, + allow_null = allow_null, + arg = arg, + call = call + ) +} + +.stop_not_number <- function(x, + ..., + exit_code, + allow_decimal, + min, + max, + allow_na, + allow_null, + arg, + call) { + if (allow_decimal) { + what <- "a number" + } else { + what <- "a whole number" + } + + if (exit_code == IS_NUMBER_oob) { + min <- min %||% -Inf + max <- max %||% Inf + + if (min > -Inf && max < Inf) { + what <- sprintf("%s between %s and %s", what, min, max) + } else if (x < min) { + what <- sprintf("%s larger than or equal to %s", what, min) + } else if (x > max) { + what <- sprintf("%s smaller than or equal to %s", what, max) + } else { + abort("Unexpected state in OOB check", .internal = TRUE) + } + } + + stop_input_type( + x, + what, + ..., + allow_na = allow_na, + allow_null = allow_null, + arg = arg, + call = call + ) +} + +check_symbol <- function(x, + ..., + allow_null = FALSE, + arg = caller_arg(x), + call = caller_env()) { + if (!missing(x)) { + if (is_symbol(x)) { + return(invisible(NULL)) + } + if (allow_null && is_null(x)) { + return(invisible(NULL)) + } + } + + stop_input_type( + x, + "a symbol", + ..., + allow_na = FALSE, + allow_null = allow_null, + arg = arg, + call = call + ) +} + +check_arg <- function(x, + ..., + allow_null = FALSE, + arg = caller_arg(x), + call = caller_env()) { + if (!missing(x)) { + if (is_symbol(x)) { + return(invisible(NULL)) + } + if (allow_null && is_null(x)) { + return(invisible(NULL)) + } + } + + stop_input_type( + x, + "an argument name", + ..., + allow_na = FALSE, + allow_null = allow_null, + arg = arg, + call = call + ) +} + +check_call <- function(x, + ..., + allow_null = FALSE, + arg = caller_arg(x), + call = caller_env()) { + if (!missing(x)) { + if (is_call(x)) { + return(invisible(NULL)) + } + if (allow_null && is_null(x)) { + return(invisible(NULL)) + } + } + + stop_input_type( + x, + "a defused call", + ..., + allow_na = FALSE, + allow_null = allow_null, + arg = arg, + call = call + ) +} + +check_environment <- function(x, + ..., + allow_null = FALSE, + arg = caller_arg(x), + call = caller_env()) { + if (!missing(x)) { + if (is_environment(x)) { + return(invisible(NULL)) + } + if (allow_null && is_null(x)) { + return(invisible(NULL)) + } + } + + stop_input_type( + x, + "an environment", + ..., + allow_na = FALSE, + allow_null = allow_null, + arg = arg, + call = call + ) +} + +check_function <- function(x, + ..., + allow_null = FALSE, + arg = caller_arg(x), + call = caller_env()) { + if (!missing(x)) { + if (is_function(x)) { + return(invisible(NULL)) + } + if (allow_null && is_null(x)) { + return(invisible(NULL)) + } + } + + stop_input_type( + x, + "a function", + ..., + allow_na = FALSE, + allow_null = allow_null, + arg = arg, + call = call + ) +} + +check_closure <- function(x, + ..., + allow_null = FALSE, + arg = caller_arg(x), + call = caller_env()) { + if (!missing(x)) { + if (is_closure(x)) { + return(invisible(NULL)) + } + if (allow_null && is_null(x)) { + return(invisible(NULL)) + } + } + + stop_input_type( + x, + "an R function", + ..., + allow_na = FALSE, + allow_null = allow_null, + arg = arg, + call = call + ) +} + +check_formula <- function(x, + ..., + allow_null = FALSE, + arg = caller_arg(x), + call = caller_env()) { + if (!missing(x)) { + if (is_formula(x)) { + return(invisible(NULL)) + } + if (allow_null && is_null(x)) { + return(invisible(NULL)) + } + } + + stop_input_type( + x, + "a formula", + ..., + allow_na = FALSE, + allow_null = allow_null, + arg = arg, + call = call + ) +} + + +# Vectors ----------------------------------------------------------------- + +# TODO: Figure out what to do with logical `NA` and `allow_na = TRUE` + +check_character <- function(x, + ..., + allow_na = TRUE, + allow_null = FALSE, + arg = caller_arg(x), + call = caller_env()) { + + if (!missing(x)) { + if (is_character(x)) { + if (!allow_na && any(is.na(x))) { + abort( + sprintf("`%s` can't contain NA values.", arg), + arg = arg, + call = call + ) + } + + return(invisible(NULL)) + } + + if (allow_null && is_null(x)) { + return(invisible(NULL)) + } + } + + stop_input_type( + x, + "a character vector", + ..., + allow_null = allow_null, + arg = arg, + call = call + ) +} + +check_logical <- function(x, + ..., + allow_null = FALSE, + arg = caller_arg(x), + call = caller_env()) { + if (!missing(x)) { + if (is_logical(x)) { + return(invisible(NULL)) + } + if (allow_null && is_null(x)) { + return(invisible(NULL)) + } + } + + stop_input_type( + x, + "a logical vector", + ..., + allow_na = FALSE, + allow_null = allow_null, + arg = arg, + call = call + ) +} + +check_data_frame <- function(x, + ..., + allow_null = FALSE, + arg = caller_arg(x), + call = caller_env()) { + if (!missing(x)) { + if (is.data.frame(x)) { + return(invisible(NULL)) + } + if (allow_null && is_null(x)) { + return(invisible(NULL)) + } + } + + stop_input_type( + x, + "a data frame", + ..., + allow_null = allow_null, + arg = arg, + call = call + ) +} + +# nocov end diff --git a/R/test_helper.R b/R/test_helper.R new file mode 100644 index 0000000..77583e2 --- /dev/null +++ b/R/test_helper.R @@ -0,0 +1,69 @@ +#' Initialize a test helper object +#' +#' @description +#' Test helpers are elmer [Chat()][elmer::Chat()]s that know how to write testthat +#' unit tests. This function creates test helpers, though [test_this()] will create +#' test helpers it needs on-the-fly. +#' +#' @param fn A `new_*()` function, likely from the elmer package. Defaults +#' to [elmer::chat_claude()]. To set a persistent alternative default, +#' set the `.testhelper_fn` option; see examples below. +#' @param .ns The package that the `new_*()` function is exported from. +#' @param ... Additional arguments to `fn`. The `system_prompt` argument will +#' be ignored if supplied. To set persistent defaults, +#' set the `.testhelper_args` option; see examples below. +#' +#' @details +#' If you have an Anthropic API key (or another API key and the `test_helper_*()` +#' options) set and this package installed, you are ready to using the addin +#' in any R session with no setup or library loading required; the addin knows +#' to look for your API credentials and will call needed functions by itself. +#' +#' @examplesIf FALSE +#' # to create a chat with claude: +#' test_helper() +#' +#' # or with OpenAI's 4o-mini: +#' test_helper( +#' "chat_openai", +#' model = "gpt-4o-mini" +#' ) +#' +#' # to set OpenAI's 4o-mini as the default, for example, set the +#' # following options (possibly in your .Rprofile, if you'd like +#' # them to persist across sessions): +#' options( +#' .testhelper_fn = "chat_openai", +#' .testhelper_args = list(model = "gpt-4o-mini") +#' ) +#' @export +test_helper <- function( + fn = getOption(".testhelper_fn", default = "chat_claude"), + ..., + .ns = "elmer" + ) { + args <- list(...) + default_args <- getOption(".testhelper_args", default = list()) + args <- modifyList(default_args, args) + + # TODO: just read this once + args$system_prompt <- test_helper_prompt() + + test_helper <- rlang::eval_bare(rlang::call2(fn, !!!args, .ns = .ns)) + + .stash_last_test_helper(test_helper) + + test_helper +} + +test_helper_prompt <- function() { + prompt <- readLines(system.file("system_prompt.md", package = "testhelper")) + + paste0(prompt, collapse = "\n") +} + +.stash_last_test_helper <- function(x) { + testhelper_env <- testhelper_env() + testhelper_env[["last_test_helper"]] <- x + invisible(NULL) +} diff --git a/R/test_this.R b/R/test_this.R new file mode 100644 index 0000000..ac69730 --- /dev/null +++ b/R/test_this.R @@ -0,0 +1,117 @@ +#' Write unit tests for selected code +#' +#' @description +#' This function queries an LLM to write unit tests for selected R code. To do +#' so, it: +#' +#' * Initializes a [test_helper()]: an elmer [Chat()][elmer::Chat()] that knows how +#' to write testthat unit tests. +#' * Reads the contents of the active `.R` file as well as the current selection. +#' * Opens a corresponding test file (creating it if need be). +#' * Asks the LLM to write unit tests for the current selection, using the +#' contents of the active `.R` file as context. +#' * Streams the response into the corresponding test file. +#' +#' @returns +#' `TRUE`, invisibly. +#' +#' @export +test_this <- function() { + context <- rstudioapi::getActiveDocumentContext() + test_helper <- retrieve_test_helper() + + # TODO: ensure that the file is a .R file in an `R/` directory + turn <- assemble_turn(context) + + test_file <- open_test(context$path) + + tryCatch( + stream_inline( + test_helper = test_helper$clone(), + turn = turn + ), + error = function(e) { + rstudioapi::showDialog( + "Error", + paste("The test_helper ran into an issue: ", e$message) + ) + } + ) + + invisible(TRUE) +} + +assemble_turn <- function(context) { + # TODO: handle case where there's nothing there, in which case test + # the whole document + paste0( + c( + "## Context", + "", + context$contents, + "", + "Now, here's the selection you'll write tests for.", + "", + "## Selection", + "", + rstudioapi::primary_selection(context)$text + ), + collapse = "\n" + ) +} + +# TODO: more variables can be replaced with constants here, and logic +# probably simplified further +stream_inline <- function(test_helper, turn) { + context <- rstudioapi::getSourceEditorContext() + selection <- context$selection + selection$range <- initial_range(context) + + output_lines <- character(0) + stream <- test_helper$stream(turn) + coro::loop(for (chunk in stream) { + if (identical(chunk, "")) {next} + output_lines <- paste(output_lines, sub("\n$", "", chunk), sep = "") + n_lines <- nchar(gsub("[^\n]+", "", output_lines)) + 1 + if (n_lines < 1) { + output_padded <- + paste0( + output_lines, + paste0(rep("\n", 2 - n_lines), collapse = "") + ) + } else { + output_padded <- paste(output_lines, "\n") + } + + rstudioapi::modifyRange( + selection$range, + output_padded %||% output_lines, + selection$id + ) + + n_selection <- selection$range$end[[1]] - selection$range$start[[1]] + n_lines_res <- nchar(gsub("[^\n]+", "", output_padded %||% output_lines)) + if (n_selection < n_lines_res) { + selection$range$end[["row"]] <- selection$range$start[["row"]] + n_lines_res + } + }) + + rstudioapi::setCursorPosition(selection$range$start) +} + +initial_range <- function(context) { + n_lines <- length(context$contents) + last_line_start <- rstudioapi::document_position(n_lines, 1) + last_line_end <- rstudioapi::document_position(n_lines, 100000) + + rstudioapi::modifyRange( + rstudioapi::document_range(last_line_start, last_line_end), + paste0(context$contents[n_lines], "\n"), + id = context$id + ) + + # TODO: set selection to the "right" place in the test file + # if it exists--perhaps as an LLM tool call? + new_loc <- rstudioapi::document_position(n_lines + 1, 1) + rstudioapi::document_range(new_loc, new_loc) +} diff --git a/R/testhelper-package.R b/R/testhelper-package.R new file mode 100644 index 0000000..d5d2c38 --- /dev/null +++ b/R/testhelper-package.R @@ -0,0 +1,11 @@ +#' @keywords internal +"_PACKAGE" + +## usethis namespace: start +#' @import rlang +#' @importFrom cli cli_abort cli_warn cli_inform qty +#' @importFrom elmer content_image_url +## usethis namespace: end +NULL + +globalVariables(c("file.edit", "modifyList")) diff --git a/R/utils.R b/R/utils.R new file mode 100644 index 0000000..18a4c67 --- /dev/null +++ b/R/utils.R @@ -0,0 +1,23 @@ +.testhelper_env <- new_environment() + +testhelper_env <- function() { + .testhelper_env +} + +retrieve_test_helper <- function() { + testhelper_env <- testhelper_env() + + if (env_has(testhelper_env, "last_test_helper")) { + return(env_get(testhelper_env, "last_test_helper")) + } + + test_helper() +} + +open_test <- function(path) { + name <- basename(path) + res <- file.path("tests", "testthat", paste0("test-", name)) + usethis::edit_file(res) + + res +} diff --git a/README.Rmd b/README.Rmd new file mode 100644 index 0000000..8749a51 --- /dev/null +++ b/README.Rmd @@ -0,0 +1,42 @@ +--- +output: github_document +--- + + + +```{r, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>", + fig.path = "man/figures/README-", + out.width = "100%" +) +``` + +# testhelper + + +[![Lifecycle: experimental](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](https://lifecycle.r-lib.org/articles/stages.html#experimental) +[![CRAN status](https://www.r-pkg.org/badges/version/testhelper)](https://CRAN.R-project.org/package=testhelper) +[![R-CMD-check](https://github.com/simonpcouch/testhelper/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/simonpcouch/testhelper/actions/workflows/R-CMD-check.yaml) + + +The testhelper package provides an addin for drafting testthat unit testing code using LLMs. Triggering the addin will open a corresponding test file and begin writing tests into it. The testhelper _test helper_ is familiar with testthat 3e as well as tidy style, and incorporates context from the rest of your R package to write concise and relevant tests. + +## Installation + +You can install testhelper like so: + +``` r +pak::pak("simonpcouch/testhelper") +``` + +Then, ensure that you have an [`ANTHROPIC_API_KEY`](https://console.anthropic.com/) environment variable set, and you're ready to go. If you'd like to use an LLM other than Anthropic's Claude 3.5 Sonnet—like OpenAI's ChatGPT—to power the testhelper helper, see the `test_helper()` documentation. + +The test helper is interfaced with the via the RStudio addin "testhelper: Test R code." For easiest access, we recommend registering the testhelper addin to a keyboard shortcut. **In RStudio**, navigate to `Tools > Modify Keyboard Shortcuts > Search "testhelper"`—we suggest `Ctrl+Alt+T` (or `Ctrl+Cmd+T` on macOS). The testhelper helper is currently not available in Positron as Positron has yet to implement document `id`s that testhelper needs to toggle between source and test files. + +Once those steps are completed, you're ready to use the testhelper addin with a keyboard shortcut. + +## Example + +To use the test helper, just trigger the addin (optionally selecting some code to only write tests for a certain portion of the file) and watch your testing code be written. diff --git a/README.md b/README.md new file mode 100644 index 0000000..c7a29e0 --- /dev/null +++ b/README.md @@ -0,0 +1,52 @@ + + + +# testhelper + + + +[![Lifecycle: +experimental](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](https://lifecycle.r-lib.org/articles/stages.html#experimental) +[![CRAN +status](https://www.r-pkg.org/badges/version/testhelper)](https://CRAN.R-project.org/package=testhelper) +[![R-CMD-check](https://github.com/simonpcouch/testhelper/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/simonpcouch/testhelper/actions/workflows/R-CMD-check.yaml) + + +The testhelper package provides an addin for drafting testthat unit +testing code using LLMs. Triggering the addin will open a corresponding +test file and begin writing tests into it. The testhelper *test helper* is +familiar with testthat 3e as well as tidy style, and incorporates +context from the rest of your R package to write concise and relevant +tests. + +## Installation + +You can install testhelper like so: + +``` r +pak::pak("simonpcouch/testhelper") +``` + +Then, ensure that you have an +[`ANTHROPIC_API_KEY`](https://console.anthropic.com/) environment +variable set, and you’re ready to go. If you’d like to use an LLM other +than Anthropic’s Claude 3.5 Sonnet—like OpenAI’s ChatGPT—to power the +testhelper helper, see the `test_helper()` documentation. + +The test helper is interfaced with the via the RStudio addin “testhelper: +Test R code.” For easiest access, we recommend registering the testhelper +addin to a keyboard shortcut. **In RStudio**, navigate to +`Tools > Modify Keyboard Shortcuts > Search "testhelper"`—we suggest +`Ctrl+Alt+T` (or `Ctrl+Cmd+T` on macOS). The testhelper helper is +currently not available in Positron as Positron has yet to implement +document `id`s that testhelper needs to toggle between source and test +files. + +Once those steps are completed, you’re ready to use the testhelper addin +with a keyboard shortcut. + +## Example + +The test helper is created automatically when users interact with the +testhelper addin. Just highlight some code, trigger the addin, and watch +your testing code be written. diff --git a/cran-comments.md b/cran-comments.md new file mode 100644 index 0000000..858617d --- /dev/null +++ b/cran-comments.md @@ -0,0 +1,5 @@ +## R CMD check results + +0 errors | 0 warnings | 1 note + +* This is a new release. diff --git a/inst/rstudio/addins.dcf b/inst/rstudio/addins.dcf new file mode 100644 index 0000000..6e0078e --- /dev/null +++ b/inst/rstudio/addins.dcf @@ -0,0 +1,4 @@ +Name: testhelper: Test R code +Description: Draft testthat unit tests +Binding: test_this +Interactive: false diff --git a/inst/system_prompt.md b/inst/system_prompt.md new file mode 100644 index 0000000..0ce8711 --- /dev/null +++ b/inst/system_prompt.md @@ -0,0 +1,214 @@ +You are a skilled engineer who is writing minimal, concise testthat 3e unit tests for R package code. Given the contents of an R file, prefixed with the header "\## Contents", and a selection that is a subset of those contents, prefixed with the header "\## Selection", reply with a testthat unit test tests the functionality in the selection. Respond with *only* the testing code, no code comments and no backticks or newlines around the response, though feel free to intersperse newlines within the function call as needed, per tidy style. + +Here's some more information on how to write testthat unit tests: + +- A test file holds one or more `test_that()` tests. +- Each test describes what it's testing: e.g. "multiplication works". +- Each test has one or more expectations: e.g. `expect_equal(2 * 2, 4)`. + +Below we go into much more detail about how to test your own functions. + +For example, here are the contents of `tests/testthat/test-dup.r` from stringr: + +```{r} +test_that("basic duplication works", { + expect_equal(str_dup("a", 3), "aaa") + expect_equal(str_dup("abc", 2), "abcabc") + expect_equal(str_dup(c("a", "b"), 2), c("aa", "bb")) + expect_equal(str_dup(c("a", "b"), c(2, 3)), c("aa", "bbb")) +}) + +test_that("0 duplicates equals empty string", { + expect_equal(str_dup("a", 0), "") + expect_equal(str_dup(c("a", "b"), 0), rep("", 2)) +}) + +test_that("uses tidyverse recycling rules", { + expect_error(str_dup(1:2, 1:3), class = "vctrs_error_incompatible_size") +}) +``` + +This file shows a typical mix of tests: + +- "basic duplication works" tests typical usage of `str_dup()`. +- "0 duplicates equals empty string" probes a specific edge case. +- "uses tidyverse recycling rules" checks that malformed input results in a specific kind of error. + +Tests are organised hierarchically: **expectations** are grouped into **tests** which are organised in **files**: + +- A **test** groups together multiple expectations to test the output from a simple function, a range of possibilities for a single parameter from a more complicated function, or tightly related functionality from across multiple functions. This is why they are sometimes called **unit** tests. Each test should cover a single unit of functionality. A test is created with `test_that(desc, code)`. + + It's common to write the description (`desc`) to create something that reads naturally, e.g. `test_that("basic duplication works", { ... })`. A test failure report includes this description, which is why you want a concise statement of the test's purpose, e.g. a specific behaviour. + +- An **expectation** is the atom of testing. It describes the expected result of a computation: Does it have the right value and right class? Does it produce an error when it should? An expectation automates visual checking of results in the console. Expectations are functions that start with `expect_`. + +You want to arrange things such that, when a test fails, you'll know what's wrong and where in your code to look for the problem. This motivates all our recommendations regarding file organisation, file naming, and the test description. Finally, try to avoid putting too many expectations in one test - it's better to have more smaller tests than fewer larger tests. + +## Expectations + +An expectation is the finest level of testing. It makes a binary assertion about whether or not an object has the properties you expect. This object is usually the return value from a function in your package. + +All expectations have a similar structure: + +- They start with `expect_`. + +- They have two main arguments: the first is the actual result, the second is what you expect. + +- If the actual and expected results don't agree, testthat throws an error. + +- Some expectations have additional arguments that control the finer points of comparing an actual and expected result. + +### Testing for equality + +`expect_equal()` checks for equality, with some reasonable amount of numeric tolerance: + +```{r, error = TRUE} +expect_equal(10, 10) +expect_equal(10, 10L) +expect_equal(10, 10 + 1e-7) +expect_equal(10, 11) +``` + +If you want to test for exact equivalence, use `expect_identical()`. + +```{r, error = TRUE} +expect_equal(10, 10 + 1e-7) +expect_identical(10, 10 + 1e-7) + +expect_equal(2, 2L) +expect_identical(2, 2L) +``` + +### Testing errors + +Use `expect_error()` to check whether an expression throws an error. It's the most important expectation in a trio that also includes `expect_warning()` and `expect_message()`. We're going to emphasize errors here, but most of this also applies to warnings and messages. + +Usually you care about two things when testing an error: + +- Does the code fail? Specifically, does it fail for the right reason? +- Does the accompanying message make sense to the human who needs to deal with the error? + +The entry-level solution is to expect a specific type of condition: + +```{r, warning = TRUE, error = TRUE} +1 / "a" +expect_error(1 / "a") + +log(-1) +expect_warning(log(-1)) +``` + +This is a bit dangerous, though, especially when testing an error. There are lots of ways for code to fail! Consider the following test: + +```{r} +expect_error(str_duq(1:2, 1:3)) +``` + +This expectation is intended to test the recycling behaviour of `str_dup()`. But, due to a typo, it tests behaviour of a non-existent function, `str_duq()`. The code throws an error and, therefore, the test above passes, but for the *wrong reason*. Due to the typo, the actual error thrown is about not being able to find the `str_duq()` function: + +```{r, error = TRUE} +str_duq(1:2, 1:3) +``` + +Recent developments in both base R and rlang make it increasingly likely that conditions are signaled with a *class*, which provides a better basis for creating precise expectations. That is exactly what you've already seen in this stringr example. This is what the `class` argument is for: + +```{r, error = TRUE} +# fails, error has wrong class +expect_error(str_duq(1:2, 1:3), class = "vctrs_error_incompatible_size") + +# passes, error has expected class +expect_error(str_dup(1:2, 1:3), class = "vctrs_error_incompatible_size") +``` + +If you have the choice, express your expectation in terms of the condition's class, instead of its message. Often this is under your control, i.e. if your package signals the condition. If the condition originates from base R or another package, proceed with caution. This is often a good reminder to re-consider the wisdom of testing a condition that is not fully under your control in the first place. + +To check for the *absence* of an error, warning, or message, use `expect_no_error()`: + +```{r} +expect_no_error(1 / 2) +``` + +Of course, this is functionally equivalent to simply executing `1 / 2` inside a test, but some developers find the explicit expectation expressive. + +If you genuinely care about the condition's message, testthat 3e's snapshot tests are the best approach, which we describe next. + +### Snapshot tests {#sec-snapshot-tests} + +Sometimes it's difficult or awkward to describe an expected result with code. Snapshot tests are a great solution to this problem and this is one of the main innovations in testthat 3e. Snapshot tests are particularly suited to monitoring your package's user interface, such as its informational messages and errors. Other use cases include testing images or other complicated objects. + +Here's how testing `waldo::compare()` would look as a snapshot test: + +```{r eval = FALSE} +test_that("side-by-side diffs work", { + withr::local_options(width = 20) + expect_snapshot( + waldo::compare(c("X", letters), c(letters, "X")) + ) +}) +``` + +`expect_snapshot()` has a few arguments worth knowing about: + +- `error = FALSE`: By default, snapshot code is *not* allowed to throw an error. See `expect_error()`, described above, for one approach to testing errors. But sometimes you want to assess "Does this error message make sense to a human?" and having it laid out in context in a snapshot is a great way to see it with fresh eyes. Specify `error = TRUE` in this case: + + ```{r eval = FALSE} + expect_snapshot(error = TRUE, + str_dup(1:2, 1:3) + ) + ``` + +- `transform`: Sometimes a snapshot contains volatile, insignificant elements, such as a temporary filepath or a timestamp. The `transform` argument accepts a function, presumably written by you, to remove or replace such changeable text. Another use of `transform` is to scrub sensitive information from the snapshot. + +- `variant`: Sometimes snapshots reflect the ambient conditions, such as the operating system or the version of R or one of your dependencies, and you need a different snapshot for each variant. This is an experimental and somewhat advanced feature, so if you can arrange things to use a single snapshot, you probably should. + +In typical usage, testthat will take care of managing the snapshot files below `tests/testthat/_snaps/`. This happens in the normal course of you running your tests and, perhaps, calling `testthat::snapshot_accept()`. + +### Common expections + +`expect_lt()` `expect_lte()` `expect_gt()` `expect_gte()` + +: Does code return a number greater/less than the expected value? + +`expect_named()` + +: Does code return a vector with (given) names? + +`expect_setequal()` `expect_mapequal()` `expect_contains()` `expect_in()` + +: Does code return a vector containing the expected values? + +`expect_true()` `expect_false()` + +: Does code return `TRUE` or `FALSE`? + +Several expectations can be described as "shortcuts", i.e. they streamline a pattern that comes up often enough to deserve its own wrapper. + +- `expect_match(object, regexp, ...)` is a shortcut that wraps `grepl(pattern = regexp, x = object, ...)`. It matches a character vector input against a regular expression `regexp`. The optional `all` argument controls whether all elements or just one element needs to match. Read the `expect_match()` documentation to see how additional arguments, like `ignore.case = FALSE` or `fixed = TRUE`, can be passed down to `grepl()`. + + ```{r, error = TRUE} + string <- "Testing is fun!" + + expect_match(string, "Testing") + + # Fails, match is case-sensitive + expect_match(string, "testing") + + # Passes because additional arguments are passed to grepl(): + expect_match(string, "testing", ignore.case = TRUE) + ``` + +- `expect_length(object, n)` is a shortcut for `expect_equal(length(object), n)`. + +- `expect_setequal(x, y)` tests that every element of `x` occurs in `y`, and that every element of `y` occurs in `x`. But it won't fail if `x` and `y` happen to have their elements in a different order. + +- `expect_s3_class()` and `expect_s4_class()` check that an object `inherit()`s from a specified class. `expect_type()`checks the `typeof()` an object. + + ```{r, error = TRUE} + model <- lm(mpg ~ wt, data = mtcars) + expect_s3_class(model, "lm") + expect_s3_class(model, "glm") + ``` + +When you need to mock functions, only use `local_mocked_bindings()` from testthat. Don't use mockery or mockr. + +The `.R` file context will follow. diff --git a/man/test_helper.Rd b/man/test_helper.Rd new file mode 100644 index 0000000..a1bf0bb --- /dev/null +++ b/man/test_helper.Rd @@ -0,0 +1,54 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/test_helper.R +\name{test_helper} +\alias{test_helper} +\title{Initialize a test helper object} +\usage{ +test_helper( + fn = getOption(".testhelper_fn", default = "chat_claude"), + ..., + .ns = "elmer" +) +} +\arguments{ +\item{fn}{A \verb{new_*()} function, likely from the elmer package. Defaults +to \code{\link[elmer:chat_claude]{elmer::chat_claude()}}. To set a persistent alternative default, +set the \code{.testhelper_fn} option; see examples below.} + +\item{...}{Additional arguments to \code{fn}. The \code{system_prompt} argument will +be ignored if supplied. To set persistent defaults, +set the \code{.testhelper_args} option; see examples below.} + +\item{.ns}{The package that the \verb{new_*()} function is exported from.} +} +\description{ +Test helpers are elmer \link[elmer:Chat]{Chat()}s that know how to write testthat +unit tests. This function creates test helpers, though \code{\link[=test_this]{test_this()}} will create +test helpers it needs on-the-fly. +} +\details{ +If you have an Anthropic API key (or another API key and the \verb{test_helper_*()} +options) set and this package installed, you are ready to using the addin +in any R session with no setup or library loading required; the addin knows +to look for your API credentials and will call needed functions by itself. +} +\examples{ +\dontshow{if (FALSE) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +# to create a chat with claude: +test_helper() + +# or with OpenAI's 4o-mini: +test_helper( + "chat_openai", + model = "gpt-4o-mini" +) + +# to set OpenAI's 4o-mini as the default, for example, set the +# following options (possibly in your .Rprofile, if you'd like +# them to persist across sessions): +options( + .testhelper_fn = "chat_openai", + .testhelper_args = list(model = "gpt-4o-mini") +) +\dontshow{\}) # examplesIf} +} diff --git a/man/test_this.Rd b/man/test_this.Rd new file mode 100644 index 0000000..e798885 --- /dev/null +++ b/man/test_this.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/test_this.R +\name{test_this} +\alias{test_this} +\title{Write unit tests for selected code} +\usage{ +test_this() +} +\value{ +\code{TRUE}, invisibly. +} +\description{ +This function queries an LLM to write unit tests for selected R code. To do +so, it: +\itemize{ +\item Initializes a \code{\link[=test_helper]{test_helper()}}: an elmer \link[elmer:Chat]{Chat()} that knows how +to write testthat unit tests. +\item Reads the contents of the active \code{.R} file as well as the current selection. +\item Opens a corresponding test file (creating it if need be). +\item Asks the LLM to write unit tests for the current selection, using the +contents of the active \code{.R} file as context. +\item Streams the response into the corresponding test file. +} +} diff --git a/man/testhelper-package.Rd b/man/testhelper-package.Rd new file mode 100644 index 0000000..2d8c519 --- /dev/null +++ b/man/testhelper-package.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/testhelper-package.R +\docType{package} +\name{testhelper-package} +\alias{testhelper} +\alias{testhelper-package} +\title{testhelper: LLM-assisted unit testing} +\description{ +Supplies an addin that writes 'testthat' unit tests for selected R code. +} +\seealso{ +Useful links: +\itemize{ + \item \url{https://github.com/simonpcouch/testhelper} + \item \url{https://simonpcouch.github.io/testhelper/} + \item Report bugs at \url{https://github.com/simonpcouch/testhelper/issues} +} + +} +\author{ +\strong{Maintainer}: Simon Couch \email{simon.couch@posit.co} (\href{https://orcid.org/0000-0001-5676-5107}{ORCID}) + +} +\keyword{internal} diff --git a/testhelper.Rproj b/testhelper.Rproj new file mode 100644 index 0000000..69fafd4 --- /dev/null +++ b/testhelper.Rproj @@ -0,0 +1,22 @@ +Version: 1.0 + +RestoreWorkspace: No +SaveWorkspace: No +AlwaysSaveHistory: Default + +EnableCodeIndexing: Yes +UseSpacesForTab: Yes +NumSpacesForTab: 2 +Encoding: UTF-8 + +RnwWeave: Sweave +LaTeX: pdfLaTeX + +AutoAppendNewline: Yes +StripTrailingWhitespace: Yes +LineEndingConversion: Posix + +BuildType: Package +PackageUseDevtools: Yes +PackageInstallArgs: --no-multiarch --with-keep.source +PackageRoxygenize: rd,collate,namespace diff --git a/tests/testthat.R b/tests/testthat.R new file mode 100644 index 0000000..e52165d --- /dev/null +++ b/tests/testthat.R @@ -0,0 +1,12 @@ +# This file is part of the standard setup for testthat. +# It is recommended that you do not modify it. +# +# Where should you do additional test configuration? +# Learn more about the roles of various files in: +# * https://r-pkgs.org/testing-design.html#sec-tests-files-overview +# * https://testthat.r-lib.org/articles/special-files.html + +library(testthat) +library(testhelper) + +test_check("testhelper") diff --git a/tests/testthat/test-test_helper.R b/tests/testthat/test-test_helper.R new file mode 100644 index 0000000..6456567 --- /dev/null +++ b/tests/testthat/test-test_helper.R @@ -0,0 +1,29 @@ +test_that("test_helper initializes correctly with defaults", { + withr::local_options(list(.testhelper_fn = NULL, .testhelper_args = NULL)) + + expect_no_error( + result <- test_helper() + ) + expect_s3_class(result, "Chat") + + expect_equal(result$system_prompt, test_helper_prompt()) +}) + +test_that("test_helper respects custom options", { + withr::local_options( + list( + .testhelper_fn = "chat_openai", + .testhelper_args = list(model = "gpt-4o-mini") + ) + ) + + result <- test_helper() + expect_s3_class(result, "Chat") + expect_equal(result$.__enclos_env__$private$provider@model, "gpt-4o-mini") +}) + +test_that("test_helper_prompt returns expected prompt", { + res <- test_helper_prompt() + expect_equal(length(res), 1) + expect_type(res, "character") +}) diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R new file mode 100644 index 0000000..5b1e6fd --- /dev/null +++ b/tests/testthat/test-utils.R @@ -0,0 +1,22 @@ +test_that("testhelper_env works", { + expect_identical(testhelper_env(), .testhelper_env) + expect_type(testhelper_env(), "environment") +}) + +test_that("retrieve_test_helper uses existing helper when available", { + if (env_has(.testhelper_env, "last_test_helper")) { + old_helper <- env_get(.testhelper_env, "last_test_helper") + withr::defer(env_bind(.testhelper_env, last_test_helper = old_helper)) + } + env_bind(.testhelper_env, last_test_helper = "boop") + expect_equal(retrieve_test_helper(), "boop") +}) + +test_that("retrieve_test_helper creates a new helper when needed", { + local_mocked_bindings( + testhelper_env = function() new_environment() + ) + + expect_equal(retrieve_test_helper(), test_helper()) + expect_true("last_test_helper" %in% names(.testhelper_env)) +})