tests/testthat/test-readSource.R

In pik-piam/madrat: May All Data be Reproducible and Transparent (MADRaT) *

nce <- function(x) {
  getComment(x) <- NULL
  attr(x, "cachefile") <- NULL
  attr(x, "id") <- NULL
  return(x)
}

test_that("readSource detects common problems", {
  localConfig(verbosity = 2, .verbose = FALSE)
  readNoDownload <- function() NULL
  globalassign("readNoDownload")
  expect_error(readSource("NoDownload"), "no download script")

  downloadTest <- function() {
    return(list(url = "dummy", author = "dummy", title = "dummy", license = "dummy",
                description = "dummy", unit = "dummy"))
  }
  readTest <- function() return(1)
  globalassign("downloadTest", "readTest")
  expect_error(readSource("Test"),
               "Output of \"readTest()\" should have class \"magpie\" but it does not.", fixed = TRUE)
  readTest <- function(x) return(as.magpie(1))
  globalassign("readTest")
  expect_warning(readSource("Test", convert = FALSE), "Some arguments .* cannot be adressed by the wrapper")
  readTest <- function() return(as.magpie(1))
  convertTest <- function(x) return(as.magpie(1))
  globalassign("readTest", "convertTest")
  expect_error(readSource("Test"), "Wrong number of countries")
  expect_warning(readSource("Test", convert = "onlycorrect"), "No correct function .* could be found")
  correctTest <- function(x) return(as.magpie(1))
  globalassign("correctTest")
  expect_identical(as.vector(readSource("Test", convert = "onlycorrect")), 1)
  expect_message(readSource("Test", convert = "onlycorrect"), "loading cache")

  expect_error(readSource(TRUE), "Invalid type")
  expect_error(readSource("NonAvailable"), "not a valid source")

  readTest <- function() return(as.magpie(1))
  correctTest <- function(x) return(as.magpie(2))
  convertTest <- function(x) return(new.magpie(getISOlist(), fill = 1))
  globalassign("correctTest", "convertTest", "readTest")
  expect_identical(nce(readSource("Test", convert = FALSE)), clean_magpie(as.magpie(1)))
  expect_identical(nce(readSource("Test", convert = "onlycorrect")), clean_magpie(as.magpie(2)))
  expect_identical(nce(readSource("Test")), clean_magpie(new.magpie(getISOlist(), fill = 1)))

  cache <- cacheName("convert", "Test")
  a <- readRDS(cache)
  getCells(a$x)[1] <- "BLA"
  saveRDS(a, cache)
  expect_message(readSource("Test"), "cache file corrupt")

  convertTest <- function(x) return(as.magpie(1))
  globalassign("convertTest")

  skip_on_cran()
  skip_if_offline("zenodo.org")
  expect_error(readSource("Tau", subtype = "paper", convert = "WTF"), "Unknown convert setting")
})

test_that("default readSource example works", {
  skip_on_cran()
  skip_if_offline("zenodo.org")
  expect_silent(suppressMessages({
    a <- readSource("Tau", "paper")
  }))
  expect_equal(getYears(a, as.integer = TRUE), c(1995, 2000))
})

test_that("downloadSource works", {
  skip_on_cran()
  skip_if_offline("zenodo.org")
  localConfig(verbosity = 2, .verbose = FALSE)
  expect_error(downloadSource("Tau", "paper"),
               paste('Source folder for source "Tau/paper" does already exist. Delete that folder or call',
                     "downloadSource(..., overwrite = TRUE) if you want to re-download."), fixed = TRUE)
  expect_error(downloadSource(1:10), "Invalid type")
  expect_error(downloadSource("Tau", subtype = 1:10), "Invalid subtype")
  downloadTest <- function() {
    return(list(url = 1, author = 1, title = 1, license = 1,
                description = 1, unit = 1, call = "notallowed"))
  }
  globalassign("downloadTest")
  expect_warning(downloadSource("Test", overwrite = TRUE), "reserved and will be overwritten")
})

test_that("forcecache works for readSource", {
  localConfig(mainfolder = withr::local_tempdir())
  readTest2 <- function() new.magpie()
  globalassign("readTest2")
  expect_error(readSource("Test2"),
               paste('Sourcefolder does not contain data for the requested source type = "Test2" and there is no',
                     "download script which could provide the missing data. Please check your settings!"),
               fixed = TRUE)
  dir.create(file.path(getConfig("sourcefolder"), "Test2"), recursive = TRUE)
  expect_identical(readSource("Test2"), new.magpie())

  # ensure forced cache file is used even though sourcefolder does not exist
  unlink(file.path(getConfig("sourcefolder"), "Test2"), recursive = TRUE)
  localConfig(forcecache = TRUE)
  saveRDS("secret", cacheName("read", "Test2"))
  actual <- readSource("Test2")
  attributes(actual) <- NULL
  expect_identical(actual, "secret")
})

