diff --git a/NEWS.md b/NEWS.md new file mode 100644 index 0000000..15ddccb --- /dev/null +++ b/NEWS.md @@ -0,0 +1,14 @@ +# mutr 0.0.2 + +* added `TEST_NOT_ERROR` to check that the expression doesn't throw error +* fixed incorrect assignment of `call` within `TEST` and `TEST_ERROR` +* enhanced self-testing `TEST__PASS` and `TEST__FAIL` to preserve the expression +* `TEST__PASS` and `TEST__FAIL` now can accept optional arguments +* added more self-tests. +* added versioning and `NEWS.md` +* removed old files (some functionality now in the [mpd](https://github.com/J-Moravec/mpd/) package +* a simple makefile for self-testing and to copy `mutr.r` into examples + +# mutr 0.0.1 + +* initial version diff --git a/examples/helpers/mutr.r b/examples/helpers/mutr.r index 7fa8ec7..16b4838 100644 --- a/examples/helpers/mutr.r +++ b/examples/helpers/mutr.r @@ -1,6 +1,7 @@ # mutr: minimal unit-testing framework -# -# a simplified copy-pastable version inspired by https://jera.com/techinfo/jtns/jtn002 +# inspired by https://jera.com/techinfo/jtns/jtn002 +# version: 0.0.2 +# https://github.com/J-Moravec/mutr TEST_INIT = function(){ env = new.env(parent = emptyenv()) @@ -31,7 +32,7 @@ TEST_PRINT = function(){ TEST = function(expr, msg = "is not TRUE!", call = NULL){ - call = if(is.null(call)) deparse(substitute(expr)) |> paste0(collapse = "") + if(is.null(call)) call = deparse(substitute(expr)) |> paste0(collapse = "") res = try(expr, silent = TRUE) env = get(".TESTS", envir = globalenv()) @@ -81,8 +82,15 @@ not = function(x){ } -TEST_ERROR = function(expr, msg = "does not signal required error!", pattern = "", call = NULL){ - call = if(is.null(call)) deparse(substitute(expr)) |> paste0(collapse = "") +TEST_ERROR = function(expr, msg = "does not signal specified error!", pattern = "", call = NULL){ + if(is.null(call)) call = deparse(substitute(expr)) |> paste0(collapse = "") e = tryCatch(expr, error = \(e) e) (is.error(e) && grepl(pattern, conditionMessage(e))) |> TEST(call = call, msg = msg) } + + +TEST_NOT_ERROR = function(expr, msg = "does signal an error!", call = NULL){ + if(is.null(call)) call = deparse(substitute(expr)) |> paste0(collapse = "") + e = tryCatch(expr, error = \(e) e) + is.error(e) |> not() |> TEST(call = call, msg = msg) + } diff --git a/examples/helpers/test-mutr.r b/examples/helpers/test-mutr.r index fdeff41..ca3824d 100644 --- a/examples/helpers/test-mutr.r +++ b/examples/helpers/test-mutr.r @@ -1,21 +1,24 @@ -# Test for unit-tests -# -# This will test a simplified version of mutr used for self-testing +# test-mutr.r: tests for the unit-testing framework mutr -# helpers TEST__CHECK = function(fail, total, sets){ env = get(".TESTS", envir = globalenv()) stopifnot(env$FAIL == fail, env$TOTAL == total, env$SETS == sets) } -TEST__FAIL = function(expr){ - msg = capture.output(TEST(expr)) - stopifnot(" Error in expr: is not TRUE!" == msg) +TEST__FAIL = function(expr, .msg = NULL, f = TEST, ...){ + .expr = substitute(expr) + out = capture.output(eval(as.call(list(f, .expr, ...)))) + if(is.null(.msg)) .msg = paste0(" Error in ", deparse(substitute(expr)), ": is not TRUE!") + if(!identical(out, .msg)) + stop("Output message differs from expected!\n", + " Output: ", out, "\n", + " Expected: ", .msg) } -TEST__PASS = function(expr){ - msg = capture.output(TEST(expr)) - stopifnot(msg == character(0)) +TEST__PASS = function(expr, f = TEST, ...){ + .expr = substitute(expr) + out = capture.output(eval(as.call(list(f, .expr, ...)))) + stopifnot(identical(out, character())) } TEST__RESET = function(){ @@ -27,15 +30,32 @@ TEST__CHECK(0, 0, 0) TEST__PASS(TRUE) TEST__CHECK(0, 1, 0) TEST__FAIL(FALSE) -TEST__CHECK(1, 2, 0) +TEST__FAIL(FALSE, " Error in FALSE: is not TRUE!") +TEST__FAIL(c(1:3), " Error in c(1:3): is not TRUE!") +TEST__CHECK(3, 4, 0) + TEST_SET("", { TEST__PASS(TRUE) TEST__FAIL(FALSE) TEST__FAIL(NA) TEST__FAIL(1) }) -TEST__CHECK(4, 6, 1) +TEST__CHECK(6, 8, 1) + +TEST__PASS(stop("foo"), f = TEST_ERROR) +TEST__PASS(stop("foo"), f = TEST_ERROR, pattern = "foo") +TEST__CHECK(6, 10, 1) +TEST__FAIL(stop("foo"), f = TEST_ERROR, pattern = "bar", + .msg = " Error in stop(\"foo\"): does not signal specified error!") +TEST__FAIL("foo", f = TEST_ERROR, + .msg = " Error in \"foo\": does not signal specified error!") +TEST__CHECK(8, 12, 1) +TEST__PASS("foo", f = TEST_NOT_ERROR) +TEST__PASS(1, f = TEST_NOT_ERROR) +TEST__FAIL(stop("foo"), f = TEST_NOT_ERROR, + .msg = " Error in stop(\"foo\"): does signal an error!") +TEST__CHECK(9, 15, 1) # Cleanup TEST__RESET() diff --git a/makefile b/makefile new file mode 100644 index 0000000..7cd83e4 --- /dev/null +++ b/makefile @@ -0,0 +1,11 @@ +.RECIPEPREFIX = + + +all: test copy + +test: ++ Rscript -e 'source("mutr.r"); source("test-mutr.r")' + +copy: test ++ cp mutr.r test-mutr.r examples/helpers/ + +.PHONY: all test copy diff --git a/mutr.r b/mutr.r index 7fa8ec7..16b4838 100644 --- a/mutr.r +++ b/mutr.r @@ -1,6 +1,7 @@ # mutr: minimal unit-testing framework -# -# a simplified copy-pastable version inspired by https://jera.com/techinfo/jtns/jtn002 +# inspired by https://jera.com/techinfo/jtns/jtn002 +# version: 0.0.2 +# https://github.com/J-Moravec/mutr TEST_INIT = function(){ env = new.env(parent = emptyenv()) @@ -31,7 +32,7 @@ TEST_PRINT = function(){ TEST = function(expr, msg = "is not TRUE!", call = NULL){ - call = if(is.null(call)) deparse(substitute(expr)) |> paste0(collapse = "") + if(is.null(call)) call = deparse(substitute(expr)) |> paste0(collapse = "") res = try(expr, silent = TRUE) env = get(".TESTS", envir = globalenv()) @@ -81,8 +82,15 @@ not = function(x){ } -TEST_ERROR = function(expr, msg = "does not signal required error!", pattern = "", call = NULL){ - call = if(is.null(call)) deparse(substitute(expr)) |> paste0(collapse = "") +TEST_ERROR = function(expr, msg = "does not signal specified error!", pattern = "", call = NULL){ + if(is.null(call)) call = deparse(substitute(expr)) |> paste0(collapse = "") e = tryCatch(expr, error = \(e) e) (is.error(e) && grepl(pattern, conditionMessage(e))) |> TEST(call = call, msg = msg) } + + +TEST_NOT_ERROR = function(expr, msg = "does signal an error!", call = NULL){ + if(is.null(call)) call = deparse(substitute(expr)) |> paste0(collapse = "") + e = tryCatch(expr, error = \(e) e) + is.error(e) |> not() |> TEST(call = call, msg = msg) + } diff --git a/old/DESCRIPTION b/old/DESCRIPTION deleted file mode 100644 index 588e0c0..0000000 --- a/old/DESCRIPTION +++ /dev/null @@ -1,24 +0,0 @@ -Package: mutr -Title: Minimal Unit-Testing Framework -Version: 0.0.1 -Authors@R: - person( - given = "Jiří", - family = "Moravec", - role = c("aut", "cre"), - email = "jiri.c.moravec@gmail.com" - ) -Description: A Minimal Unit-Testing Framework in R, for scripts or packages. - Simply copy the main file into your project and write some tests for a - dependency-free workflow, use the package as a simple lightweight - dependency. -License: MIT + file LICENSE -Encoding: UTF-8 -RoxygenNote: 7.3.1 -URL: https://github.com/j-moravec/mutr -BugReports: https://github.com/j-moravec/mutr/issues -Imports: - tools, - utils -Suggests: - roxygen2 diff --git a/old/LICENSE b/old/LICENSE deleted file mode 100644 index 892263f..0000000 --- a/old/LICENSE +++ /dev/null @@ -1,2 +0,0 @@ -YEAR: 2024 -COPYRIGHT HOLDER: mutr authors diff --git a/old/LICENSE.md b/old/LICENSE.md deleted file mode 100644 index 65eb865..0000000 --- a/old/LICENSE.md +++ /dev/null @@ -1,21 +0,0 @@ -# MIT License - -Copyright (c) 2024 mutr 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/old/NAMESPACE b/old/NAMESPACE deleted file mode 100644 index 74a6d5b..0000000 --- a/old/NAMESPACE +++ /dev/null @@ -1,17 +0,0 @@ -# Generated by roxygen2: do not edit by hand - -export(check) -export(deinit_mutr) -export(document) -export(init_mutr) -export(new_mutr) -export(new_stack) -export(pkg_build) -export(pkg_check) -export(pkg_install) -export(pkg_name) -export(test) -export(test_dir) -export(test_file) -export(test_pkg) -export(test_set) diff --git a/old/R/mutr.r b/old/R/mutr.r deleted file mode 100644 index 0c336f5..0000000 --- a/old/R/mutr.r +++ /dev/null @@ -1,229 +0,0 @@ -# mutr.r -# -# Minimal test framework -# inspired by https://jera.com/techinfo/jtns/jtn002 and https://github.com/siu/minunit - - -#' Create, initialize, and deinitialize mutr object -#' -#' @description -#' Create, initialize, and deinitialize a mutr object. -#' -#' @details -#' This objects stores information required to track tests, test sets, and their error messages. -#' -#' `new_mutr` creates a new object, `init_mutr` saves it and `deinit_mutr` removes it from the -#' user's global environment. Before the removal, `deinit_mutr` also prints test results. -#' -#' The `print` argument specifies when the errors are being printed, -#' whether after each `test`, `test_set`, on exit during de-initialization. -#' These are handled in `test`, `test_set`,`test_file`, and `test_dir`. -#' -#' Methods: -#' -#' * add_test(x) -- append test result 'x' to the memory -#' * add_set() -- increase the set ounter by one -#' -#' Slots: -#' -#' * sets -- the total number of test sets, see `[test_set]` -#' * tests -- the total number of tests -#' * failed -- the number of failed tests -#' * print -- when to print errors, see details -#' -#' @param print when to print errors, see details -#' @return `new_mutr` returns an environment containing callable methods, -#' `init_mutr` and `deinit_mutr` are run for side-effects. -#' -#' @export -new_mutr = function(print = c("test", "set", "exit")){ - sets = 0 - tests = 0 - failed = 0 - print = match.arg(print) - messages = new_stack() - - add_test = function(x){ - tests <<- tests + 1L - - if(!isTRUE(x)){ - failed <<- failed + 1L - } - } - - add_set = function(){ - sets <<- sets + 1L - } - - structure(environment(), "class" = "counter") - } - - -#' @rdname new_mutr -#' @export -init_mutr = function(print){ - mutr = new_mutr(print) - env = globalenv() - env$.mutr = mutr - - invisible() - } - - -#' @rdname new_mutr -#' @export -deinit_mutr = function(print = FALSE){ - env = globalenv()$.mutr - rm(".mutr", envir = globalenv()) - - if(print){ - cat( - "[", - env$sets, "sets,", - env$tests, "tests:", - env$failed, "failed,", - env$tests - env$failed, "passed", - "]\n\n" - ) - - if(env$failed != 0 && env$print == "exit") - cat(unlist(env$messages$pop())) - if(env$failed != 0) - stop("Some tests did not pass.\n", call. = FALSE) - } - - invisible() - } - - -#' Test expression -#' -#' Test provided expression for true-ness, the evaluated expression is returned invisibly. -#' If the `.mutr` object exists, the test counter is increased and the error message is appended. -#' Otherwise, the error message is printed. -#' -#' Any other condition than `TRUE` results in a differe with different diagnostic expression -#' depending on the evaluation. For this purpose, `test` distinguishes between: -#' -#' * error condition -#' * non-logical object -#' * logical object with length > 1 -#' * singular logical FALSE -#' * singular logical TRUE -#' -#' @param expr an expression to be evaluated -#' @return an evaluated expression -#' -#' @export -#' -#' @examples -#' test(TRUE) -#' test(FALSE) -#' test(stop()) -test = function(expr){ - res = try(expr, silent = TRUE) - expr = paste0(deparse(substitute(expr)), collapse = "") - - if(isTRUE(res)){ - msg = paste0("Passed: ", expr, " is TRUE", "\n") - } else if(class(res)[1] == "try-error"){ - msg = paste0("Error in ", expr, - ": ", attr(res, "condition")$message, "\n") - } else if(!is.logical(res)){ - msg = paste0("Error in ", expr, - ": does not evaluate to TRUE/FALSE\n") - } else if(length(res) > 1){ - msg = paste0("Error in ", expr, - ": condition has length > 1\n") - } else if(!res){ - msg = paste0("Error in ", expr, ": is not TRUE\n") - } else { - stop("Unknown condition in ", expr, ": ", res, "\n") - } - - # TODO this could be simplified - if(exists(".mutr", envir = globalenv(), mode = "environment")){ - env = globalenv()$.mutr - env$add_test(res) - - if(env$print == "test"){ - cat(msg) - } else { - if(!isTRUE(res)) env$messages$push(msg) - } - - } else { - cat(msg) - } - - invisible(res) - } - - -#' Test context -#' -#' Run the `test` functions in a context, such as set, file, or a directory. -#' -#' These function establish context for tests so that a structured test-suite can be constructed. -#' Each of the context functions `test_set`, `test_file`, and `test_dir` initialize the `.mutr` -#' object if it doesn't already exists, and create a `on.exit` destructor to print the test -#' result. -#' -#' @param msg a name of the set -#' @param expr an expression containing `test`s, since only the `mutr::test` functions append -#' to the `.mutr` object, any other expressions won't influence the test counter. -#' @param file a file containing `test_set`s and `test`s -#' @param dir a directory containing files starting with `test` -#' @name test_context - -#' @rdname test_context -#' @export -#' -test_set = function(msg, expr){ - if(!exists(".mutr", envir = globalenv(), mode = "environment")){ - init_mutr("set") - on.exit(deinit_mutr(print = TRUE), add = TRUE) - } - env = globalenv()$.mutr - env$add_set() - - before = env$failed - res = try(expr, silent = TRUE) - set_failed = env$failed > before - - cat(" ", msg, ": ", sep = "") - if(class(res)[1] == "try-error" || set_failed) cat("FAIL\n") else cat("PASS\n") - - if(env$print == "set" && set_failed) cat(unlist(env$messages$pop())) - - invisible() - } - - -#' @rdname test_context -#' @export -test_file = function(file){ - if(!exists(".mutr", envir = globalenv(), mode = "environment")){ - init_mutr("exit") - on.exit(deinit_mutr(print = TRUE), add = TRUE) - } - - source(file, chdir = TRUE) - - invisible() - } - - - -#' @rdname test_context -#' @export -test_dir = function(dir){ - if(!exists(".mutr", envir = globalenv(), mode = "environment")){ - init_mutr("exit") - on.exit(deinit_mutr(print = TRUE), add = TRUE) - } - files = dir(dir, "^test[^.]*\\.[rR]$", full.names = TRUE) - lapply(files, test_file) - - invisible() - } diff --git a/old/R/pkg.r b/old/R/pkg.r deleted file mode 100644 index f199885..0000000 --- a/old/R/pkg.r +++ /dev/null @@ -1,128 +0,0 @@ -#' Package development functions -#' -#' These functions provide a dependency-light alternative to `devtools`. -#' -#' `test_pkg()` install and runs tests for specified package, these tests must be created by -#' some unit-testing framework in that they need to be able to be run outside of `R CMD check`. -#' -#' The `check()` maps to the `R CMD check` and `document()` runs the `roxygen2::roxygenize` -#' function to generate documentation. -#' -#' @param pkg a path to the package directory -#' @param as_cran run the `R CMD check` with the CRAN preset (internet connection required) -#' @return nothing, these functions are run for their side-effect -#' -#' @export -test_pkg = function(pkg = "."){ - pkg_name = pkg_name(pkg) - - # set local library - tmp_lib = file.path(tempdir(), "r-lib") - if(!dir.exists(tmp_lib)) dir.create(tmp_lib) - .libPaths(c(tmp_lib, .libPaths())) - - # install pkg - pkg_install(pkg, tmp_lib) - - # remove package from search path if its already there - if(paste0("package:", pkg_name) %in% search()) - detach(paste0("package:", pkg_name), unload = TRUE, force = TRUE, character.only = TRUE) - - test_files = list.files(file.path(pkg, "tests"), full.names = TRUE) - test_files = Filter(function(x) utils::file_test("-f", x), test_files) - - # run the code inside pkg environment - env = new.env(parent = getNamespace(pkg_name)) - for(test_file in test_files){ - rm(list = ls(env, all.names = TRUE), envir = env) - sys.source(test_file, chdir = TRUE, envir = env, toplevel.env = getNamespace(pkg_name)) - } - } - - -#' @rdname test_pkg -#' @export -check = function(pkg = ".", as_cran = FALSE){ - tmp = tempdir() - - pkg_file = pkg_build(pkg) - pkg_check(pkg_file, as_cran = as_cran) - } - - -#' @rdname test_pkg -#' @export -document = function(pkg = "."){ - if(!requireNamespace("roxygen2")) - stop("package roxygen2 required") - - roxygen2::roxygenize(pkg) - } - - -#' Utility package functions -#' -#' These functions map to the `R CMD INSTALL`, `R CMD build` and `R CMD check` commands. -#' -#' The functions `pkg_install`, `pkg_build`, and `pkg_check` map to the respective `R CMD` -#' commands. By default, all output files are created in a temporary directory. -#' The `pkg_name` is an utility functions that reads the `DESCRIPTION` file and returns the -#' package name. -#' -#' @param pkg a path to package source (`pkg_install()`, `pkg_build()`, `pkg_name()`) -#' or tarball (`pkg_install()`, `pkg_check()`) -#' @param path a path where package is installed, build, or checked, defaults to `tempdir()` -#' @param as_cran whether to run `R CMD check` with the `--as-cran` preset -#' @return `pkg_install` and `pkg_check` do not have a return value, -#' `pkg_build` returns a path to the compiled package tarball, -#' `pkg_name` returns a name of the package in specified path -#' -#' @name pkg_cmd - -#' @rdname pkg_cmd -#' @export -pkg_install = function(pkg, path = tempdir()){ - res = tools::Rcmd(c( - "INSTALL", - paste0("--library=", path), - "--no-help", - "--no-staged-install", - pkg - )) - if(res != 0) stop("installation error", call. = FALSE) - } - - -#' @rdname pkg_cmd -#' @export -pkg_build = function(pkg, path = tempdir()){ - res = tools::Rcmd(c("build", "--no-build-vignettes", "--no-manual", pkg)) - if(res != 0) stop("build error", call. = FALSE) - - pkg_file = dir(pkg, pattern = paste0(pkg_name(pkg), ".*\\.tar\\.gz"), full.names = TRUE) - pkg_tmpfile = file.path(path, basename(pkg_file)) - - if(pkg_file != pkg_tmpfile) - file.rename(pkg_file, pkg_tmpfile) - - pkg_tmpfile - } - - -#' @rdname pkg_cmd -#' @export -pkg_check = function(pkg, path = tempdir(), as_cran = FALSE){ - args = if(as_cran) "--as-cran" else c("--no-build-vignettes", "--no-manual") - args = c("-o", path, args) - tools::Rcmd(c("check", args, pkg)) - } - - -#' @rdname pkg_cmd -#' @export -pkg_name = function(pkg){ - descr = file.path(pkg, "DESCRIPTION") - if(!(file.exists(descr) && utils::file_test("-f", descr))) - stop("no description found, is ", pkg, " a path to a package?") - read.dcf(descr, fields = "Package")[1] - } diff --git a/old/R/stack.r b/old/R/stack.r deleted file mode 100644 index 8fb3006..0000000 --- a/old/R/stack.r +++ /dev/null @@ -1,59 +0,0 @@ -#' Create new stack object -#' -#' @description -#' Create a new stack object with reference semantics and two methods, -#' `push` adds objects to the stack and `pop` removes them. -#' -#' @details -#' This is dependency-free class based on function closures with reference semantics. -#' Internally, the stack is represented as a pre-allocated `list` that is extended as required. -#' The size of the `list` is set to the `init`, and is dynamically extended by the `init` value. -#' -#' Following methods are available: -#' -#' * `push(...)` - element or elements to stack, elements are converted to list -#' * `pop(n)` - removes and returns `n` latest elements from stack, if `n` is missing, remove all elements -#' -#' Following slots are available: -#' -#' * items - stack memory, a pre-allocated -#' * size - current size of the stack -#' -#' Modifying these slots could lead to inconsistent behaviour. -#' -#' @param init an initial size of the stack -#' @return an environment containing callable methods, see details -#' -#' @examples -#' s = new_stack() -#' s$push("foo", "bar", "baz") -#' -#' identical(s$pop(1), list("foo")) -#' identical(s$pop(), list("bar", "baz")) -#' identical(s$pop(), list()) -#' -#' @export -new_stack = function(init = 20L){ - items = vector("list", init) - size = 0L - - push = function(...){ - new = list(...) - new_size = length(new) + size - while(new_size > length(items)) - items[[length(items) + init]] = list(NULL) - - items[size + seq_along(new)] <<- new - size <<- new_size - - invisible(NULL) - } - - pop = function(n = NULL){ - if(is.null(n)) n = size - size <<- size - n # no need to clean list - items[size + seq_len(n)] - } - - structure(environment(), "class" = "stack") - } diff --git a/old/man/new_mutr.Rd b/old/man/new_mutr.Rd deleted file mode 100644 index 2b7c87d..0000000 --- a/old/man/new_mutr.Rd +++ /dev/null @@ -1,46 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/mutr.r -\name{new_mutr} -\alias{new_mutr} -\alias{init_mutr} -\alias{deinit_mutr} -\title{Create, initialize, and deinitialize mutr object} -\usage{ -new_mutr(print = c("test", "set", "exit")) - -init_mutr(print) - -deinit_mutr(print = FALSE) -} -\arguments{ -\item{print}{when to print errors, see details} -} -\value{ -`new_mutr` returns an environment containing callable methods, - `init_mutr` and `deinit_mutr` are run for side-effects. -} -\description{ -Create, initialize, and deinitialize a mutr object. -} -\details{ -This objects stores information required to track tests, test sets, and their error messages. - -`new_mutr` creates a new object, `init_mutr` saves it and `deinit_mutr` removes it from the -user's global environment. Before the removal, `deinit_mutr` also prints test results. - -The `print` argument specifies when the errors are being printed, -whether after each `test`, `test_set`, on exit during de-initialization. -These are handled in `test`, `test_set`,`test_file`, and `test_dir`. - -Methods: - -* add_test(x) -- append test result 'x' to the memory -* add_set() -- increase the set ounter by one - -Slots: - -* sets -- the total number of test sets, see `[test_set]` -* tests -- the total number of tests -* failed -- the number of failed tests -* print -- when to print errors, see details -} diff --git a/old/man/new_stack.Rd b/old/man/new_stack.Rd deleted file mode 100644 index 54f36f9..0000000 --- a/old/man/new_stack.Rd +++ /dev/null @@ -1,44 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/stack.r -\name{new_stack} -\alias{new_stack} -\title{Create new stack object} -\usage{ -new_stack(init = 20L) -} -\arguments{ -\item{init}{an initial size of the stack} -} -\value{ -an environment containing callable methods, see details -} -\description{ -Create a new stack object with reference semantics and two methods, -`push` adds objects to the stack and `pop` removes them. -} -\details{ -This is dependency-free class based on function closures with reference semantics. -Internally, the stack is represented as a pre-allocated `list` that is extended as required. -The size of the `list` is set to the `init`, and is dynamically extended by the `init` value. - -Following methods are available: - -* `push(...)` - element or elements to stack, elements are converted to list -* `pop(n)` - removes and returns `n` latest elements from stack, if `n` is missing, remove all elements - -Following slots are available: - -* items - stack memory, a pre-allocated -* size - current size of the stack - -Modifying these slots could lead to inconsistent behaviour. -} -\examples{ -s = new_stack() -s$push("foo", "bar", "baz") - -identical(s$pop(1), list("foo")) -identical(s$pop(), list("bar", "baz")) -identical(s$pop(), list()) - -} diff --git a/old/man/pkg_cmd.Rd b/old/man/pkg_cmd.Rd deleted file mode 100644 index b6f8475..0000000 --- a/old/man/pkg_cmd.Rd +++ /dev/null @@ -1,40 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/pkg.r -\name{pkg_cmd} -\alias{pkg_cmd} -\alias{pkg_install} -\alias{pkg_build} -\alias{pkg_check} -\alias{pkg_name} -\title{Utility package functions} -\usage{ -pkg_install(pkg, path = tempdir()) - -pkg_build(pkg, path = tempdir()) - -pkg_check(pkg, path = tempdir(), as_cran = FALSE) - -pkg_name(pkg) -} -\arguments{ -\item{pkg}{a path to package source (`pkg_install()`, `pkg_build()`, `pkg_name()`) -or tarball (`pkg_install()`, `pkg_check()`)} - -\item{path}{a path where package is installed, build, or checked, defaults to `tempdir()`} - -\item{as_cran}{whether to run `R CMD check` with the `--as-cran` preset} -} -\value{ -`pkg_install` and `pkg_check` do not have a return value, - `pkg_build` returns a path to the compiled package tarball, - `pkg_name` returns a name of the package in specified path -} -\description{ -These functions map to the `R CMD INSTALL`, `R CMD build` and `R CMD check` commands. -} -\details{ -The functions `pkg_install`, `pkg_build`, and `pkg_check` map to the respective `R CMD` -commands. By default, all output files are created in a temporary directory. -The `pkg_name` is an utility functions that reads the `DESCRIPTION` file and returns the -package name. -} diff --git a/old/man/test.Rd b/old/man/test.Rd deleted file mode 100644 index 2228e19..0000000 --- a/old/man/test.Rd +++ /dev/null @@ -1,34 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/mutr.r -\name{test} -\alias{test} -\title{Test expression} -\usage{ -test(expr) -} -\arguments{ -\item{expr}{an expression to be evaluated} -} -\value{ -an evaluated expression -} -\description{ -Test provided expression for true-ness, the evaluated expression is returned invisibly. -If the `.mutr` object exists, the test counter is increased and the error message is appended. -Otherwise, the error message is printed. -} -\details{ -Any other condition than `TRUE` results in a differe with different diagnostic expression -depending on the evaluation. For this purpose, `test` distinguishes between: - -* error condition -* non-logical object -* logical object with length > 1 -* singular logical FALSE -* singular logical TRUE -} -\examples{ -test(TRUE) -test(FALSE) -test(stop()) -} diff --git a/old/man/test_context.Rd b/old/man/test_context.Rd deleted file mode 100644 index d381528..0000000 --- a/old/man/test_context.Rd +++ /dev/null @@ -1,34 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/mutr.r -\name{test_context} -\alias{test_context} -\alias{test_set} -\alias{test_file} -\alias{test_dir} -\title{Test context} -\usage{ -test_set(msg, expr) - -test_file(file) - -test_dir(dir) -} -\arguments{ -\item{msg}{a name of the set} - -\item{expr}{an expression containing `test`s, since only the `mutr::test` functions append -to the `.mutr` object, any other expressions won't influence the test counter.} - -\item{file}{a file containing `test_set`s and `test`s} - -\item{dir}{a directory containing files starting with `test`} -} -\description{ -Run the `test` functions in a context, such as set, file, or a directory. -} -\details{ -These function establish context for tests so that a structured test-suite can be constructed. -Each of the context functions `test_set`, `test_file`, and `test_dir` initialize the `.mutr` -object if it doesn't already exists, and create a `on.exit` destructor to print the test -result. -} diff --git a/old/man/test_pkg.Rd b/old/man/test_pkg.Rd deleted file mode 100644 index ca858db..0000000 --- a/old/man/test_pkg.Rd +++ /dev/null @@ -1,32 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/pkg.r -\name{test_pkg} -\alias{test_pkg} -\alias{check} -\alias{document} -\title{Package development functions} -\usage{ -test_pkg(pkg = ".") - -check(pkg = ".", as_cran = FALSE) - -document(pkg = ".") -} -\arguments{ -\item{pkg}{a path to the package directory} - -\item{as_cran}{run the `R CMD check` with the CRAN preset (internet connection required)} -} -\value{ -nothing, these functions are run for their side-effect -} -\description{ -These functions provide a dependency-light alternative to `devtools`. -} -\details{ -`test_pkg()` install and runs tests for specified package, these tests must be created by -some unit-testing framework in that they need to be able to be run outside of `R CMD check`. - -The `check()` maps to the `R CMD check` and `document()` runs the `roxygen2::roxygenize` -function to generate documentation. -} diff --git a/old/tests/helpers/mutr.r b/old/tests/helpers/mutr.r deleted file mode 100644 index 4c4e76c..0000000 --- a/old/tests/helpers/mutr.r +++ /dev/null @@ -1,63 +0,0 @@ -# mutr: minimal unit-testing framework -# -# a simplified copy-pastable version inspired by https://jera.com/techinfo/jtns/jtn002 -# -# For a more feature-full version along with some goodies see the `mutr` package. -.TEST_FAIL = 0 -.TEST_TOTAL = 0 -.TEST_SETS = 0 - -TEST_PRINT = function(){ - cat( - "[", - .TEST_SETS, "sets,", - .TEST_TOTAL, "tests,", - .TEST_FAIL, "failed,", - .TEST_TOTAL - .TEST_FAIL, "passed", - "]\n\n" - ) - if(.TEST_FAIL != 0) - stop("Some tests did not pass.\n", call. = FALSE) - - invisible() - } - - -TEST = function(expr){ - res = try(expr, silent = TRUE) - expr = paste0(deparse(substitute(expr)), collapse = "") - - .TEST_TOTAL <<- .TEST_TOTAL + 1 - - if(!isTRUE(res)){ - .TEST_FAIL <<- .TEST_FAIL + 1 - cat("Error in ", expr, ": is not TRUE\n", sep = "") - } - - invisible(res) - } - - -TEST_SET = function(msg, expr){ - .TEST_SETS <<- .TEST_SETS + 1 - - cat(" ", msg, "\n", sep = "") - res = try(expr, silent = TRUE) - - invisible() - } - - -TEST_FILE = function(file){ - sys.source(file, envir = environment(), chdir = TRUE) - - invisible() - } - - -TEST_DIR = function(dir){ - files = dir(dir, "^test[^.]*\\.[rR]$", full.names = TRUE) - lapply(files, TEST_FILE) - - invisible() - } diff --git a/old/tests/helpers/test-mutr.r b/old/tests/helpers/test-mutr.r deleted file mode 100644 index 2df0bae..0000000 --- a/old/tests/helpers/test-mutr.r +++ /dev/null @@ -1,42 +0,0 @@ -# Test for unit-tests -# -# This will test a simplified version of mutr used for self-testing - -# helpers -TEST_CHECK = function(fail, total, sets){ - stopifnot(.TEST_FAIL == fail, .TEST_TOTAL == total, .TEST_SETS == sets) - } - -TEST_FAIL = function(expr){ - msg = capture.output(TEST(expr)) - stopifnot("Error in expr: is not TRUE" == msg) - } - -TEST_PASS = function(expr){ - msg = capture.output(TEST(expr)) - stopifnot(msg == character(0)) - } - -TEST_RESET = function(){ - .TEST_FAIL <<- 0 - .TEST_TOTAL <<- 0 - .TEST_SETS <<- 0 - } - -TEST_CHECK(0, 0, 0) -TEST_PASS(TRUE) -TEST_CHECK(0, 1, 0) -TEST_FAIL(FALSE) -TEST_CHECK(1, 2, 0) -TEST_SET("", { - TEST_PASS(TRUE) - TEST_FAIL(FALSE) - TEST_FAIL(NA) - TEST_FAIL(1) - }) -TEST_CHECK(4, 6, 1) - - -# Cleanup -TEST_RESET() -rm("TEST_CHECK", "TEST_FAIL", "TEST_PASS", "TEST_RESET") diff --git a/old/tests/test_all.r b/old/tests/test_all.r deleted file mode 100644 index 8e08f87..0000000 --- a/old/tests/test_all.r +++ /dev/null @@ -1,6 +0,0 @@ -source("helpers/mutr.r") -source("helpers/test-mutr.r") -library("mutr") - -TEST_DIR("tests") -TEST_PRINT() diff --git a/old/tests/tests/test-stack.r b/old/tests/tests/test-stack.r deleted file mode 100644 index 78ac7a4..0000000 --- a/old/tests/tests/test-stack.r +++ /dev/null @@ -1,10 +0,0 @@ -TEST_SET("Test the 'stack' object", { - stack = new_stack() - - TEST(identical(stack$pop(), list())) - - stack$push("foo", "bar", "baz") - TEST(identical(stack$pop(1), list("baz"))) - TEST(identical(stack$pop(), list("foo", "bar"))) - TEST(identical(stack$pop(), list())) - }) diff --git a/test-mutr.r b/test-mutr.r new file mode 100644 index 0000000..ca3824d --- /dev/null +++ b/test-mutr.r @@ -0,0 +1,62 @@ +# test-mutr.r: tests for the unit-testing framework mutr + +TEST__CHECK = function(fail, total, sets){ + env = get(".TESTS", envir = globalenv()) + stopifnot(env$FAIL == fail, env$TOTAL == total, env$SETS == sets) + } + +TEST__FAIL = function(expr, .msg = NULL, f = TEST, ...){ + .expr = substitute(expr) + out = capture.output(eval(as.call(list(f, .expr, ...)))) + if(is.null(.msg)) .msg = paste0(" Error in ", deparse(substitute(expr)), ": is not TRUE!") + if(!identical(out, .msg)) + stop("Output message differs from expected!\n", + " Output: ", out, "\n", + " Expected: ", .msg) + } + +TEST__PASS = function(expr, f = TEST, ...){ + .expr = substitute(expr) + out = capture.output(eval(as.call(list(f, .expr, ...)))) + stopifnot(identical(out, character())) + } + +TEST__RESET = function(){ + rm(".TESTS", envir = globalenv()) + } + +TEST_INIT() +TEST__CHECK(0, 0, 0) +TEST__PASS(TRUE) +TEST__CHECK(0, 1, 0) +TEST__FAIL(FALSE) +TEST__FAIL(FALSE, " Error in FALSE: is not TRUE!") +TEST__FAIL(c(1:3), " Error in c(1:3): is not TRUE!") +TEST__CHECK(3, 4, 0) + +TEST_SET("", { + TEST__PASS(TRUE) + TEST__FAIL(FALSE) + TEST__FAIL(NA) + TEST__FAIL(1) + }) +TEST__CHECK(6, 8, 1) + +TEST__PASS(stop("foo"), f = TEST_ERROR) +TEST__PASS(stop("foo"), f = TEST_ERROR, pattern = "foo") +TEST__CHECK(6, 10, 1) +TEST__FAIL(stop("foo"), f = TEST_ERROR, pattern = "bar", + .msg = " Error in stop(\"foo\"): does not signal specified error!") +TEST__FAIL("foo", f = TEST_ERROR, + .msg = " Error in \"foo\": does not signal specified error!") +TEST__CHECK(8, 12, 1) + +TEST__PASS("foo", f = TEST_NOT_ERROR) +TEST__PASS(1, f = TEST_NOT_ERROR) +TEST__FAIL(stop("foo"), f = TEST_NOT_ERROR, + .msg = " Error in stop(\"foo\"): does signal an error!") +TEST__CHECK(9, 15, 1) + +# Cleanup +TEST__RESET() +rm("TEST__CHECK", "TEST__FAIL", "TEST__PASS", "TEST__RESET")