From 75106d6085409880447f7b08b8a21a771a95bc89 Mon Sep 17 00:00:00 2001 From: Sam El-Kamand Date: Wed, 13 Nov 2024 15:11:49 +1100 Subject: [PATCH 01/12] fix: bulked up unit tests for set operations partially addresses #26 --- R/set_operations.R | 6 +- tests/testthat/test-set_operations.R | 89 ++++++++++++++++++++++++++++ 2 files changed, 92 insertions(+), 3 deletions(-) create mode 100644 tests/testthat/test-set_operations.R diff --git a/R/set_operations.R b/R/set_operations.R index 18080df..874587b 100644 --- a/R/set_operations.R +++ b/R/set_operations.R @@ -176,9 +176,9 @@ sets_are_equivalent <- function(x, y){ else if(any_missing & !any_extra) "missing" missing_plural = if(length(missing_values) > 1) "s" else "" - missing_plural_the = if(length(missing_values) < 2) " a " else "" + missing_plural_the = if(length(missing_values) < 2) "a " else "" extra_plural = if(length(extra_values) > 1) "s" else "" - extra_plural_the = if(length(extra_values) < 2) " an " else "" + extra_plural_the = if(length(extra_values) < 2) "an " else "" if(failure_mode == "both"){ @@ -188,6 +188,6 @@ sets_are_equivalent <- function(x, y){ return(paste0("'{arg_name}' contains ", extra_plural_the, "unexpected value",extra_plural,": {setopts_exlusive_to_first(x, y)}.")) } else if(failure_mode == "missing"){ - return(paste0("'{arg_name}' is missing" ,missing_plural_the, " required value",missing_plural,": {setopts_exlusive_to_first(y, x)}.")) + return(paste0("'{arg_name}' is missing " ,missing_plural_the, "required value",missing_plural,": {setopts_exlusive_to_first(y, x)}.")) } } diff --git a/tests/testthat/test-set_operations.R b/tests/testthat/test-set_operations.R new file mode 100644 index 0000000..00c691d --- /dev/null +++ b/tests/testthat/test-set_operations.R @@ -0,0 +1,89 @@ +# Test for is_subset ----------------------------------------------------------- +test_that("is_subset works correctly", { + expect_true(is_subset(c(1, 2), c(1, 2, 3, 4))) # Subset case + expect_false(is_subset(c(1, 5), c(1, 2, 3, 4))) # Not a subset + expect_true(is_subset(c("a"), c("a", "b", "c"))) # Single element subset + expect_true(is_subset(c(TRUE, FALSE), c(TRUE, FALSE))) # Logical subset + expect_false(is_subset(c(TRUE, TRUE), c(FALSE))) # No overlap + expect_true(is_subset(integer(0), 1:10)) # Empty subset is always true +}) + +# Test for is_superset ----------------------------------------------------------- +test_that("is_superset works correctly", { + expect_true(is_superset(c(1, 2, 3, 4), c(1, 2))) # Superset case + expect_false(is_superset(c(1, 2, 3), c(1, 4))) # Not a superset + expect_true(is_superset(c("a", "b", "c"), c("a"))) # Single element in set + expect_true(is_superset(c(TRUE, FALSE), c(TRUE))) # Logical superset + expect_false(is_superset(c(FALSE), c(TRUE, FALSE))) # Missing element in superset + expect_true(is_superset(1:10, integer(0))) # Empty subset always true +}) + +# Test for setopts_exlusive_to_first ----------------------------------------------------------- +test_that("setopts_exlusive_to_first works correctly", { + expect_equal(setopts_exlusive_to_first(c(1, 2, 3), c(2, 3, 4)), 1) # Element exclusive to x + expect_equal(setopts_exlusive_to_first(c("a", "b"), c("b", "c")), "a") # Character vector + expect_equal(setopts_exlusive_to_first(c(TRUE, FALSE), c(TRUE)), FALSE) # Logical vector + expect_equal(setopts_exlusive_to_first(1:5, 6:10), 1:5) # Non-overlapping sets + expect_equal(setopts_exlusive_to_first(integer(0), 1:10), integer(0)) # Empty x + expect_equal(setopts_exlusive_to_first(1:10, integer(0)), 1:10) # Empty y +}) + +# Test for setopts_count_exlusive_to_first ----------------------------------------------------------- +test_that("setopts_count_exlusive_to_first works correctly", { + expect_equal(setopts_count_exlusive_to_first(c(1, 2, 3), c(2, 3, 4)), 1) # Single exclusive + expect_equal(setopts_count_exlusive_to_first(c("a", "b"), c("b", "c")), 1) # Character vector + expect_equal(setopts_count_exlusive_to_first(c(TRUE, FALSE), c(TRUE)), 1) # Logical vector + expect_equal(setopts_count_exlusive_to_first(1:5, 6:10), 5) # Non-overlapping sets + expect_equal(setopts_count_exlusive_to_first(integer(0), 1:10), 0) # Empty x +}) + +# Test for setopts_common_elements ----------------------------------------------------------- +test_that("setopts_common_elements works correctly", { + expect_equal(setopts_common_elements(c(1, 2, 3), c(2, 3, 4)), c(2, 3)) # Overlapping elements + expect_equal(setopts_common_elements(c("a", "b"), c("b", "c")), "b") # Single common character + expect_equal(setopts_common_elements(c(TRUE, FALSE), c(TRUE)), TRUE) # Logical vector + expect_equal(setopts_common_elements(1:5, 6:10), integer(0)) # No common elements + expect_equal(setopts_common_elements(integer(0), 1:10), integer(0)) # Empty x +}) + +# Test for setopts_are_equal ----------------------------------------------------------- +test_that("setopts_are_equal works correctly", { + expect_true(setopts_are_equal(c(1, 2, 3), c(3, 2, 1))) # Same elements, different order + expect_false(setopts_are_equal(c(1, 2, 3), c(2, 3, 4))) # Different elements + expect_true(setopts_are_equal(c("a", "b"), c("b", "a"))) # Character vector + expect_false(setopts_are_equal(c(TRUE, FALSE), c(TRUE))) # Logical vector, missing value + expect_true(setopts_are_equal(integer(0), integer(0))) # Both empty +}) + +# Test for includes ----------------------------------------------------------- +test_that("includes works correctly", { + expect_true(includes(c(1, 2, 3, 4), c(1, 2))) # Subset case + expect_false(includes(c(1, 2, 3), c(1, 4))) # Not a subset + expect_true(includes(c("a", "b", "c"), "a")) # Single element + expect_true(includes(c(TRUE, FALSE), c(TRUE))) # Logical vector + expect_true(includes(1:10, integer(0))) # Empty required set +}) + +# Test for includes_advanced ----------------------------------------------------------- +test_that("includes_advanced works correctly", { + expect_equal(includes_advanced(c(1, 2, 3, 4), c(1, 2)), TRUE) # Subset case + expect_match(includes_advanced(c(1, 2, 3), c(1, 4)), "must include") # Missing elements + expect_equal(includes_advanced(c("a", "b"), "a"), TRUE) # Single element character + expect_match(includes_advanced(1:5, "a"), "must be the same type") # Type mismatch +}) + +# Test for excludes_advanced ----------------------------------------------------------- +test_that("excludes_advanced works correctly", { + expect_equal(excludes_advanced(c(1, 2, 3, 4), c(5, 6)), TRUE) # No overlap + expect_match(excludes_advanced(c(1, 2, 3), c(1, 4)), "must exclude") # Contains prohibited elements + expect_equal(excludes_advanced(c("a", "b"), "c"), TRUE) # No prohibited element + expect_match(excludes_advanced(1:5, "a"), "must be the same type") # Type mismatch +}) + +# Test for sets_are_equivalent ----------------------------------------------------------- +test_that("sets_are_equivalent works correctly", { + expect_equal(sets_are_equivalent(c(1, 2, 3), c(3, 2, 1)), TRUE) # Same elements + expect_match(sets_are_equivalent(c(1, 2, 3), c(1, 2)), "unexpected value") # Extra element in x + expect_match(sets_are_equivalent(c(1, 2), c(1, 2, 3)), "missing a required value") # Missing element in y + expect_match(sets_are_equivalent(c(1, 2, 3), c(4, 5, 6)), "missing required values") # Completely different +}) From cb0f3045a1f27b7694ab1ab0f91c8dcc0915d17d Mon Sep 17 00:00:00 2001 From: Sam El-Kamand Date: Wed, 13 Nov 2024 15:19:24 +1100 Subject: [PATCH 02/12] fix: added unit test for is_ functions --- tests/testthat/test-is_functions.R | 155 +++++++++++++++++++++++++++++ 1 file changed, 155 insertions(+) create mode 100644 tests/testthat/test-is_functions.R diff --git a/tests/testthat/test-is_functions.R b/tests/testthat/test-is_functions.R new file mode 100644 index 0000000..21d3f32 --- /dev/null +++ b/tests/testthat/test-is_functions.R @@ -0,0 +1,155 @@ +# Unit tests for each function + +# Test `is_vector` +test_that("is_vector works as expected", { + expect_true(is_vector(c(1, 2, 3))) + expect_false(is_vector(list(1, 2, 3))) + expect_false(is_vector(matrix(1:4, 2, 2))) + expect_false(is_vector(data.frame(a = 1:3, b = 4:6))) + expect_false(is_vector(NULL)) + expect_true(is_vector(NA)) +}) + +# Test `is_numeric_vector` +test_that("is_numeric_vector works as expected", { + expect_true(is_numeric_vector(c(1, 2, 3))) + expect_false(is_numeric_vector(list(1, 2, 3))) + expect_true(is_numeric_vector(1:5)) + expect_false(is_numeric_vector("hello")) + expect_false(is_numeric_vector(c(1, 2, "a"))) + expect_false(is_numeric_vector(NULL)) +}) + +# Test `is_number` +test_that("is_number works as expected", { + expect_true(is_number(1)) + expect_false(is_number(c(1, 2))) + expect_false(is_number("a")) + expect_false(is_number(NULL)) + expect_false(is_number(TRUE)) +}) + +# Test `is_character_vector` +test_that("is_character_vector works as expected", { + expect_true(is_character_vector(c("a", "b", "c"))) + expect_false(is_character_vector(list("a", "b", "c"))) + expect_false(is_character_vector(1:5)) + expect_false(is_character_vector(NA)) +}) + +# Test `is_character_vector_or_glue` +test_that("is_character_vector_or_glue works as expected", { + expect_true(is_character_vector_or_glue(c("a", "b", "c"))) + expect_false(is_character_vector_or_glue(1:5)) + expect_false(is_character_vector_or_glue(NA)) + # If `glue` package is available, add tests with glue strings + glue_str <- glue::glue("Hello {1+1}") + expect_true(is_character_vector_or_glue(glue_str)) +}) + +# Test `is_scalar` +test_that("is_scalar works as expected", { + expect_true(is_scalar(1)) + expect_false(is_scalar(c(1, 2))) + expect_false(is_scalar(matrix(1:4, 2, 2))) + expect_false(is_scalar(data.frame(a = 1:3, b = 4:6))) + expect_false(is_scalar(NULL)) + expect_true(is_scalar(TRUE)) + expect_false(is_scalar(list(1))) +}) + +# Test `is_logical_vector` +test_that("is_logical_vector works as expected", { + expect_true(is_logical_vector(c(TRUE, FALSE, TRUE))) + expect_true(is_logical_vector(NA)) + expect_false(is_logical_vector(list(TRUE, FALSE, TRUE))) + expect_false(is_logical_vector(1:5)) + expect_false(is_logical_vector("hello")) +}) + +# Test `is_string` +test_that("is_string works as expected", { + expect_true(is_string("hello")) + expect_false(is_string(c("a", "b"))) + expect_false(is_string(1)) + expect_false(is_string(NULL)) + expect_false(is_string(TRUE)) + expect_false(is_string(NA)) +}) + +# Test `is_flag` +test_that("is_flag works as expected", { + expect_true(is_flag(TRUE)) + expect_true(is_flag(FALSE)) + expect_false(is_flag(c(TRUE, FALSE))) + expect_false(is_flag(1)) + expect_false(is_flag("hello")) + expect_false(is_flag(NULL)) +}) + +# Test `is_list` +test_that("is_list works as expected", { + expect_true(is_list(list(1, 2))) + expect_false(is_list(c(1, 2, 3))) + expect_false(is_list(matrix(1:4, 2, 2))) + expect_false(is_list(data.frame(a = 1:3, b = 4:6))) + expect_true(is_list(data.frame(a = 1:3, b = 4:6), include_dataframes = TRUE)) +}) + +# Test `is_reactive` (requires shiny) +test_that("is_reactive works as expected", { + if (requireNamespace("shiny", quietly = TRUE)) { + expect_true(is_reactive(shiny::reactive(1))) + expect_false(is_reactive(1)) + expect_false(is_reactive(NULL)) + } else { + skip("Shiny package not installed.") + } +}) + +# Test `is_whole_number` +test_that("is_whole_number works as expected", { + expect_true(is_whole_number(2)) + expect_false(is_whole_number(2.5)) + expect_true(is_whole_number(0)) + expect_true(is_whole_number(-3)) +}) + +# Test `is_connection` (requires DBI) +test_that("is_connection works as expected", { + # conn <- DBI::dbConnect(RSQLite::SQLite(), ":memory:") # We use a mock connection instead since a real one would require more dependencies + conn <- structure(list(), class = c("SQLiteConnection", "DBIConnection")) + expect_true(is_connection(conn)) + expect_false(is_connection(NULL)) + expect_false(is_connection(1)) +}) + +# Advanced function tests + +# Test `is_number_advanced` +test_that("is_number_advanced works as expected", { + expect_true(is_number_advanced(1)) + expect_match(is_number_advanced("a"), "is not a {.strong number}", fixed = TRUE) + expect_match(is_number_advanced(c(1, 2)), "is not a {.strong number}", fixed = TRUE) +}) + +# Test `is_flag_advanced` +test_that("is_flag_advanced works as expected", { + expect_true(is_flag_advanced(TRUE)) + expect_match(is_flag_advanced(1), "is not a {.strong flag}", fixed=TRUE) + expect_match(is_flag_advanced(c(TRUE, FALSE)), "is not a {.strong flag}", fixed=TRUE) +}) + +# Test `is_string_advanced` +test_that("is_string_advanced works as expected", { + expect_true(is_string_advanced("hello")) + expect_match(is_string_advanced(1), "is not a {.strong string}", fixed=TRUE) + expect_match(is_string_advanced(c("a", "b")), "is not a {.strong string}", fixed=TRUE) +}) + +# Test `is_non_empty_string_advanced` +test_that("is_non_empty_string_advanced works as expected", { + expect_true(is_non_empty_string_advanced("hello")) + expect_match(is_non_empty_string_advanced(1), "is not a {.strong string}", fixed=TRUE) + expect_match(is_non_empty_string_advanced(""), "is an {.strong empty} string", fixed=TRUE) +}) From 5e3ba80449955d52eeb73e076f23c6cf242f7e2a Mon Sep 17 00:00:00 2001 From: Sam El-Kamand Date: Wed, 13 Nov 2024 15:22:10 +1100 Subject: [PATCH 03/12] fix: tested assert_create_chain_example --- tests/testthat/test-assert_create.R | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/tests/testthat/test-assert_create.R b/tests/testthat/test-assert_create.R index 80a3682..a9ecd70 100644 --- a/tests/testthat/test-assert_create.R +++ b/tests/testthat/test-assert_create.R @@ -152,3 +152,11 @@ cli::test_that_cli(configs = "plain", "assert_create_chain: user supplied custo age = "26" expect_error(assert_chain(age, "{arg_name} must be a number, not a {class(arg_value)}"), "age must be a number, not a character", fixed=TRUE) }) + + +cli::test_that_cli(configs = "plain", "assert_create_chain_example", { + expect_no_error(assert_create_chain_example()) + expect_true(is.character(assert_create_chain_example())) +}) + + From 4450ddce59d5c6343f802a2da49d036bfcb3bc11 Mon Sep 17 00:00:00 2001 From: Sam El-Kamand Date: Wed, 13 Nov 2024 15:39:56 +1100 Subject: [PATCH 04/12] fix: unit tested underlying file-existance funcs --- R/assert_files.R | 10 ++- tests/testthat/test-assert_files.R | 130 +++++++++++++++++++++++++++++ 2 files changed, 136 insertions(+), 4 deletions(-) diff --git a/R/assert_files.R b/R/assert_files.R index 1e4cf66..6d6197e 100644 --- a/R/assert_files.R +++ b/R/assert_files.R @@ -29,7 +29,7 @@ get_file_extensions <- function(filenames) { }, character(1)) } -#' Title +#' Has Extension #' #' @param x object to test #' @param extensions valid extensions (character vector). Do not include the '.', e.g. supply `extensions = 'txt'` not `extensions = '.txt'` @@ -46,16 +46,18 @@ has_extension <- function(x, extensions, compression = FALSE){ all(observed_ext %in% extensions) } +# Which of the filenames are missing the required extension? files_missing_extension <- function(x, extensions, compression = FALSE){ + original = x if(compression){ - x = sub(x = x,"\\.(gz|bz2|xz)$","") + x = sub(x = x,"\\.(gz|bz2|xz)$","") } observed_ext <- get_file_extensions(x) - x[!observed_ext %in% extensions] + original[!observed_ext %in% extensions] } -# Files --------------------------------------------------------------- +# File Assertions --------------------------------------------------------------- #' Assert that all files exist #' diff --git a/tests/testthat/test-assert_files.R b/tests/testthat/test-assert_files.R index 0c2b1d4..b1ac33e 100644 --- a/tests/testthat/test-assert_files.R +++ b/tests/testthat/test-assert_files.R @@ -228,3 +228,133 @@ test_that("assert_directory_does_not_exist() works", { expect_error(assert_file_does_not_exist(dirpath), regexp = "Directory .* already exists") }) + +# Test Underlying Functions ----------------------------------------------- + +## All files exist ------------------------------------------------ +test_that("all_files_exist() works", { + # False when files don't exist + expect_false(all_files_exist(c("ALKAWDWLKDLWADJWLD", "ADASKJDLAJWLDJKDKLWDJLAKDJWLKLDAW"))) + + # Create two temporary files + f1 <- withr::local_tempfile() + f2 <- withr::local_tempfile() + f3 <- "Does Not exist" + + # Write some content to the files to ensure they exist + writeLines("Test content 1", f1) + writeLines("Test content 2", f2) + + # Test that both files exist + expect_true(file.exists(f1)) + expect_true(file.exists(f2)) + + # Test all_files_exist() function + expect_true(all_files_exist(c(f1, f2))) + expect_false(all_files_exist(c(f1, f2, f3))) +}) + +## Has Extension ------------------------------------------------ +test_that("has_extension works() works", { + # False when files don't exist + expect_false(all_files_exist(c("ALKAWDWLKDLWADJWLD", "ADASKJDLAJWLDJKDKLWDJLAKDJWLKLDAW"))) + + # Create two temporary files + f1 <- withr::local_tempfile() + f2 <- withr::local_tempfile() + f3 <- "Does Not exist" + + # Write some content to the files to ensure they exist + writeLines("Test content 1", f1) + writeLines("Test content 2", f2) + + # Test that both files exist + expect_true(file.exists(f1)) + expect_true(file.exists(f2)) + + # Test all_files_exist() function + expect_true(all_files_exist(c(f1, f2))) + expect_false(all_files_exist(c(f1, f2, f3))) +}) + + +test_that("has_extension works with single valid extensions", { + expect_true(has_extension("file.txt", extensions = "txt")) + expect_true(has_extension("file.csv", extensions = "csv")) + expect_false(has_extension("file.doc", extensions = "txt")) +}) + +test_that("has_extension works with multiple valid extensions", { + expect_true(has_extension("file.txt", extensions = c("txt", "csv"))) + expect_true(has_extension("file.csv", extensions = c("txt", "csv"))) + expect_false(has_extension("file.doc", extensions = c("txt", "csv"))) +}) + +test_that("has_extension handles multiple files", { + expect_true(has_extension(c("file1.txt", "file2.txt"), extensions = "txt")) + expect_false(has_extension(c("file1.txt", "file2.csv"), extensions = "txt")) + expect_true(has_extension(c("file1.txt", "file2.csv"), extensions = c("txt", "csv"))) +}) + +test_that("has_extension handles compression correctly", { + expect_true(has_extension("file.txt.gz", extensions = "txt", compression = TRUE)) + expect_false(has_extension("file.doc.gz", extensions = "txt", compression = TRUE)) + expect_true(has_extension("file.txt.bz2", extensions = "txt", compression = TRUE)) + expect_true(has_extension("file.csv.xz", extensions = "csv", compression = TRUE)) + expect_false(has_extension("file.csv.zip", extensions = "csv", compression = TRUE)) # zip is not supported as compression +}) + +test_that("has_extension handles files without extensions", { + expect_false(has_extension("file", extensions = "txt")) + expect_false(has_extension("file", extensions = c("txt", "csv"))) + expect_true(has_extension("file", extensions = "")) # No extension, treated as valid if `extensions` includes an empty string +}) + +test_that("has_extension handles mixed cases and unexpected inputs", { + expect_false(has_extension(c("file.TXT", "file.csv"), extensions = "txt")) # Case sensitivity + expect_true(has_extension("file.txt.gz", extensions = "txt", compression = TRUE)) + expect_false(has_extension("file.txt.gz", extensions = "gz", compression = TRUE)) # Compression stripped + expect_true(has_extension(c("file.txt", "file.TXT"), extensions = c("txt", "TXT"))) # Mixed-case extensions +}) + +## Files Missing Extension ------------------------------------------------ + +test_that("files_missing_extension identifies files without specified extensions", { + # Only "file.doc" does not match the specified extensions + expect_equal(files_missing_extension(c("file.txt", "file.csv", "file.doc"), extensions = c("txt", "csv")), + c("file.doc")) + + # Both "file.doc" and "file.pdf" do not match "txt" + expect_equal(files_missing_extension(c("file.txt", "file.doc", "file.pdf"), extensions = "txt"), + c("file.doc", "file.pdf")) + + # No files are missing the specified extension + expect_equal(files_missing_extension(c("file.txt", "file.csv"), extensions = c("txt", "csv")), + character(0)) +}) + + +test_that("files_missing_extension handles compression correctly", { + # Only "file.doc.gz" does not match "txt" when compression is enabled + expect_equal(files_missing_extension(c("file.txt.gz", "file.csv.bz2", "file.doc.gz"), extensions = "txt", compression = TRUE), + c("file.csv.bz2", "file.doc.gz")) + + # When compression is disabled, all files with compression extensions are treated as missing + expect_equal(files_missing_extension(c("file.txt.gz", "file.csv.bz2", "file.doc.gz"), extensions = c("txt", "csv"), compression = FALSE), + c("file.txt.gz", "file.csv.bz2", "file.doc.gz")) + + # Mixed case: Only "file.doc.xz" is missing the specified extensions + expect_equal(files_missing_extension(c("file.txt.gz", "file.csv.bz2", "file.doc.xz"), extensions = c("txt", "csv"), compression = TRUE), + c("file.doc.xz")) +}) + +test_that("files_missing_extension handles files without any extensions", { + # Files without extensions should be identified as missing + expect_equal(files_missing_extension(c("file1", "file2.txt", "file3"), extensions = "txt"), + c("file1", "file3")) + + # If extensions includes an empty string, files without extensions should be considered valid + expect_equal(files_missing_extension(c("file1", "file2.txt", "file3"), extensions = c("txt", "")), + character(0)) +}) + From 6493ef3e7cd4192ffd7350d5de8ba234a3168198 Mon Sep 17 00:00:00 2001 From: Sam El-Kamand Date: Wed, 13 Nov 2024 15:42:55 +1100 Subject: [PATCH 05/12] fix: added unit tests for is_comparisons --- tests/testthat/test-is_comparisons.R | 83 ++++++++++++++++++++++++++++ 1 file changed, 83 insertions(+) create mode 100644 tests/testthat/test-is_comparisons.R diff --git a/tests/testthat/test-is_comparisons.R b/tests/testthat/test-is_comparisons.R new file mode 100644 index 0000000..855ff3d --- /dev/null +++ b/tests/testthat/test-is_comparisons.R @@ -0,0 +1,83 @@ +# Unit tests for `compare` +test_that("compare function behaves correctly with different criteria", { + # Single condition: equal to + expect_true(compare(5, equal_to = 5)) + expect_false(compare(4, equal_to = 5)) + + # Single condition: minimum (inclusive and exclusive) + expect_true(compare(5, minimum = 5, comparison_inclusive = TRUE)) + expect_false(compare(4, minimum = 5, comparison_inclusive = TRUE)) + expect_true(compare(6, minimum = 5, comparison_inclusive = FALSE)) + expect_false(compare(5, minimum = 5, comparison_inclusive = FALSE)) + + # Single condition: maximum (inclusive and exclusive) + expect_true(compare(5, maximum = 5, comparison_inclusive = TRUE)) + expect_false(compare(6, maximum = 5, comparison_inclusive = TRUE)) + expect_true(compare(4, maximum = 5, comparison_inclusive = FALSE)) + expect_false(compare(5, maximum = 5, comparison_inclusive = FALSE)) + + # Multiple conditions: equal to and minimum + expect_true(compare(5, equal_to = 5, minimum = 3)) + expect_false(compare(5, equal_to = 5, minimum = 6)) + + # All must satisfy with vector input + expect_true(compare(c(5, 6, 7), minimum = 5, all_must_satisfy = TRUE)) + expect_false(compare(c(5, 6, 4), minimum = 5, all_must_satisfy = TRUE)) + + # Any can satisfy with vector input + expect_true(compare(c(5, 6, 4), minimum = 5, all_must_satisfy = FALSE)) + expect_false(compare(c(4, 3, 2), minimum = 5, all_must_satisfy = FALSE)) +}) + +# Unit tests for `is_greater_than` +test_that("is_greater_than function checks if all values are greater than minimum", { + expect_true(is_greater_than(c(2, 3, 4), minimum = 1)) + expect_false(is_greater_than(c(2, 3, 4), minimum = 4)) + expect_false(is_greater_than(c(2, 3, 1), minimum = 2)) +}) + +# Unit tests for `is_greater_than_or_equal_to` +test_that("is_greater_than_or_equal_to function checks if all values are greater than or equal to minimum", { + expect_true(is_greater_than_or_equal_to(c(2, 3, 4), minimum = 2)) + expect_false(is_greater_than_or_equal_to(c(2, 3, 1), minimum = 3)) +}) + +# Unit tests for `is_less_than` +test_that("is_less_than function checks if all values are less than maximum", { + expect_true(is_less_than(c(1, 2, 3), maximum = 4)) + expect_false(is_less_than(c(1, 2, 4), maximum = 3)) +}) + +# Unit tests for `is_less_than_or_equal_to` +test_that("is_less_than_or_equal_to function checks if all values are less than or equal to maximum", { + expect_true(is_less_than_or_equal_to(c(1, 2, 3), maximum = 3)) + expect_false(is_less_than_or_equal_to(c(1, 2, 4), maximum = 3)) +}) + +# Unit tests for `is_identical` +test_that("is_identical function correctly identifies identical objects", { + expect_true(is_identical(1, 1)) + expect_false(is_identical(c(1, 2), 1)) + expect_true(is_identical("A", "A")) + expect_false(is_identical("A", "B")) + expect_true(is_identical(list(a = 1), list(a = 1))) + expect_false(is_identical(list(a = 1), list(a = 2))) +}) + +# Unit tests for `is_equal` +test_that("is_equal function correctly compares equality with tolerance", { + expect_true(is_equal(1.00000001, 1.00000002)) + expect_false(is_equal(1.0001, 1.0002)) + expect_true(is_equal(c(1, 2), c(1, 2))) + expect_false(is_equal(c(1, 2), c(2, 3))) + expect_true(is_equal("hello", "hello")) + expect_false(is_equal("hello", "world")) +}) + +# Unit tests for `is_same_type` +test_that("is_same_type function correctly identifies same types", { + expect_true(is_same_type(1, 2)) + expect_false(is_same_type(1, "a")) + expect_true(is_same_type(c(1, 2), c(3, 4))) + expect_false(is_same_type(list(a = 1), c(1, 2))) +}) From 3cd82b0a506a5e968f0ec48ccac89e5cc8cbc23c Mon Sep 17 00:00:00 2001 From: Sam El-Kamand Date: Wed, 13 Nov 2024 15:53:42 +1100 Subject: [PATCH 06/12] fix: unit tested function probing funcs --- tests/testthat/test-assert_functions.R | 88 ++++++++++++++++++++++++++ 1 file changed, 88 insertions(+) diff --git a/tests/testthat/test-assert_functions.R b/tests/testthat/test-assert_functions.R index 1e50849..e1f1ac2 100644 --- a/tests/testthat/test-assert_functions.R +++ b/tests/testthat/test-assert_functions.R @@ -1,3 +1,91 @@ + +# Test Underlying Functions ----------------------------------------------- +func_arg_count <- function(f, dots = "throw_error") { + args <- formals(f) + if ("..." %in% names(args)) { + switch(dots, + throw_error = stop("Function should not contain ... arguments"), + count_as_0 = return(length(args) - 1), + count_as_1 = return(length(args)), + count_as_inf = return(Inf)) + } + return(length(args)) +} + +# Define some test functions for validation +fn_0_args <- function() {} +fn_1_arg <- function(a) {} +fn_2_args <- function(a, b) {} +fn_1_arg_with_dots <- function(a, ...) {} +fn_2_args_with_dots <- function(a, b, ...) {} + +# Unit tests for `function_expects_n_arguments_advanced` +test_that("function_expects_n_arguments_advanced behaves correctly for exact argument count", { + # Exact argument match + expect_true(function_expects_n_arguments_advanced(fn_0_args, 0)) + expect_true(function_expects_n_arguments_advanced(fn_1_arg, 1)) + expect_true(function_expects_n_arguments_advanced(fn_2_args, 2)) + + # Mismatched argument counts + expect_match(function_expects_n_arguments_advanced(fn_1_arg, 2), "must expect exactly {.strong {n}} argument", fixed = TRUE) + expect_match(function_expects_n_arguments_advanced(fn_2_args, 1), "must expect exactly {.strong {n}} argument", fixed = TRUE) +}) + +test_that("function_expects_n_arguments_advanced handles dots behavior correctly", { + # Test with `...` and dots="throw_error" + expect_match(function_expects_n_arguments_advanced(fn_1_arg_with_dots, 1, dots = "throw_error"), + "must not contain ... arguments", fixed = TRUE) + + # Test with `...` and dots="count_as_0" + expect_true(function_expects_n_arguments_advanced(fn_1_arg_with_dots, 1, dots = "count_as_0")) + expect_true(function_expects_n_arguments_advanced(fn_2_args_with_dots, 2, dots = "count_as_0")) + + # Test with `...` and dots="count_as_1" + expect_true(function_expects_n_arguments_advanced(fn_1_arg_with_dots, 2, dots = "count_as_1")) + expect_true(function_expects_n_arguments_advanced(fn_2_args_with_dots, 3, dots = "count_as_1")) + + # Test with `...` and dots="count_as_inf" + expect_true(function_expects_n_arguments_advanced(fn_1_arg_with_dots, Inf, dots = "count_as_inf")) + expect_true(function_expects_n_arguments_advanced(fn_2_args_with_dots, Inf, dots = "count_as_inf")) +}) + +test_that("function_expects_n_arguments_advanced returns correct error for non-function inputs", { + # Input is not a function + expect_match(function_expects_n_arguments_advanced(42, 1), "must be a function, not a", fixed = TRUE) + expect_match(function_expects_n_arguments_advanced("not_a_function", 1), "must be a function, not a", fixed = TRUE) +}) + +test_that("function_expects_n_arguments_advanced correctly counts arguments for functions with no arguments", { + # Functions with no arguments should pass with 0 expected arguments + expect_true(function_expects_n_arguments_advanced(fn_0_args, 0)) + + # Mismatch for functions with no arguments + expect_match(function_expects_n_arguments_advanced(fn_0_args, 1), "must expect exactly {.strong {n}} argument", fixed = TRUE) +}) + +test_that("function_expects_n_arguments_advanced correctly counts arguments for functions with multiple arguments", { + # Functions with multiple arguments should match exactly + expect_true(function_expects_n_arguments_advanced(fn_2_args, 2)) + + # Mismatch for functions with multiple arguments + expect_match(function_expects_n_arguments_advanced(fn_2_args, 3), "must expect exactly {.strong {n}} argument", fixed = TRUE) +}) + +test_that("function_expects_n_arguments_advanced handles `dots` parameter correctly with complex cases", { + # Functions with variadic args (dots) should adapt based on `dots` parameter + expect_true(function_expects_n_arguments_advanced(fn_1_arg_with_dots, 1, dots = "count_as_0")) + expect_true(function_expects_n_arguments_advanced(fn_2_args_with_dots, 2, dots = "count_as_0")) + expect_true(function_expects_n_arguments_advanced(fn_1_arg_with_dots, 2, dots = "count_as_1")) + expect_true(function_expects_n_arguments_advanced(fn_2_args_with_dots, 3, dots = "count_as_1")) + expect_true(function_expects_n_arguments_advanced(fn_1_arg_with_dots, Inf, dots = "count_as_inf")) + expect_true(function_expects_n_arguments_advanced(fn_2_args_with_dots, Inf, dots = "count_as_inf")) +}) + + + + +# Test Assertions --------------------------------------------------------- + cli::test_that_cli("assert_function_expects_n_arguments() works", config = "plain", { # Works for functions with the correct number of arguments my_func <- function(x, y) { x + y } From 49ffe6237982c1a60ed4dac70b8825e0b86997a8 Mon Sep 17 00:00:00 2001 From: Sam El-Kamand Date: Wed, 13 Nov 2024 16:10:55 +1100 Subject: [PATCH 07/12] fix: updated func_arg_count to count ... arg as 0 Resolves issue #128 --- R/assert_create.R | 2 +- tests/testthat/test-assert_create.R | 12 ++++++++++++ 2 files changed, 13 insertions(+), 1 deletion(-) diff --git a/R/assert_create.R b/R/assert_create.R index 6770994..a68533f 100644 --- a/R/assert_create.R +++ b/R/assert_create.R @@ -53,7 +53,7 @@ assert_create <- function(func, default_error_msg = NULL){ } # Ensure func has at least 1 argument - if(func_arg_count(func) == 0){ + if(func_arg_count(func, dots = "count_as_0") == 0){ if (func_supports_variable_arguments(func)) additional_note = " (Note '...' does NOT count as an argument)" else additional_note = "" diff --git a/tests/testthat/test-assert_create.R b/tests/testthat/test-assert_create.R index a9ecd70..86bea07 100644 --- a/tests/testthat/test-assert_create.R +++ b/tests/testthat/test-assert_create.R @@ -119,6 +119,18 @@ cli::test_that_cli(configs = "plain", "created assertion() functions throw infor expect_true(assert_f1('a', 'b')) }) + +cli::test_that_cli(configs = "plain", "assert_create edge case errors", { + + # Function has dots + expect_no_error(assert_create(func = function(a, b, ...){ FALSE }, default_error_msg = "error")) + + # Function has dots but no other arguments + expect_error(assert_create(func = function( ...){ FALSE }, default_error_msg = "error"), regexp = "must have at least 1 paramater.*Note '\\.\\.\\.' does NOT count as an argument") + +}) + + # Test Creation of Assertion Chains ----------------------------------------------------- cli::test_that_cli(configs = "plain", "assertion chains can evaluate expressions part and not get confused if they contain variable names", { #assert_is_character <- assert_create(is.character, "Error: {arg_name} must be a character") From a066c41443c88a4bbd334c4ff5a3eef498697ea9 Mon Sep 17 00:00:00 2001 From: Sam El-Kamand Date: Wed, 13 Nov 2024 16:13:20 +1100 Subject: [PATCH 08/12] fix: resolves issue #129 --- R/assert_create.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/assert_create.R b/R/assert_create.R index a68533f..f7493c1 100644 --- a/R/assert_create.R +++ b/R/assert_create.R @@ -72,7 +72,7 @@ assert_create <- function(func, default_error_msg = NULL){ # Assert that function has no arguments named 'msg' or 'call', 'arg_name', since we need to add our own if(any(c('msg', 'call', 'arg_name') %in% names(args))){ - cli::cli_abort("Function supplied to `func` argument of `create_dataframe` cannot include paramaters namex 'msg' or 'call', 'arg_name', since we add our own arguments with these names") + cli::cli_abort("Function supplied to `func` argument of `assert_create` cannot include paramaters namex 'msg' or 'call', 'arg_name', since we add our own arguments with these names") } # Change add 'msg', 'call' and 'arg_name' arguments at the end From 612c027242c85acaa8b4a8c944bed467f6e086e9 Mon Sep 17 00:00:00 2001 From: Sam El-Kamand Date: Wed, 13 Nov 2024 16:19:43 +1100 Subject: [PATCH 09/12] fix: assert_create error message impoved + tested --- R/assert_create.R | 2 +- man/has_extension.Rd | 4 ++-- tests/testthat/test-assert_create.R | 7 +++++-- 3 files changed, 8 insertions(+), 5 deletions(-) diff --git a/R/assert_create.R b/R/assert_create.R index f7493c1..a5ca918 100644 --- a/R/assert_create.R +++ b/R/assert_create.R @@ -72,7 +72,7 @@ assert_create <- function(func, default_error_msg = NULL){ # Assert that function has no arguments named 'msg' or 'call', 'arg_name', since we need to add our own if(any(c('msg', 'call', 'arg_name') %in% names(args))){ - cli::cli_abort("Function supplied to `func` argument of `assert_create` cannot include paramaters namex 'msg' or 'call', 'arg_name', since we add our own arguments with these names") + cli::cli_abort("Function supplied to `func` argument of `assert_create` cannot include paramaters named 'msg', 'call', or 'arg_name', since assert_create adds these arguments to every assertion") } # Change add 'msg', 'call' and 'arg_name' arguments at the end diff --git a/man/has_extension.Rd b/man/has_extension.Rd index 4d37e0c..a7c54fc 100644 --- a/man/has_extension.Rd +++ b/man/has_extension.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/assert_files.R \name{has_extension} \alias{has_extension} -\title{Title} +\title{Has Extension} \usage{ has_extension(x, extensions, compression = FALSE) } @@ -17,5 +17,5 @@ has_extension(x, extensions, compression = FALSE) TRUE if all x have valid extensions as supplied by \code{extensions} (flag) } \description{ -Title +Has Extension } diff --git a/tests/testthat/test-assert_create.R b/tests/testthat/test-assert_create.R index 86bea07..3f7f448 100644 --- a/tests/testthat/test-assert_create.R +++ b/tests/testthat/test-assert_create.R @@ -123,10 +123,13 @@ cli::test_that_cli(configs = "plain", "created assertion() functions throw infor cli::test_that_cli(configs = "plain", "assert_create edge case errors", { # Function has dots - expect_no_error(assert_create(func = function(a, b, ...){ FALSE }, default_error_msg = "error")) + expect_no_error(assert_create(func = function(a, b, ...){ FALSE })) # Function has dots but no other arguments - expect_error(assert_create(func = function( ...){ FALSE }, default_error_msg = "error"), regexp = "must have at least 1 paramater.*Note '\\.\\.\\.' does NOT count as an argument") + expect_error(assert_create(func = function( ...){ FALSE }), regexp = "must have at least 1 paramater.*Note '\\.\\.\\.' does NOT count as an argument") + + # Function has names that clash with those assert_create adds to all assertions + expect_error(assert_create(func = function(msg){ FALSE }), regexp = "cannot include paramaters named 'msg', 'call', or 'arg_name", fixed=TRUE) }) From d6f694cfb02fba065b2b7a5c9bfd545dfa40c6b0 Mon Sep 17 00:00:00 2001 From: Sam El-Kamand Date: Wed, 13 Nov 2024 16:28:31 +1100 Subject: [PATCH 10/12] fix: improved unit testing of assert_create_chain --- tests/testthat/test-assert_create.R | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) diff --git a/tests/testthat/test-assert_create.R b/tests/testthat/test-assert_create.R index 3f7f448..0b2c4cd 100644 --- a/tests/testthat/test-assert_create.R +++ b/tests/testthat/test-assert_create.R @@ -131,6 +131,9 @@ cli::test_that_cli(configs = "plain", "assert_create edge case errors", { # Function has names that clash with those assert_create adds to all assertions expect_error(assert_create(func = function(msg){ FALSE }), regexp = "cannot include paramaters named 'msg', 'call', or 'arg_name", fixed=TRUE) + # arg_name is not a string + assertion <- assert_create(func = function(a){ FALSE }, default_error_msg = "{arg_name} is ignored - this function always throws an error") + expect_error(assertion(a, arg_name = 2), regexp = "arg_name must be a string, not a numeric") }) @@ -145,6 +148,26 @@ cli::test_that_cli(configs = "plain", "assertion chains can evaluate expressions expect_error(assert_chain(length(y)), regexp = "length(y) must be a character", fixed = TRUE) }) +cli::test_that_cli(configs = "plain", "Common assert_create_chain errors", { + + # Throws error if argument given to assert_create_chain is not a function + expect_error(assert_create_chain( + 2, + assert_create(is.numeric, "{arg_name} must be numeric") + ), regexp = "Input to assert_create_chain must must be functions created by `assert_create()`", fixed=TRUE) + + # Throws error a function doesn't have the required arguments (x, msg & call( + expect_error(assert_create_chain( + function(x, msg, notcall){}, + assert_create(is.numeric, "{arg_name} must be numeric") + ), regexp = "Input to assert_create_chain must must be functions created by `assert_create()`", fixed=TRUE) + + # Throws error if functions have less than 4 args (some_obj_to_test and officially required functions: msg, call, arg_name) + expect_error(assert_create_chain( + function(x, msg, call){}, # 3 args only + assert_create(is.numeric, "{arg_name} must be numeric") + ), regexp = "Input to assert_create_chain must must be functions created by `assert_create()`", fixed=TRUE) +}) cli::test_that_cli(configs = "plain", "assert_create_chain: user supplied custom error message has access to the environment in which it was called", { assert_chain<- assert_create_chain( From fe4fe76e8777e2494cf29f411cef7cdb852feaa7 Mon Sep 17 00:00:00 2001 From: Sam El-Kamand Date: Wed, 13 Nov 2024 16:34:39 +1100 Subject: [PATCH 11/12] fix: comments no longer lie about required args test updated to actually test arg count failure --- R/assert_create.R | 2 +- tests/testthat/test-assert_create.R | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/assert_create.R b/R/assert_create.R index a5ca918..9e64ec7 100644 --- a/R/assert_create.R +++ b/R/assert_create.R @@ -204,7 +204,7 @@ assert_create_chain <- function(...){ )) } - # Check functions all have the required arguments (x, msg & call) + # Check functions all have the required arguments (msg, call and arg_name) if(!all(vapply(dot_args, function(f){ all(c('msg', 'call', 'arg_name') %in% func_arg_names(f)) }, FUN.VALUE = logical(1)))){ cli::cli_abort( c("Input to {.strong assert_create_chain} must must be {.strong functions} created by {.strong `assert_create()`}", diff --git a/tests/testthat/test-assert_create.R b/tests/testthat/test-assert_create.R index 0b2c4cd..c3234af 100644 --- a/tests/testthat/test-assert_create.R +++ b/tests/testthat/test-assert_create.R @@ -156,15 +156,15 @@ cli::test_that_cli(configs = "plain", "Common assert_create_chain errors", { assert_create(is.numeric, "{arg_name} must be numeric") ), regexp = "Input to assert_create_chain must must be functions created by `assert_create()`", fixed=TRUE) - # Throws error a function doesn't have the required arguments (x, msg & call( + # Throws error a function doesn't have the required arguments (msg, call and arg_name) expect_error(assert_create_chain( - function(x, msg, notcall){}, + function(x, msg, arg_name, notcall){}, assert_create(is.numeric, "{arg_name} must be numeric") ), regexp = "Input to assert_create_chain must must be functions created by `assert_create()`", fixed=TRUE) # Throws error if functions have less than 4 args (some_obj_to_test and officially required functions: msg, call, arg_name) expect_error(assert_create_chain( - function(x, msg, call){}, # 3 args only + function(msg, call, arg_name){}, # 3 args only assert_create(is.numeric, "{arg_name} must be numeric") ), regexp = "Input to assert_create_chain must must be functions created by `assert_create()`", fixed=TRUE) }) From 31ed56bf4f0ad2a0c14167625679c2414a55893a Mon Sep 17 00:00:00 2001 From: Sam El-Kamand Date: Wed, 13 Nov 2024 16:37:13 +1100 Subject: [PATCH 12/12] fix: dropped unnecessary function mocking --- tests/testthat/test-assert_functions.R | 12 ------------ 1 file changed, 12 deletions(-) diff --git a/tests/testthat/test-assert_functions.R b/tests/testthat/test-assert_functions.R index e1f1ac2..3f91c31 100644 --- a/tests/testthat/test-assert_functions.R +++ b/tests/testthat/test-assert_functions.R @@ -1,17 +1,5 @@ # Test Underlying Functions ----------------------------------------------- -func_arg_count <- function(f, dots = "throw_error") { - args <- formals(f) - if ("..." %in% names(args)) { - switch(dots, - throw_error = stop("Function should not contain ... arguments"), - count_as_0 = return(length(args) - 1), - count_as_1 = return(length(args)), - count_as_inf = return(Inf)) - } - return(length(args)) -} - # Define some test functions for validation fn_0_args <- function() {} fn_1_arg <- function(a) {}