From 2771bc17e14f9cc65fe0c09dd4a03087702555ab Mon Sep 17 00:00:00 2001 From: CJ Yetman Date: Thu, 15 Aug 2024 10:19:31 +0200 Subject: [PATCH] add `stop_if_` utility functions to test func args (#61) --- DESCRIPTION | 4 + R/stop_if_.R | 141 +++++++++++++++++++++++++++++++++ tests/testthat.R | 12 +++ tests/testthat/test-stop_if_.R | 103 ++++++++++++++++++++++++ 4 files changed, 260 insertions(+) create mode 100644 R/stop_if_.R create mode 100644 tests/testthat.R create mode 100644 tests/testthat/test-stop_if_.R diff --git a/DESCRIPTION b/DESCRIPTION index a3fbbc21..2e579742 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -40,3 +40,7 @@ Depends: R (>= 4.1.0) License: MIT + file LICENSE RoxygenNote: 7.3.2 +Suggests: + testthat (>= 3.0.0), + writexl +Config/testthat/edition: 3 diff --git a/R/stop_if_.R b/R/stop_if_.R new file mode 100644 index 00000000..d10cb197 --- /dev/null +++ b/R/stop_if_.R @@ -0,0 +1,141 @@ +#' stop_if_not_inherits +#' +#' @param x an object to be checked +#' @param cls a string defining the expected object class +#' +#' @return `NULL` invisibly or an error + +stop_if_not_inherits <- function(x, cls) { + if (isFALSE(inherits(x, cls))) { + arg <- deparse(substitute(x)) + cli::cli_abort( + message = paste0( + "x" = "Argument {.arg {arg}} must inherit class {.cls {cls}}, ", + "not {.cls {class(x)}}." + ), + call = rlang::caller_env() + ) + } +} + + +#' stop_if_not_length +#' +#' @param x an object to be checked +#' @param len an integer defining the expected length of the object +#' +#' @return `NULL` invisibly or an error + +stop_if_not_length <- function(x, len) { + if (length(x) != len) { + arg <- deparse(substitute(x)) + cli::cli_abort( + message = paste0( + "x" = "Argument {.arg {arg}} must be of length {.strong {len}}, ", + " not {.strong {length(x)}}." + ), + call = rlang::caller_env() + ) + } +} + + +#' stop_if_dir_not_found +#' +#' @param path a string defining the path to a directory +#' @param desc a string describing the type of directory to be added to the +#' error msg +#' +#' @return `NULL` invisibly or an error + +stop_if_dir_not_found <- function(path, desc = NULL) { + if (isFALSE(dir.exists(path))) { + if (is.null(desc)) { + msg <- "Directory not found at path:" + } else { + msg <- "{desc} directory not found at path:" + } + cli::cli_abort( + message = c( + "x" = msg, + " " = "{.path {path}}", + "i" = "Check the path set in your {.file config.yml}." + ), + call = rlang::caller_env() + ) + } +} + + +#' stop_if_file_not_found +#' +#' @param path a string defining the path to a file +#' @param desc a string describing the type of file to be added to the error msg +#' +#' @return `NULL` invisibly or an error + +stop_if_file_not_found <- function(path, desc = NULL) { + if (isFALSE(file.exists(path))) { + if (is.null(desc)) { + msg <- "File not found at path:" + } else { + msg <- "{desc} file not found at path:" + } + cli::cli_abort( + message = c( + "x" = msg, + " " = "{.file {path}}", + "i" = "Check the path and filename set in your {.file config.yml}." + ), + call = rlang::caller_env() + ) + } +} + + +#' stop_if_sheet_not_found +#' +#' @param sheet a string defining the name of a sheet +#' @param path a string defining the path to a XLS/X file +#' +#' @return `NULL` invisibly or an error + +stop_if_sheet_not_found <- function(sheet, path) { + if (isFALSE(sheet %in% readxl::excel_sheets(path))) { + cli::cli_abort( + message = c( + "x" = "Sheet {.val {sheet}} is not found in file:", + " " = "{.file {path}}", + "i" = "Check the sheet name set in your {.file config.yml}." + ), + call = rlang::caller_env() + ) + } +} + + +#' stop_if_not_expected_columns +#' +#' @param data a data frame to be checked +#' @param cols a vector of expected column names +#' @param desc a string describing the type of data to be added to the error msg +#' +#' @return `NULL` invisibly or an error + +stop_if_not_expected_columns <- function(data, cols, desc = NULL) { + if (isFALSE(all(cols %in% names(data)))) { + if (is.null(desc)) { + msg <- "Data does not contain all of the expected columns." + } else { + msg <- "{desc} data does not contain all of the expected columns." + } + missing_cols <- setdiff(cols, names(data)) + cli::cli_abort( + message = c( + "x" = msg, + "i" = "missing columns: {.var {missing_cols}}." + ), + call = rlang::caller_env() + ) + } +} diff --git a/tests/testthat.R b/tests/testthat.R new file mode 100644 index 00000000..3c197e9b --- /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(workflow.multi.loanbook) + +test_check("workflow.multi.loanbook") diff --git a/tests/testthat/test-stop_if_.R b/tests/testthat/test-stop_if_.R new file mode 100644 index 00000000..a805aba9 --- /dev/null +++ b/tests/testthat/test-stop_if_.R @@ -0,0 +1,103 @@ +test_that("stop_if_not_inherits()", { + expect_no_condition(stop_if_not_inherits(1L, "integer")) + expect_no_condition(stop_if_not_inherits(1, "numeric")) + expect_no_condition(stop_if_not_inherits(1.1, "numeric")) + expect_no_condition(stop_if_not_inherits("A", "character")) + expect_no_condition(stop_if_not_inherits(list(a = 1), "list")) + expect_no_condition(stop_if_not_inherits(data.frame(a = 1), "data.frame")) + + expect_condition(stop_if_not_inherits(1, "integer")) + expect_condition(stop_if_not_inherits(1.1, "integer")) + expect_condition(stop_if_not_inherits("A", "integer")) + expect_condition(stop_if_not_inherits(list(a = 1), "integer")) + expect_condition(stop_if_not_inherits(data.frame(a = 1), "integer")) + + expect_condition(stop_if_not_inherits(1L, "numeric")) + expect_condition(stop_if_not_inherits("A", "numeric")) + expect_condition(stop_if_not_inherits(list(a = 1), "numeric")) + expect_condition(stop_if_not_inherits(data.frame(a = 1), "numeric")) + + expect_condition(stop_if_not_inherits(1L, "character")) + expect_condition(stop_if_not_inherits(1, "character")) + expect_condition(stop_if_not_inherits(1.1, "character")) + expect_condition(stop_if_not_inherits(list(a = 1), "character")) + expect_condition(stop_if_not_inherits(data.frame(a = 1), "character")) + + expect_condition(stop_if_not_inherits(1L, "list")) + expect_condition(stop_if_not_inherits(1, "list")) + expect_condition(stop_if_not_inherits(1.1, "list")) + expect_condition(stop_if_not_inherits("A", "list")) + expect_condition(stop_if_not_inherits(data.frame(a = 1), "list")) + + expect_condition(stop_if_not_inherits(1L, "data.frame")) + expect_condition(stop_if_not_inherits(1, "data.frame")) + expect_condition(stop_if_not_inherits(1.1, "data.frame")) + expect_condition(stop_if_not_inherits("A", "data.frame")) + expect_condition(stop_if_not_inherits(list(a = 1), "data.frame")) +}) + + +test_that("stop_if_not_length()", { + expect_no_condition(stop_if_not_length(NA, 1)) + expect_no_condition(stop_if_not_length(numeric(0), 0)) + expect_no_condition(stop_if_not_length(1, 1)) + expect_no_condition(stop_if_not_length(1:2, 2)) + expect_no_condition(stop_if_not_length(character(0), 0)) + expect_no_condition(stop_if_not_length("A", 1)) + expect_no_condition(stop_if_not_length(c("A", "B"), 2)) + expect_no_condition(stop_if_not_length(list(), 0)) + expect_no_condition(stop_if_not_length(list(a = 1), 1)) + expect_no_condition(stop_if_not_length(list(a = 1, b = 2), 2)) + + expect_condition(stop_if_not_length(NULL, 1)) + expect_condition(stop_if_not_length(numeric(0), 1)) + expect_condition(stop_if_not_length(1, 2)) + expect_condition(stop_if_not_length(1:2, 1)) + expect_condition(stop_if_not_length(character(0), 1)) + expect_condition(stop_if_not_length("A", 2)) + expect_condition(stop_if_not_length(c("A", "B"), 1)) + expect_condition(stop_if_not_length(list(), 1)) + expect_condition(stop_if_not_length(list(a = 1), 2)) + expect_condition(stop_if_not_length(list(a = 1, b = 2), 1)) +}) + + +test_that("stop_if_dir_not_found()", { + tmp_dir <- tempdir() + expect_no_condition(stop_if_dir_not_found(tmp_dir)) + expect_condition(stop_if_dir_not_found(file.path(tmp_dir, "XYZ"))) +}) + + +test_that("stop_if_file_not_found()", { + tmp_file <- tempfile() + file.create(tmp_file) + expect_no_condition(stop_if_file_not_found(tmp_file)) + expect_condition(stop_if_file_not_found(file.path(".", tmp_file))) + unlink(tmp_file) +}) + + +test_that("stop_if_sheet_not_found()", { + tmp_file <- tempfile() + writexl::write_xlsx(list("test" = data.frame(a = 1)), tmp_file) + expect_no_condition(stop_if_sheet_not_found("test", tmp_file)) + expect_condition(stop_if_sheet_not_found("xyz", tmp_file)) + unlink(tmp_file) +}) + + +test_that("stop_if_not_expected_columns()", { + data <- data.frame(a = 1, b = 2, c = 3) + expect_no_condition(stop_if_not_expected_columns(data, c("a"))) + expect_no_condition(stop_if_not_expected_columns(data, c("b"))) + expect_no_condition(stop_if_not_expected_columns(data, c("c"))) + expect_no_condition(stop_if_not_expected_columns(data, c("a", "b"))) + expect_no_condition(stop_if_not_expected_columns(data, c("b", "c"))) + expect_no_condition(stop_if_not_expected_columns(data, c("a", "b", "c"))) + expect_no_condition(stop_if_not_expected_columns(data, c("b", "c", "a"))) + + expect_condition(stop_if_not_expected_columns(data, c("x"))) + expect_condition(stop_if_not_expected_columns(data, c("x", "y", "z"))) + expect_condition(stop_if_not_expected_columns(data, c("a", "x"))) +})