test_that("read functions can return non-magpie objects", {
  testReadSource <- function(readThis,
                             correctThis = function(x) readThis(),
                             convertThis = function(x) readThis(),
                             convert = TRUE,
                             supplementary = FALSE) {
    downloadThis <- function() list(url = "", author = "", title = "", license = "", description = "", unit = "")
    localConfig(globalenv = TRUE)
    stopifnot(!"This" %in% getCalculations(c("download", "read", "correct", "convert"))$type)
    globalassign("downloadThis", "readThis", "correctThis", "convertThis")
    return(readSource("This", convert = convert, supplementary = supplementary))
  }

  expect_identical(testReadSource(function() list(x = 1, class = "numeric"), supplementary = TRUE),
                   list(x = 1, class = "numeric"))

  # running second time -> loading from cache, will have additional attribute
  expect_false(identical(testReadSource(function() list(x = 1, class = "numeric"), supplementary = TRUE),
                         list(x = 1, class = "numeric")))
  expect_identical(nce(testReadSource(function() list(x = 1, class = "numeric"), supplementary = TRUE)),
                   list(x = 1, class = "numeric"))

  expect_identical(testReadSource(function() list(x = 1, class = "numeric")), 1)
  expect_error(testReadSource(function() list(x = 1, class = "character")),
               "Output of \"readThis()\" should have class \"character\" but it does not.",
               fixed = TRUE)
  expect_error(testReadSource(readThis = function() list(x = 1, class = "numeric"),
                              correctThis = function() list(x = 1, class = "character")),
               "Output of \"correctThis()\" should have class \"character\" but it does not.",
               fixed = TRUE)

  convertThis <- function(x) {
    expect_identical(x, 1)
    return(list(x = 2, class = "numeric"))
  }
  expect_identical(testReadSource(readThis = function() list(x = 1, class = "numeric"), convertThis = convertThis), 2)
  expect_error(testReadSource(readThis = function() list(x = 1, class = "numeric"),
                              correctThis = function() list(x = 1, class = "numeric"),
                              convertThis = function() list(x = 1, class = "character")),
               "Output of \"convertThis()\" should have class \"character\" but it does not.",
               fixed = TRUE)
  expect_error(testReadSource(function() NULL),
               "Output of \"readThis()\" should have class \"magpie\" but it does not.",
               fixed = TRUE)
  expect_error(testReadSource(function() character(0)),
               "Output of \"readThis()\" should have class \"magpie\" but it does not.",
               fixed = TRUE)
  expect_error(testReadSource(function() list(y = 1, class = "character")),
               paste("Output of \"readThis()\" must be a MAgPIE object",
                     "or a list with the entries \"x\" and \"class\"!"), fixed = TRUE)

  # test whether ISO country check is applied
  expect_error(testReadSource(function() list(x = as.magpie(1), class = "magpie")),
               "Wrong number of countries returned by convertThis(x=x)!", fixed = TRUE)

  # test whether clean_magpie is applied
  brokenMagpie <- as.magpie(1)
  dimnames(brokenMagpie)[1] <- NULL
  expect_false(identical(brokenMagpie, clean_magpie(brokenMagpie)))
  expect_identical(testReadSource(function() list(x = brokenMagpie, class = "magpie"), convert = FALSE),
                   clean_magpie(brokenMagpie))
})

test_that("readSource uses default subtype", {
  mainfolder <- normalizePath(withr::local_tempdir(), winslash = "/")
  localConfig(mainfolder = mainfolder)

  downloadTest <- function(subtype = "a") {
    writeLines(subtype, "data.txt")
    return(list(url = "", author = "", title = "", license = "", description = "", unit = ""))
  }
  readTest <- function(subtype = "a") {
    stopifnot(file.exists("data.txt"))
    return(as.magpie(1))
  }
  globalassign(c("downloadTest", "readTest"))

  expect_false(file.exists(file.path(mainfolder, "sources", "Test", "a", "data.txt")))
  readSource("Test") # call readSource without passing subtype explicitly
  expect_true(file.exists(file.path(mainfolder, "sources", "Test", "a", "data.txt")))
})

test_that("read with subtype, download without", {
  mainfolder <- normalizePath(withr::local_tempdir(), winslash = "/")
  localConfig(mainfolder = mainfolder)

  downloadTest <- function() {
    writeLines("z", "data.txt")
    return(list(url = "", author = "", title = "", license = "", description = "", unit = ""))
  }
  readTest <- function(subtype = "a") {
    stopifnot(file.exists("data.txt"))
    return(as.magpie(1))
  }
  globalassign(c("downloadTest", "readTest"))

  expect_false(file.exists(file.path(mainfolder, "sources", "Test", "data.txt")))
  readSource("Test") # call readSource without passing subtype explicitly
  expect_true(file.exists(file.path(mainfolder, "sources", "Test", "data.txt")))
})