From 9ae3f1f9824f1462086f6b6e825343592a41a396 Mon Sep 17 00:00:00 2001 From: Marco Colombo Date: Thu, 5 Dec 2024 17:12:32 +0100 Subject: [PATCH] Improve validation against an Risoe.BINfileData object. --- R/import_Data.R | 2 ++ R/merge_RLum.Analysis.R | 1 + R/merge_RLum.Data.Curve.R | 2 ++ R/merge_RLum.Data.Spectrum.R | 2 ++ tests/testthat/test_import_Data.R | 2 ++ tests/testthat/test_merge_RLum.Analysis.R | 8 ++------ tests/testthat/test_merge_RLum.Data.Curve.R | 2 ++ tests/testthat/test_merge_RLum.Data.Spectrum.R | 2 ++ 8 files changed, 15 insertions(+), 6 deletions(-) diff --git a/R/import_Data.R b/R/import_Data.R index 341ee39e1..fcd90617d 100644 --- a/R/import_Data.R +++ b/R/import_Data.R @@ -44,6 +44,8 @@ import_Data <- function ( .set_function_name("import_Data") on.exit(.unset_function_name(), add = TRUE) + .validate_class(file, c("character", "list")) + ## supported functions are extracted automatically from the package ## namespace so that we don't have to maintain this list manually fun <- grep("^read_", getNamespaceExports("Luminescence"), value = TRUE) diff --git a/R/merge_RLum.Analysis.R b/R/merge_RLum.Analysis.R index bd2623671..1472c7798 100644 --- a/R/merge_RLum.Analysis.R +++ b/R/merge_RLum.Analysis.R @@ -57,6 +57,7 @@ merge_RLum.Analysis<- function( ## Integrity checks ------------------------------------------------------- + .validate_class(objects, "list") .validate_not_empty(objects) ##check if object is of class RLum diff --git a/R/merge_RLum.Data.Curve.R b/R/merge_RLum.Data.Curve.R index 6a153e237..75caa328a 100644 --- a/R/merge_RLum.Data.Curve.R +++ b/R/merge_RLum.Data.Curve.R @@ -125,6 +125,8 @@ merge_RLum.Data.Curve<- function( ## Integrity checks ------------------------------------------------------- + .validate_class(object, "list") + ##(1) check if object is of class RLum.Data.Curve num.objects <- length(object) temp.recordType.test <- sapply(object, function(x) { diff --git a/R/merge_RLum.Data.Spectrum.R b/R/merge_RLum.Data.Spectrum.R index 1de49d336..bdbcbf371 100644 --- a/R/merge_RLum.Data.Spectrum.R +++ b/R/merge_RLum.Data.Spectrum.R @@ -125,6 +125,8 @@ merge_RLum.Data.Spectrum <- function( ## Integrity checks ------------------------------------------------------- + .validate_class(object, "list") + ## check if object is of a supported RLum.Data class num.objects <- length(object) temp.recordType.test <- sapply(object, function(x) { diff --git a/tests/testthat/test_import_Data.R b/tests/testthat/test_import_Data.R index bd7ab7615..43b894985 100644 --- a/tests/testthat/test_import_Data.R +++ b/tests/testthat/test_import_Data.R @@ -1,6 +1,8 @@ test_that("input validation", { testthat::skip_on_cran() + expect_error(import_Data(data.frame()), + "'file' should be of class 'character' or 'list'") expect_message(import_Data(system.file("extdata/QNL84_2_bleached.txt")), "Unknown file format, nothing imported") }) diff --git a/tests/testthat/test_merge_RLum.Analysis.R b/tests/testthat/test_merge_RLum.Analysis.R index 0ede3b04d..33a74daf6 100644 --- a/tests/testthat/test_merge_RLum.Analysis.R +++ b/tests/testthat/test_merge_RLum.Analysis.R @@ -7,15 +7,11 @@ test_that("input validation", { r1 <- as(object = list(1:10), Class = "RLum.Results") expect_error(merge_RLum.Analysis(), - "is missing, with no default") + "'objects' should be of class 'list'") expect_error(merge_RLum.Analysis(o1), - "At least one input object in the list has to be of class") + "'objects' should be of class 'list'") expect_error(merge_RLum.Analysis(list()), "'objects' cannot be an empty list") - expect_error(merge_RLum.Analysis(set_RLum("RLum.Analysis")), - "'objects' cannot be an empty RLum.Analysis") - expect_error(merge_RLum.Analysis(set_RLum("RLum.Data.Image")), - "At least one input object in the list has to be of class") expect_error(merge_RLum.Analysis(list(c1)), "At least one input object in the list has to be of class") expect_error(merge_RLum.Analysis(list(o1, "test")), diff --git a/tests/testthat/test_merge_RLum.Data.Curve.R b/tests/testthat/test_merge_RLum.Data.Curve.R index 4441f84cd..2f47de500 100644 --- a/tests/testthat/test_merge_RLum.Data.Curve.R +++ b/tests/testthat/test_merge_RLum.Data.Curve.R @@ -19,6 +19,8 @@ test_that("input validation", { testthat::skip_on_cran() expect_error(merge_RLum.Data.Curve("", merge.method = "/"), + "'object' should be of class 'list'") + expect_error(merge_RLum.Data.Curve(list("")), "All elements of 'object' should be of class 'RLum.Data.Curve'") expect_error(merge_RLum.Data.Curve(list(), merge.method = "/"), "'object' contains no data") diff --git a/tests/testthat/test_merge_RLum.Data.Spectrum.R b/tests/testthat/test_merge_RLum.Data.Spectrum.R index 39398bfaa..0178c8699 100644 --- a/tests/testthat/test_merge_RLum.Data.Spectrum.R +++ b/tests/testthat/test_merge_RLum.Data.Spectrum.R @@ -13,6 +13,8 @@ test_that("input validation", { testthat::skip_on_cran() expect_error(merge_RLum.Data.Spectrum("error", merge.method = "/"), + "'object' should be of class 'list'") + expect_error(merge_RLum.Data.Spectrum(list("error")), "All elements of 'object' should be of class 'RLum.Data.Spectrum'") expect_error(merge_RLum.Data.Spectrum(list(), merge.method = "-"), "'object' contains no data")