tests/testthat/test_internals.R

In Luminescence: Comprehensive Luminescence Dating Data Analysis

test_that("Test internals", {
  testthat::skip_on_cran()

  ## since below we are testing internal functions that use `.throw_error()`
  ## and `.throw_warning()`, we need to treat this block as a function
  ## definition and set the function name
  .set_function_name("test")
  on.exit(.unset_function_name(), add = TRUE)

  # .expand_parameters() ------------------------------------------------------
  ##create empty function ... reminder
  ##this is an internal function, the first object is always discarded, it
  ##might be a list of RLum.Analysis objects is might be super large
  f <- function(object, a, b = 1, c = list(), d = NULL) {
    Luminescence:::.expand_parameters(len = 3)
  }

  ##test some functions
  ##missing arguments must be identified
  expect_error(f(), "Argument 'a' missing, with no default")

  ##check whether the objects are properly recycled
  expect_type(f(object, a = 1), "list")
  expect_length(f(object, a = 1, c = list(a = 1, b = 2, c = 3))$c, 3)
  expect_length(f(object, a = (1), c = list(a = 1, b = 2, c = 3))$c, 3)
  expect_equal(f(object, a = (1 + 10), c = list(a = 1, b = 2, c = 3))$a[[1]], 11)

  # .calc_HPDI() ------------------------------------------------------------
  set.seed(1234)
  test <- expect_type(Luminescence:::.calc_HPDI(rnorm(100), plot = TRUE), "double")
  expect_equal(round(sum(test),2), 0.20, tolerance = 1)

  ##create a case where the value cannot be calculated
  expect_type(.calc_HPDI(rlnorm(n = 100, meanlog = 10, sdlog = 100)), type = "logical")

  ## .warningCatcher() ------------------------------------------------------
  expect_warning(Luminescence:::.warningCatcher(for(i in 1:5) {
                                                  warning("message 1")
                                                  if (i %% 2 == 0)
                                                    warning("message 2")
                                                  if (i %% 3 == 0)
                                                    warning("message 3")
                                                }),
                 paste(c("(1) message 1 [5 times]",
                         "(2) message 2 [2 times]",
                         "(3) message 3"), collapse = "\n"),
                 fixed = TRUE)
  expect_warning(Luminescence:::.warningCatcher(warning("single message")),
                 "single message")

  # .smoothing ----------------------------------------------------------------------------------
  expect_silent(Luminescence:::.smoothing(runif(100), k = 5, method = "median"))
  expect_silent(.smoothing(runif(200), method = "median"))
  expect_silent(.smoothing(runif(100), k = 4, method = "mean"))
  expect_silent(.smoothing(runif(100), k = 4, method = "median"))
  expect_equal(.smoothing(c(1, 1, 2, 50, 0, 2, 1, 2, 0, 1, 50),
                          method = "Carter"),
               c(1, 1, 2, 1, 0, 2, 1, 2, 0, 1, NA))
  expect_equal(.smoothing(c(1, 1, 2, 50, 0, 2, 1, 2, 0, 1, 50),
                          method = "Carter", fill = 0),
               c(1, 1, 2, 1, 0, 2, 1, 2, 0, 1, 0))
  expect_equal(.smoothing(c(1, 1, 2, 50, 0, 2, 1, 2, 0, 1, 50) * 10,
                          method = "Carter", p_acceptance = 1e-30),
               c(10, 10, 20, 17, 17, 20, 10, 20, 13, 10, NA))
  expect_error(.smoothing(c(1, 1, 2, 50, 0, 2, 1, 2, 0, 1, 50),
                          method = "Carter", p_acceptance = 0.5),
               "'p_acceptance' rejects all counts, set it to a smaller value")
  expect_error(.smoothing(runif(100), k = integer()),
               "'k' should be a single positive integer value or NULL")
  expect_error(.smoothing(runif(100), fill = numeric()),
               "'fill' should be of class 'numeric' or NA and have length 1")
  expect_error(.smoothing(runif(100), fill = matrix()),
               "'fill' should be of class 'numeric' or NA and have length 1")
  expect_error(.smoothing(runif(100), method = "error"),
               "'method' should be one of 'mean', 'median' or")
  expect_error(.smoothing(runif(100), align = "error"),
               "'align' should be one of 'right', 'center' or 'left'")
  expect_error(.smoothing(runif(100), p_acceptance = "error"),
               "'p_acceptance' should be a single positive value")

  ## .weighted.median() -----------------------------------------------------
  expect_equal(.weighted.median(1:10, w = rep(1, 10)),
               median(1:10))
  expect_equal(.weighted.median(1:10, w = c(1:9, Inf)),
               NA_real_)
  expect_equal(.weighted.median(1:10, w = c(NaN, 2:10)),
               NA_real_)
  expect_equal(.weighted.median(1:5, w = c(0.15, 0.1, 0.2, 0.3, 0.25)),
               4)
  expect_equal(.weighted.median(c(1:5, NA), w = c(0.15, 0.1, 0.2, 0.3, 0.25, 1)),
               NA_real_)
  expect_equal(.weighted.median(c(1:5, NA), w = c(0.15, 0.1, 0.2, 0.3, 0.25, 1),
                                na.rm = TRUE),
               4)

  ## .normalise_curve() -----------------------------------------------------
  ## vector
  data <- runif(100)
  expect_equal(data, .normalise_curve(data, FALSE))
  expect_equal(.normalise_curve(data, TRUE), .normalise_curve(data, "max"))
  expect_silent(.normalise_curve(data, "min"))
  expect_silent(.normalise_curve(data, "first"))
  expect_silent(.normalise_curve(data, "last"))
  expect_silent(.normalise_curve(data, "huot"))
  expect_silent(.normalise_curve(data, "intensity"))
  expect_silent(.normalise_curve(data, 2.2))

  ## check for matrix
  m <- matrix(runif(10), ncol = 2)
  expect_equal(m, .normalise_curve(m, FALSE))
  expect_equal(.normalise_curve(m, TRUE), .normalise_curve(m, "max"))
  expect_silent(.normalise_curve(m, "min"))
  expect_silent(.normalise_curve(m, "first"))
  expect_true(is.matrix(.normalise_curve(m, "last")))
  expect_silent(.normalise_curve(m, "huot"))
  expect_silent(.normalise_curve(m, "intensity"))
  expect_silent(.normalise_curve(m, 2.2))

  data[100] <- 0
  expect_warning(.normalise_curve(data, "last"),
                 "Curve normalisation produced Inf/NaN values, values replaced")
  expect_warning(.normalise_curve(data, "min"),
                 "Curve normalisation produced Inf/NaN values, values replaced")

  data[99] <- NA_real_
  ## this will produce warnings, but still normalise, because
  ## we use na.rm internally for max(), min() etc.
  expect_equal(
    suppressWarnings(.normalise_curve(data, TRUE)),
    suppressWarnings(.normalise_curve(data, "max")))
  expect_warning(.normalise_curve(data, "last"),
                 "Curve normalisation produced Inf/NaN values, values replaced")
  expect_warning(.normalise_curve(data, "huot"),
                 "Curve normalisation produced Inf/NaN values, values replaced")
  expect_warning(.normalise_curve(data, "min"),
                 "Curve normalisation produced Inf/NaN values, values replaced")
  expect_warning(.normalise_curve(data, 2),
                 "Curve normalisation produced Inf/NaN values, values replaced")

  # fancy_scientific ()--------------------------------------------------------------------------
  plot(seq(1e10, 1e20, length.out = 10),1:10, xaxt = "n")
  expect_silent(axis(1, at = axTicks(1),labels = Luminescence:::fancy_scientific(axTicks(1))))

  # .add_fancy_log_axis() -----------------------------------------------------
  y <- c(0.1, 0.001, 0.0001)
  plot(1:length(y), y, yaxt = "n", log = "y")
  expect_silent(Luminescence:::.add_fancy_log_axis(side = 2, las = 1))
  expect_null(.add_fancy_log_axis(side = 1, las = 1))

  ## .text_with_bg() --------------------------------------------------------
  expect_silent(.text_with_bg(x = 2, y = 0.1, label = "pos = NULL", pos = NULL))
  expect_silent(.text_with_bg(x = 2, y = 0.01, label = "pos = 1", pos = 1))
  expect_silent(.text_with_bg(x = 2, y = 0.01, label = "pos = 2", pos = 2))
  expect_silent(.text_with_bg(x = 2, y = 0.01, label = "pos = 3", pos = 3))
  expect_silent(.text_with_bg(x = 2, y = 0.01, label = "pos = 4", pos = 4))

  # .get_keyword_coordinates() ----------------------------------------------
  xlim <- c(0, 5)
  ylim <- c(2, 10)
  coords <- .get_keyword_coordinates(xlim = xlim, ylim = ylim)
  expect_type(coords, "list")
  expect_named(coords, c("pos", "adj"))
  expect_length(coords, 2)
  expect_equal(coords$pos,
               c(0, 10))
  expect_equal(.get_keyword_coordinates(pos = c(1, 2), xlim, ylim)$pos,
               c(1, 2))
  expect_equal(.get_keyword_coordinates(pos = "topleft", xlim, ylim)$pos,
               c(0, 10))
  expect_equal(.get_keyword_coordinates(pos = "top", xlim, ylim)$pos,
               c(2.5, 10))
  expect_equal(.get_keyword_coordinates(pos = "topright", xlim, ylim)$pos,
               c(5, 10))
  expect_equal(.get_keyword_coordinates(pos = "left", xlim, ylim)$pos,
               c(0, 6))
  expect_equal(.get_keyword_coordinates(pos = "center", xlim, ylim)$pos,
               c(2.5, 6))
  expect_equal(.get_keyword_coordinates(pos = "right", xlim, ylim)$pos,
               c(5, 6))
  expect_equal(.get_keyword_coordinates(pos = "bottomleft", xlim, ylim)$pos,
               c(0, 2))
  expect_equal(.get_keyword_coordinates(pos = "bottom", xlim, ylim)$pos,
               c(2.5, 2))
  expect_equal(.get_keyword_coordinates(pos = "bottomright", xlim, ylim)$pos,
               c(5, 2))

  # .create_StatisticalSummaryText() ------------------------------------------------------------
  stats <- calc_Statistics(data.frame(1:10,1:10))
  expect_equal(Luminescence:::.create_StatisticalSummaryText(),
               "")
  expect_equal(.create_StatisticalSummaryText(stats, keywords = ""),
               "")
  expect_equal(.create_StatisticalSummaryText(stats, keywords = "nonexisting"),
               "")
  expect_equal(.create_StatisticalSummaryText(stats,
                                              keywords = "mean"),
               "mean = 5.5")
  expect_equal(.create_StatisticalSummaryText(stats,
                                              keywords = "unweighted$mean"),
               "mean = 5.5")
  expect_equal(.create_StatisticalSummaryText(stats,
                                              keywords = "weighted$mean"),
               "mean = 1.89")


  # .unlist_RLum() ------------------------------------------------------------------------------
  expect_length(Luminescence:::.unlist_RLum(list(a = list(b = list(c = list(d = 1, e = 2))))), 2)

  # .rm_nonRLum() -----------------------------------------------------------
  expect_type(
    Luminescence:::.rm_nonRLum(c(list(set_RLum("RLum.Analysis"), set_RLum("RLum.Analysis")), 2)),
    "list")
  expect_type(
    Luminescence:::.rm_nonRLum(
      c(list(set_RLum("RLum.Analysis"), set_RLum("RLum.Analysis")), 2), class = "RLum.Analysis"),
    "list")

  ## regression test for issue 907
  expect_length(Luminescence:::.rm_nonRLum(list(matrix(iris)), "RLum.Analysis"),
                0)

  # .rm_NULL_elements() -----------------------------------------------------------
  expect_type(.rm_NULL_elements(list("a", NULL)),
    "list")
  t <- expect_type(.rm_NULL_elements(list(NULL, NULL)),
              "list")
  expect_length(t, 0)

  # .rm_unnamed_elements() --------------------------------------------------
  expect_equal(.rm_unnamed_elements(list(a = "a", b = "b")),
               list(a = "a", b = "b"))
  expect_equal(.rm_unnamed_elements(list(a = "a", b = NULL, 3, 4, c = 5)),
               list(a = "a", b = NULL, c = 5))
  expect_null(.rm_unnamed_elements(list("a", NULL)))
  expect_null(.rm_unnamed_elements(list()))

  # .matrix_binning() ---------------------------------------------------------------------------
  m <- matrix(data = c(rep(1:20, each = 20)), ncol = 20, nrow = 20)
  rownames(m) <- 1:nrow(m)
  colnames(m) <- 1:ncol(m)

    ##crash the function
    expect_error(Luminescence:::.matrix_binning("none matrix"),
                 "'m' should be of class 'matrix'")

    ##test operation modes and arguments
    expect_type(Luminescence:::.matrix_binning(m, bin_size = 4, bin_col = FALSE), "integer")
    expect_type(Luminescence:::.matrix_binning(m, bin_size = 4, bin_col = TRUE), "integer")

    ##test row / column renaming options
    expect_type(Luminescence:::.matrix_binning(m, bin_size = 2, bin_col = FALSE, names = "groups"),
              "integer")
    expect_type(Luminescence:::.matrix_binning(m, bin_size = 2, bin_col = FALSE, names = "mean"),
             "integer")
    expect_type(Luminescence:::.matrix_binning(m, bin_size = 2, bin_col = FALSE, names = "sum"),
             "integer")
    expect_type(Luminescence:::.matrix_binning(m, bin_size = 2, bin_col = FALSE, names = c("test1", "test2")),
              "integer")

    ##clean-up
    rm(m)

  # .download_file() --------------------------------------------------------

  ## returns just NULL (no URL detected)
  expect_null(.download_file(url = "_url"))
  expect_null(.download_file(url = "https://"))
  expect_null(.download_file(url = "_https://github.com"))

  ## attempts download but fails
  url.404 <- "https://raw.githubusercontent.com/R-Lum/rxylib/master/inst/extg"
  expect_message(
          expect_message(expect_equal(.download_file(url = url.404), NA),
                         "Downloading"),
      "FAILED")

  ## attempts download and succeeds
  url.ok <- "https://raw.githubusercontent.com/R-Lum/rxylib/master/codecov.yml"
  destfile <- tempfile()
  SW({
  expect_message(expect_equal(.download_file(url = url.ok, destfile),
                              destfile),
                 "OK")
  expect_message(.download_file(url = paste("  ", url.ok, "\n")),
                 "OK")
  })

  ## .throw_error() ---------------------------------------------------------
  fun.int <- function() {
    .set_function_name("fun.int")
    on.exit(.unset_function_name(), add = TRUE)
    .throw_error("Error message")
  }
  fun.ext <- function() fun.int()
  fun.docall <- function() do.call(fun.ext, args = list())
  fun.docall_do <- function() fun.docall()
  expect_error(fun.int(),
               "[fun.int()] Error message", fixed = TRUE)
  expect_error(fun.ext(),
               "[fun.int()] Error message", fixed = TRUE)
  expect_error(fun.docall(),
               "[fun.int()] Error message", fixed = TRUE)
  expect_error(fun.docall_do(),
               "[fun.int()] Error message", fixed = TRUE)

  ## .throw_warning() -------------------------------------------------------
  fun.int <- function() {
    .set_function_name("fun.int")
    on.exit(.unset_function_name(), add = TRUE)
    .throw_warning("Warning message")
  }
  fun.ext <- function() fun.int()
  fun.docall <- function() do.call(fun.ext, args = list())
  fun.docall_do <- function() fun.docall()
  expect_warning(fun.int(),
                 "[fun.int()] Warning message", fixed = TRUE)
  expect_warning(fun.ext(),
                 "[fun.int()] Warning message", fixed = TRUE)
  expect_warning(fun.docall(),
                 "[fun.int()] Warning message", fixed = TRUE)
  expect_warning(fun.docall_do(),
                 "[fun.int()] Warning message", fixed = TRUE)

  ## .throw_message() -------------------------------------------------------
  fun.int <- function(error = TRUE) {
    .set_function_name("fun.int")
    on.exit(.unset_function_name(), add = TRUE)
    .throw_message("Simple message", error = error)
  }
  fun.ext <- function(error = TRUE) fun.int(error)
  fun.docall <- function(error = TRUE) do.call(fun.ext, args = list(error = error))
  fun.docall_do <- function(error = TRUE) fun.docall(error)
  expect_message(fun.int(),
                 "[fun.int()] Error: Simple message", fixed = TRUE)
  expect_message(fun.ext(),
                 "[fun.int()] Error: Simple message", fixed = TRUE)
  expect_message(fun.docall(),
                 "[fun.int()] Error: Simple message", fixed = TRUE)
  expect_message(fun.docall_do(),
                 "[fun.int()] Error: Simple message", fixed = TRUE)
  expect_message(fun.int(error = FALSE),
                 "[fun.int()] Simple message", fixed = TRUE)
  expect_message(fun.ext(error = FALSE),
                 "[fun.int()] Simple message", fixed = TRUE)
  expect_message(fun.docall(error = FALSE),
                 "[fun.int()] Simple message", fixed = TRUE)
  expect_message(fun.docall_do(error = FALSE),
                 "[fun.int()] Simple message", fixed = TRUE)

  ## .deprecated() ----------------------------------------------------------
  expect_warning(.deprecated("old", "new", "1.0"),
                 "'old' was deprecated in v1.0, use 'new' instead")
  expect_warning(.deprecated(c("old1", "old2"), c("new1", "new2"), "1.0"),
                 "'old1' and 'old2' were deprecated in v1.0, use 'new1' and 'new2' instead")

  ## SW() ------------------------------------------------------------------
  expect_silent(SW(cat("silenced message")))
  expect_silent(SW(message("silenced message")))
  expect_silent(SW(warning("silenced message")))
  expect_silent(SW(.throw_warning("silenced message")))
  expect_error(SW(stop("error message")),
               "error message")
  expect_error(SW(.throw_error("error message")),
               "error message")

  ## .validate_args() -------------------------------------------------------
  fun1 <- function(arg) {
    .validate_args(arg, c("val1", "val2", "val3"), null.ok = TRUE)
  }
  expect_silent(fun1(NULL))
  expect_equal(fun1(arg = "val1"), "val1")
  expect_equal(fun1(arg = c("val1", "val2")), "val1")
  expect_equal(fun1(arg = c("val3", "val2")), "val3")
  expect_equal(.validate_args(matrix(letters), c("reciprocal", "square")),
               "reciprocal")
  expect_error(fun1(arg = c("error", "val1")),
               "[test()] 'arg' contains multiple values but not all of them",
               fixed = TRUE)
  expect_error(fun1(arg = "error"),
               "[test()] 'arg' should be one of 'val1', 'val2', 'val3' or NULL",
               fixed = TRUE)
  expect_error(fun1(set_RLum("RLum.Data.Curve")),
               "'arg' should be one of 'val1', 'val2', 'val3' or NULL")
  expect_error(fun1(set_RLum("RLum.Data.Curve", data = matrix(1:10, ncol = 2))),
               "'arg' should be one of 'val1', 'val2', 'val3' or NULL")

  fun2 <- function(arg = c("val1", "val2", "val3")) {
    .validate_args(arg, c("val1", "val2", "val3"), name = "'other_name'")
  }
  expect_equal(fun2(), "val1")
  expect_error(fun2(arg = NULL),
               "[test()] 'other_name' should be one of 'val1', 'val2' or 'val3'",
               fixed = TRUE)
  expect_error(fun2(arg = "error"),
               "[test()] 'other_name' should be one of 'val1', 'val2' or 'val3'",
               fixed = TRUE)

  fun3 <- function(arg) {
    .validate_args(arg, c("val1", "val2"),
                   extra = "'other.val'", null.ok = FALSE)
  }
  expect_error(fun3(arg = "error"),
               "[test()] 'arg' should be one of 'val1', 'val2' or 'other.val'",
               fixed = TRUE)

  fun4 <- function(arg) {
    .validate_args(arg, c("val1", "val2"),
                   extra = "'other.val'", null.ok = TRUE)
  }
  expect_error(fun4(arg = "error"),
               "[test()] 'arg' should be one of 'val1', 'val2', 'other.val' or NULL",
               fixed = TRUE)

  fun.err <- function(arg) {
    .validate_args(arg)
  }
  expect_error(fun.err("val1"),
               "is missing, with no default")

  ## .validate_class() ------------------------------------------------------
  fun1 <- function(arg) {
    .validate_class(arg, "data.frame")
  }
  fun2 <- function(arg) {
    .validate_class(arg, "data.frame", null.ok = TRUE)
  }
  fun3 <- function(arg) {
    .validate_class(arg, "data.frame", throw.error = FALSE)
  }
  expect_true(fun1(iris))
  expect_true(fun2(NULL))
  expect_true(.validate_class(iris, c("data.frame", "integer")))
  expect_true(.validate_class(iris, c("data.frame", "integer"),
                              throw.error = FALSE))
  expect_true(.validate_class(1:3, "integer", length = c(2, 3)))
  expect_warning(expect_false(.validate_class(arg <- NULL, "data.frame",
                                   throw.error = FALSE)),
      "'arg' should be of class 'data.frame'")
  expect_error(fun1(),
               "'arg' should be of class 'data.frame'")
  expect_error(fun2(),
               "'arg' should be of class 'data.frame' or NULL")
  expect_error(fun1(NULL),
               "'arg' should be of class 'data.frame'")
  expect_error(.validate_class(test <- 1:5),
               "is missing, with no default")
  expect_error(.validate_class(test <- 1:5, "data.frame"),
               "'test' should be of class 'data.frame'")
  expect_error(.validate_class(test <- 1:5, "data.frame", length = 2),
               "'test' should be of class 'data.frame' and have length 2")
  expect_error(.validate_class(test <- 1:5, "data.frame", length = 1:2),
               "'test' should be of class 'data.frame' and have length 1 or 2")
  expect_error(.validate_class(test <- 1:5, c("list", "data.frame", "numeric")),
               "'test' should be of class 'list', 'data.frame' or 'numeric'")
  expect_error(.validate_class(test <- 1:5, c("list", "data.frame")),
               "'test' should be of class 'list' or 'data.frame'")
  expect_error(.validate_class(test <- 1:5, c("list", "data.frame"),
                               extra = "another type"),
               "'test' should be of class 'list', 'data.frame' or another")
  expect_error(.validate_class(test <- 1:5, c("list", "data.frame"),
                               name = "'other_name'"),
               "'other_name' should be of class 'list' or 'data.frame'")
  expect_warning(fun3(),
                 "'arg' should be of class 'data.frame'")

  ## .validate_not_empty() --------------------------------------------------
  expect_true(.validate_not_empty(letters, "vector"))

  expect_error(.validate_not_empty(test <- c(), "vector"),
               "'test' cannot be an empty vector")
  expect_error(.validate_not_empty(test <- list()),
               "'test' cannot be an empty list")
  expect_error(.validate_not_empty(test <- numeric(0)),
               "'test' cannot be an empty numeric")
  expect_error(.validate_not_empty(test <- data.frame()),
               "'test' cannot be an empty data.frame")
  expect_error(.validate_not_empty(iris[0, ]),
               "'iris' cannot be an empty data.frame")
  expect_error(.validate_not_empty(iris[, 0]),
               "'iris' cannot be an empty data.frame")
  expect_error(.validate_not_empty(test <- matrix(NA, 0, 5)),
               "'test' cannot be an empty matrix")
  expect_error(.validate_not_empty(test <- matrix(NA, 5, 0)),
               "'test' cannot be an empty matrix")
  expect_error(.validate_not_empty(test <- set_RLum("RLum.Analysis")),
               "'test' cannot be an empty RLum.Analysis")
  expect_error(.validate_not_empty(list(), "list", name = "'other_name'"),
               "'other_name' cannot be an empty list")
  expect_warning(expect_false(.validate_not_empty(test <- list(), "list",
                                                  throw.error = FALSE)),
                 "'test' cannot be an empty list")

  ## .validate_length() -----------------------------------------------------
  expect_true(.validate_length(letters, 26))
  expect_error(.validate_length(letters),
               "is missing, with no default")
  expect_error(.validate_length(letters, 25),
               "'letters' should have length 25")
  expect_error(.validate_length(letters, 25, name = "'other_name'"),
               "'other_name' should have length 25")
  expect_warning(expect_false(.validate_length(letters, 25, throw.error = FALSE)),
                 "'letters' should have length 25")

  ## .validate_scalar() -----------------------------------------------------
  expect_equal(.validate_scalar(1.3),
               1.3)
  expect_equal(.validate_scalar(-2, int = TRUE),
               -2)
  expect_equal(.validate_scalar(Inf, inf = TRUE),
               Inf)
  expect_null(.validate_scalar(NULL, int = TRUE, null.ok = TRUE))

  expect_error(.validate_scalar(int = TRUE),
               "'NA' should be a single integer value")
  expect_error(.validate_scalar(test <- "a"),
               "'test' should be a single value")
  expect_error(.validate_scalar(test <- NULL),
               "'test' should be a single value")
  expect_error(.validate_scalar(iris),
               "'iris' should be a single value")
  expect_error(.validate_scalar(iris[, 1, drop = FALSE]),
               "'iris' should be a single value")
  expect_error(.validate_scalar(iris[1, 0, drop = FALSE]),
               "'iris' should be a single value")
  expect_error(.validate_scalar(iris, null.ok = TRUE),
               "'iris' should be a single value or NULL")
  expect_error(.validate_scalar(iris, extra = "something else"),
               "'iris' should be a single value or something else")
  expect_error(.validate_scalar(iris, extra = "something else", null.ok = TRUE),
               "'iris' should be a single value or something else or NULL")
  expect_error(.validate_scalar(array(1, c(1, 1, 0))),
               "'NA' should be a single value")
  expect_error(.validate_scalar(-1:2, name = "'var'"),
               "'var' should be a single value")
  expect_error(.validate_scalar(Inf, name = "'var'"),
               "'var' should be a single value")
  expect_error(.validate_scalar(Inf, int = TRUE, name = "'var'"),
               "'var' should be a single integer value")
  expect_error(.validate_scalar(.Machine$double.xmax, int = TRUE, name = "'var'"),
               "'var' should be a single integer value")
  expect_error(.validate_scalar(1.5, int = TRUE, name = "'var'"),
               "'var' should be a single integer value")
  expect_error(.validate_scalar(NA, int = TRUE, name = "The variable"),
               "The variable should be a single integer value")
  expect_error(.validate_scalar(-1:2, pos = TRUE, name = "'var'"),
               "'var' should be a single positive value")
  expect_error(.validate_scalar(-1:2, int = TRUE, pos = TRUE, name = "'var'"),
               "'var' should be a single positive integer value")

  ## .validate_positive_scalar() --------------------------------------------
  expect_equal(.validate_positive_scalar(1.3),
               1.3)
  expect_equal(.validate_positive_scalar(2, int = TRUE),
               2)
  expect_equal(.validate_positive_scalar(Inf, inf = TRUE),
               Inf)
  expect_null(.validate_positive_scalar(NULL, int = TRUE, null.ok = TRUE))

  expect_error(.validate_positive_scalar(int = TRUE),
               "'NA' should be a single positive integer value")
  expect_error(.validate_positive_scalar(test <- "a"),
               "'test' should be a single positive value")
  expect_error(.validate_positive_scalar(test <- NULL),
               "'test' should be a single positive value")
  expect_error(.validate_positive_scalar(iris),
               "'iris' should be a single positive value")
  expect_error(.validate_positive_scalar(iris, null.ok = TRUE),
               "'iris' should be a single positive value or NULL")
  expect_error(.validate_positive_scalar(iris, extra = "something else"),
               "'iris' should be a single positive value or something else")
  expect_error(.validate_positive_scalar(iris, extra = "something else", null.ok = TRUE),
               "'iris' should be a single positive value or something else or NULL")
  expect_error(.validate_positive_scalar(1:2, name = "'var'"),
               "'var' should be a single positive value")
  expect_error(.validate_positive_scalar(0, name = "'var'"),
               "'var' should be a single positive value")
  expect_error(.validate_positive_scalar(-1, name = "'var'"),
               "'var' should be a single positive value")
  expect_error(.validate_positive_scalar(Inf, int = TRUE, name = "'var'"),
               "'var' should be a single positive integer value")
  expect_error(.validate_positive_scalar(1.5, int = TRUE, name = "'var'"),
               "'var' should be a single positive integer value")
  expect_error(.validate_positive_scalar(NA, int = TRUE, name = "The variable"),
               "The variable should be a single positive integer value")

  ## .validate_nonnegative_scalar() -----------------------------------------
  expect_equal(.validate_nonnegative_scalar(0),
               0)
  expect_equal(.validate_nonnegative_scalar(2, int = TRUE),
               2)
  expect_equal(.validate_nonnegative_scalar(Inf, inf = TRUE),
               Inf)
  expect_null(.validate_nonnegative_scalar(NULL, int = TRUE, null.ok = TRUE))

  expect_error(.validate_nonnegative_scalar(int = TRUE),
               "'NA' should be a single non-negative integer value")
  expect_error(.validate_nonnegative_scalar(test <- "a"),
               "'test' should be a single non-negative value")
  expect_error(.validate_nonnegative_scalar(test <- NULL),
               "'test' should be a single non-negative value")
  expect_error(.validate_nonnegative_scalar(iris),
               "'iris' should be a single non-negative value")
  expect_error(.validate_nonnegative_scalar(iris, null.ok = TRUE),
               "'iris' should be a single non-negative value or NULL")
  expect_error(.validate_nonnegative_scalar(iris, extra = "something else"),
               "'iris' should be a single non-negative value or something else")
  expect_error(.validate_nonnegative_scalar(iris, extra = "something else", null.ok = TRUE),
               "'iris' should be a single non-negative value or something else or NULL")
  expect_error(.validate_nonnegative_scalar(1:2, name = "'var'"),
               "'var' should be a single non-negative value")
  expect_error(.validate_nonnegative_scalar(-1, name = "'var'"),
               "'var' should be a single non-negative value")
  expect_error(.validate_nonnegative_scalar(Inf, int = TRUE, name = "'var'"),
               "'var' should be a single non-negative integer value")
  expect_error(.validate_nonnegative_scalar(1.5, int = TRUE, name = "'var'"),
               "'var' should be a single non-negative integer value")
  expect_error(.validate_nonnegative_scalar(NA, int = TRUE, name = "The variable"),
               "The variable should be a single non-negative integer value")

  ## .validate_logical_scalar() ---------------------------------------------
  expect_equal(.validate_logical_scalar(TRUE),
               TRUE)
  expect_equal(.validate_logical_scalar(FALSE),
               FALSE)
  expect_null(.validate_logical_scalar(NULL, null.ok = TRUE))

  expect_error(.validate_logical_scalar(),
               "'NA' should be a single logical value")
  expect_error(.validate_logical_scalar(test <- "a"),
               "'test' should be a single logical value")
  expect_error(.validate_logical_scalar(test <- NULL),
               "'test' should be a single logical value")
  expect_error(.validate_logical_scalar(iris),
               "'iris' should be a single logical value")
  expect_error(.validate_logical_scalar(iris, null.ok = TRUE),
               "'iris' should be a single logical value or NULL")
  expect_error(.validate_logical_scalar(iris, extra = "something else"),
               "'iris' should be a single logical value or something else")
  expect_error(.validate_logical_scalar(iris, extra = "something else", null.ok = TRUE),
               "'iris' should be a single logical value or something else or NULL")
  expect_error(.validate_logical_scalar(c(TRUE, FALSE), name = "'var'"),
               "'var' should be a single logical value")
  expect_error(.validate_logical_scalar(0, name = "'var'"),
               "'var' should be a single logical value")
  expect_error(.validate_logical_scalar(NA, name = "The variable"),
               "The variable should be a single logical value")

  ## .validate_position() ---------------------------------------------------
  expect_equal(.validate_position("topleft"),
               "topleft")
  expect_equal(.validate_position(c("left", "right")),
               "left")
  expect_equal(.validate_position("sub", sub = TRUE),
               "sub")
  expect_equal(.validate_position(c(1, 2)),
               c(1, 2))
  expect_error(.validate_position("sub"),
               "'NA' should be one of 'left', 'center', 'right', 'topleft'")
  expect_error(.validate_position(c("left", "error")),
               "contains multiple values but not all of them match 'choices'")
  expect_error(.validate_position(summary.pos <- 1),
               "'summary.pos' should have length 2")
  expect_error(.validate_position(1, name = "'summary.pos'"),
               "'summary.pos' should have length 2")
  expect_error(.validate_position(c(NA, 5), name = "A position"),
               "A position cannot contain missing values")

  ## .validate_originator() ----------------------------------------------------
  expect_error(.validate_originator(set_RLum("RLum.Analysis"), "orig"),
               "'NA' has an unsupported originator (expected 'orig', but found",
               fixed = TRUE)
  expect_equal(.validate_originator(set_RLum("RLum.Analysis", originator = "orig"),
                                    "orig"),
               "orig")

  ## .check_originator() ----------------------------------------------------
  expect_true(.check_originator(set_RLum("RLum.Analysis", originator = "orig"),
                                "orig"))
  expect_false(.check_originator(set_RLum("RLum.Analysis", originator = "orig"),
                                 c("orig1", "orig2")))
  expect_false(.check_originator(set_RLum("RLum.Analysis"), "orig"))
  expect_false(.check_originator(NULL, "orig"))
  expect_false(.check_originator(iris, "orig"))

  ## .validate_integral() ----------------------------------------------------
  expect_null(.validate_integral(NULL, null.ok = TRUE))
  expect_equal(.validate_integral(integral <- 5:1),
               1:5)
  expect_equal(.validate_integral(integral <- NA, na.ok = TRUE),
               NA)
  expect_equal(.validate_integral(c(0, 1.5), int = FALSE),
               c(0, 1.5))
  expect_error(.validate_integral(integral <- 1:5 + 0.1, int = FALSE),
               integral)
  expect_warning(expect_equal(.validate_integral(integral <- c(5:1, -3:3)),
                              1:5),
                 "'integral' contains out of bounds elements, reset to be between 1 and 5")
  expect_warning(expect_equal(.validate_integral(integral <- 1:100,
                                                 min = 5, max = 50),
                              5:50),
                 "'integral' contains out of bounds elements, reset to be between 5 and 50")
  expect_error(.validate_integral(integral <- "error"),
               "'integral' should be of class 'integer' or 'numeric'")
  expect_error(.validate_integral(integral <- list(NA), na.ok = TRUE),
               "'integral' should be of class 'integer', 'numeric' or NA")
  expect_error(.validate_integral(integral <- NA, na.ok = FALSE),
               "'integral' should be of class 'integer' or 'numeric'")
  expect_error(.validate_integral(integral <- NA_real_, na.ok = TRUE),
               "'integral' contains no elements between 1 and Inf")
  expect_error(.validate_integral(integral <- -9:0),
               "'integral' contains no elements between 1 and Inf")
  expect_error(.validate_integral(integral <- 1:10, min = 50, max = 100),
               "'integral' contains no elements between 50 and 100")
  expect_error(.validate_integral(integral <- 1:10, min = 150, max = 100),
               "is expected to be at least 150, but the maximum allowed is 100")
  expect_error(.validate_integral(integral <- 1:5 + 0.1),
               "'integral' should be a vector of integers")
  expect_warning(expect_error(.validate_integral(integral <- c(0, 1.5)),
                              "'integral' should be a vector of integers"),
                 "'integral' contains out of bounds elements, reset to be between 1.5 and 1.5")
  expect_error(.validate_integral(list.integral <- list(1:4)),
               "'list.integral' should be of class 'integer' or 'numeric'")
  expect_error(.validate_integral(list.integral <- list("error"), list.ok = TRUE),
               "All elements of 'list.integral' should be of class 'integer' or")
  expect_equal(.validate_integral(list.integral <- list(5:1), list.ok = TRUE),
               list(1:5))
  expect_warning(.validate_integral(integral <- c(1, 3)),
                 "'integral' was defined as c(1, 3) but in general we would",
                 fixed = TRUE)
  expect_no_warning(.validate_integral(integral <- c(1, 2)),
                    message = "'integral' was defined as c(1, 2) but in general")

  ## .convert_to_channels() -------------------------------------------------
  tl <- seq(1.8, 450, by = 1.8)
  expect_equal(.convert_to_channels(tl, NULL, null.ok = TRUE),
               NULL)
  expect_equal(.convert_to_channels(tl, NA, na.ok = TRUE),
               NA)
  expect_equal(.convert_to_channels(tl, 0:20),
               1:11)
  expect_equal(.convert_to_channels(tl, 200:220),
               111:122)
  expect_equal(.convert_to_channels(tl, c(200:210, NA, 200:220)),
               111:122)
  expect_equal(.convert_to_channels(tl, list(200:210, 200:220), list.ok = TRUE),
               list(111:117, 111:122))
  expect_warning(expect_equal(.convert_to_channels(tl, signal_integral <- c(0, 1.5),
                                                   unit = "temperature"),
                              1),
                 "Conversion of 'signal_integral' from temperature to channels failed")
  expect_warning(expect_equal(.convert_to_channels(tl, signal_integral <- c(1000, 2000),
                                                   unit = "temperature"),
                              250),
                 "Conversion of 'signal_integral' from temperature to channels failed")

  expect_error(.convert_to_channels(tl, integral <- NULL),
               "'integral' should be of class 'integer' or 'numeric'")
  expect_error(.convert_to_channels(tl, integral <- NA),
               "'integral' should be of class 'integer' or 'numeric'")
  expect_error(.convert_to_channels(tl, integral <- NA_real_, na.ok = TRUE,
                                    unit = "temperature"),
               "'integral' contains no elements in 1.8:450.0")
  expect_error(.convert_to_channels(tl, integral <- list(200:210, NA), list.ok = FALSE),
               "'integral' should be of class 'integer' or 'numeric'")
  expect_error(.convert_to_channels(tl, integral <- list(200:210, NA), list.ok = TRUE),
               "All elements of 'integral' should be of class 'integer' or 'numeric'")

  ## .validate_file() -------------------------------------------------------

  dir.path <- system.file("extdata", package = "Luminescence")
  expect_equal(.validate_file(file <- c("file1", "file2")),
               list("file1", "file2"))
  expect_equal(.validate_file(file <- list("file1")),
               list("file1"))
  expect_message(expect_equal(.validate_file(dir.path),
                              as.list(dir(dir.path, full.names = TRUE))),
                 "Directory detected, looking for any files")
  expect_silent(.validate_file(dir.path, verbose = FALSE))
  expect_message(expect_equal(basename(.validate_file(dir.path, pattern = "xsyg")),
                              "XSYG_file.xsyg"),
                 "Directory detected, looking for 'xsyg' files")
  expect_message(expect_message(
      expect_length(.validate_file(dir.path, pattern = "_none_"), 0),
      "Directory detected, looking for '_none_' files"),
      "No files matching the given pattern found")

  url <- "https://raw.githubusercontent.com/R-Lum/rxylib/master"
  expect_message(expect_message(.validate_file(file.path(url, "_pkgdown.yml")),
                                "Downloading"), "OK")
  expect_message(expect_message(.validate_file(file.path(url, "_error_")),
                                "Downloading"), "FAILED")

  expect_error(.validate_file(file <- TRUE),
               "'file' should be of class 'character' or 'list'")
  expect_error(.validate_file(file <- list(TRUE)),
               "All elements of 'file' should be of class 'character' and have length 1")
  expect_error(.validate_file("_error_"),
               "File '.*_error_' does not exist") # windows CI needs the regexp
  expect_message(expect_null(.validate_file("_error_", throw.error = FALSE)),
                 "File '.*_error_' does not exist") # windows CI needs the regexp
  expect_error(.validate_file(dir.path, scan.dir = FALSE),
               "File '.*' does not exist")
  file.create(zero <- tempfile(pattern = "zero", fileext = ".binx"))
  expect_error(.validate_file(zero),
               "is a zero-byte file")
  expect_message(expect_null(.validate_file(zero, throw.error = FALSE)),
                             "is a zero-byte file")
  expect_error(.validate_file(test_path("test_read_BIN2R.R"), ext = "e1"),
               "File extension 'R' is not supported, only 'e1' is valid")
  expect_error(.validate_file(test_path("test_read_BIN2R.R"), ext = c("e1", "e2")),
               "File extension 'R' is not supported, only 'e1' and 'e2' are valid")
  expect_message(expect_null(.validate_file(test_path("test_read_BIN2R.R"),
                                            ext = c("e1", "e2", "e3"), throw.error = FALSE)),
                 "File extension 'R' is not supported, only 'e1', 'e2' and 'e3'")

  ## .validate_cores() ------------------------------------------------------
  expect_equal(.validate_cores(NULL),
               max(parallel::detectCores() - 2, 1))
  expect_equal(.validate_cores(2),
               2)
  expect_warning(expect_equal(.validate_cores(2000),
                              parallel::detectCores()),
                 "Number of cores limited to the maximum available")
  expect_error(.validate_cores(-1),
               "'cores' should be a single positive integer value")
  expect_error(.validate_cores(c(2, 3)),
               "'cores' should be a single positive integer value")

  ## .require_suggested_package() -------------------------------------------
  expect_true(.require_suggested_package("utils"))
  expect_error(.require_suggested_package("error"),
               "This function requires the 'error' package: to install it")
  expect_error(.require_suggested_package("error",
                                          reason = "Reporting a good error"),
               "Reporting a good error requires the 'error' package")
  expect_warning(
      expect_false(.require_suggested_package("error", throw.error = FALSE),
                   "This function requires the 'error' package: to install it"))

  ## .listify() -------------------------------------------------------------
  expect_equal(.listify(1, length = 3),
               list(1, 1, 1))
  expect_equal(.listify(letters, length = 5),
               .listify(list(letters), length = 5))

  ## .collapse() ------------------------------------------------------------
  expect_equal(.collapse(1:3),
               "'1', '2', '3'")
  expect_equal(.collapse(1:3, quote = FALSE),
               "1, 2, 3")
  expect_equal(.collapse(1:2, quote = FALSE, last_sep = " or "),
               "1 or 2")
  expect_equal(.collapse(1:3, quote = FALSE, last_sep = " or "),
               "1, 2 or 3")
  expect_equal(.collapse(as.factor(c("060920", "070920", "080920", "090920")),
                         quote = FALSE),
               "060920, 070920, 080920, 090920")
  expect_equal(.collapse(NULL), "")

  ## .format_range() ________________________________________________________
  expect_equal(.format_range(1:10),
               "1:10")
  expect_equal(.format_range(c(1, 10, NA, 8)),
               "1:10")
  expect_equal(.format_range(c(-1, -10, NA, -8)),
               "-10:-1")
  expect_equal(.format_range(NULL),
               "NA:NA")
  expect_equal(.format_range(c(NA, NA, NA)),
               "NA:NA")
  expect_equal(.format_range(c(0, 1, -1), sep = ", "),
               "-1, 1")
  expect_equal(.format_range(c(0.53, 1.39, 1.14)),
               "0.53:1.39")
  expect_equal(.format_range(c(0.53, 1.39, 1.14), nsmall = 3),
               "0.530:1.390")

  ## .compress_ranges() _____________________________________________________
  expect_equal(.compress_ranges(1),
               "1")
  expect_equal(.compress_ranges(c(1, NA)),
               "1")
  expect_equal(.compress_ranges(c(-1, 0, 1)),
               "-1:1")
  expect_equal(.compress_ranges(c(1, 3, 4)),
               c("1", "3:4"))
  expect_equal(.compress_ranges(c(1, 3, 5)),
               c("1", "3", "5"))

  ## .shorten_filename() ----------------------------------------------------
  expect_equal(.shorten_filename("/path/to/filename"),
               "/path/to/filename")
  max.width <- 27
  shortened <- .shorten_filename("/path/to/a_somewhat_longer_filename",
                                 max.width = max.width)
  expect_equal(shortened,
               "/path/to/a_s...ger_filename")
  expect_equal(nchar(shortened), max.width)

  ## check vector
  max.width <- 10
  shortened <- .shorten_filename(c("short", NA, "muchmuchlonger"), 10)
  expect_equal(shortened,
               c("short", NA, "muc...nger"))
  expect_equal(nchar(shortened), c(5, NA, max.width))

  ## .rescale() ----------------------------------------------------
  x <- stats::rnorm(100)
  y_dens <- stats::density(x)
  expect_equal(max(.rescale(
   x = y_dens$y,
   range_old = c(min(y_dens$y), max(y_dens$y)),
   range_new = c(0, 20))), 20)

  ## C++ code ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  ##
  # src_create_RLumDataCurve_matrix -------------------------------------------------------------
  ##RLum.Data.Curve() ... test src_create_RLumDataCurve_matrix()
  expect_output(
    Luminescence:::src_create_RLumDataCurve_matrix(
      DATA = 1:100,
      VERSION = 4,
      NPOINTS = 100,
      LTYPE = "TL",
      LOW = 0,
      HIGH = 500,
      AN_TEMP = 0,
      TOLDELAY = 0,
      TOLON = 0,
      TOLOFF = 0
    )
  )
  ## cover NA case
  expect_type(
    Luminescence:::src_create_RLumDataCurve_matrix(
      DATA = 1:100,
      VERSION = 4,
      NPOINTS = 0,
      LTYPE = "OSL",
      LOW = 0,
      HIGH = 500,
      AN_TEMP = 0,
      TOLDELAY = 0,
      TOLON = 0,
      TOLOFF = 0), type = "double")

  ## case for a delayed hit ramp start
  expect_type(
    Luminescence:::src_create_RLumDataCurve_matrix(
      DATA = 1:100,
      VERSION = 4,
      NPOINTS = 0,
      LTYPE = "OSL",
      LOW = 0,
      HIGH = 500,
      AN_TEMP = 0,
      TOLDELAY = 10,
      TOLON = 0,
      TOLOFF = 0), type = "double")
  ## case for a delayed hit ramp start
  expect_type(
    Luminescence:::src_create_RLumDataCurve_matrix(
      DATA = 1:100,
      VERSION = 4,
      NPOINTS = 0,
      LTYPE = "OSL",
      LOW = 0,
      HIGH = 500,
      AN_TEMP = 100,
      TOLDELAY = 0,
      TOLON = 0,
      TOLOFF = 0), type = "double")
  ## generate strange curve and more tests
  expect_type(Luminescence:::src_create_RLumDataCurve_matrix(
    DATA = 1:100,
    VERSION = 4,
    NPOINTS = 100,
    LTYPE = "TL",
    LOW = 0,
    HIGH = 500,
    AN_TEMP = 200,
    TOLDELAY = 10,
    TOLON = 10,
    TOLOFF = 400),  type = "double")
})