Merge pull request #516 from R-Lum/issue_515

Improve validation against an Risoe.BINfileData object [skip ci]
R-Lum · Dec 5, 2024 · d83f86c · d83f86c
2 parents 5013c5c + 9ae3f1f
commit d83f86c
Show file tree

Hide file tree

Showing 8 changed files with 15 additions and 6 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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")