Merge pull request #3188 from meetagrawal09/test-utils

Improving test coverage for `PEcAn.utils` package

base/utils/DESCRIPTION

@@ -48,9 +48,11 @@ Suggests:
     data.table,
     ggplot2,
     MASS,
+    mockery,
     randtoolbox,
     rjags,
     testthat (>= 2.0.0),
+    withr,
     xtable
 License: BSD_3_clause + file LICENSE
 Copyright: Authors

base/utils/R/mail.R

@@ -32,7 +32,7 @@ sendmail <- function(from, to, subject, body) {
     cat(paste0("From: ", from, "\n", 
                "Subject: ", subject, "\n", 
                "To: ", to, "\n", "\n", 
-               body), file = mailfile)
+               body, "\n"), file = mailfile)
     system2(sendmail, c("-f", paste0("\"", from, "\""), 
                         paste0("\"", to, "\""), "<", mailfile))
     unlink(mailfile)

base/utils/R/utils.R

@@ -669,7 +669,7 @@ convert.expr <- function(expression) {
 ##' @author Shawn Serbin, Rob Kooper
 download_file <- function(url, filename, method) {
   if (startsWith(url, "ftp://")) {
-    method <- if (missing(method)) getOption("download.ftp.method", default = "auto")
+    if (missing(method)) method <- getOption("download.ftp.method", default = "auto")
     if (method == "ncftpget") {
       PEcAn.logger::logger.debug(paste0("FTP Method: ",method))
       #system2("ncftpget", c("-c", "url", ">", filename))
@@ -706,7 +706,7 @@ download_file <- function(url, filename, method) {
 ##'       "thredds/dodsC/ornldaac/1220", 
 ##'       "/mstmip_driver_global_hd_climate_lwdown_1999_v1.nc4")
 ##' dap <- retry.func(
-##'   ncdf4::nc_open(file_url)
+##'   ncdf4::nc_open(file_url),
 ##'   maxErrors=10,
 ##'   sleep=2)
 ##' }

base/utils/tests/testthat/test.cf2date.R

@@ -0,0 +1,23 @@
+test_that("`cf2datetime()` able to convert CF-style date-time to POSIXct date-time along with taking care of leap years", {
+  expect_equal(cf2datetime(5, "days since 1981-01-01"), as.POSIXct("1981-01-06", tz = "UTC"))
+  expect_equal(cf2datetime(27, "minutes since 1963-01-03 12:00:00 -05:00"), as.POSIXct("1963-01-03 17:27:00", tz = "UTC"))
+  # nom-leap year
+  expect_equal(cf2datetime(365, "days since 1999-01-01"), as.POSIXct("2000-01-01", tz = "UTC"))
+  # leap year
+  expect_equal(cf2datetime(365, "days since 2000-01-01 12:00:00 -05:00"), as.POSIXct("2000-12-31 17:00:00", tz = "UTC"))
+})
+
+test_that("`datetime2cf()` able to convert POSIXct date-time to CF-style date-time", {
+  expect_equal(datetime2cf("1990-10-05", "days since 1990-01-01", tz = "UTC"), 277)
+  expect_equal(datetime2cf("1963-01-03 17:27:00", "minutes since 1963-01-03 12:00:00 -05:00", tz = "UTC"), 27)
+})
+
+test_that("`datetime2doy()` and `cf2doy()` able to extract Julian day from POSIXct or CF date-times respectively(cf2doy internally converts CF to POSIXct and calls datetime2doy)", {
+
+  # POSIXct date-times
+  expect_equal(datetime2doy("2010-01-01"), 1)
+  expect_equal(datetime2doy("2010-01-01 12:00:00"), 1.5)
+
+  # CF date-times
+  expect_equal(cf2doy(0, "days since 2007-01-01"), 1)
+})

base/utils/tests/testthat/test.clear.scratch.R

@@ -0,0 +1,24 @@
+test_that("`clear.scratch()` able to build the correct system command prompt to remove previous model run output", {
+  mocked_res <- mockery::mock(TRUE)
+  mockery::stub(clear.scratch, 'system', mocked_res)
+  mockery::stub(clear.scratch, 'seq', 0)
+  settings <- list(host = list(name = "cluster"))
+  expect_output(
+    clear.scratch(settings),
+    ".*Removing.*[email protected]"
+  )
+  args <- mockery::mock_args(mocked_res)
+  expect_true(
+    grepl(
+      "ssh -T cluster qlogin -q [email protected].*clear.scratch.sh", 
+      args[[1]][[1]]
+    )
+  )
+
+  # host name not cluster
+  settings <- list(host = list(name = "test"))
+  expect_output(
+    clear.scratch(settings),
+    ".*No output to delete.*"
+  )
+})

base/utils/tests/testthat/test.days_in_year.R

@@ -0,0 +1,5 @@
+test_that("`days_in_year()` correctly returns number of days when provided a year or a vector of years", {
+  expect_equal(days_in_year(2010), 365)
+  expect_equal(days_in_year(2012), 366)
+  expect_equal(days_in_year(2010:2012), c(365, 365, 366))
+})

base/utils/tests/testthat/test.download.url.R

@@ -0,0 +1,12 @@
+test_that("`download.url()` able to create the target dir for file download and passes the correct args to curl_download", {
+  withr::with_dir(tempdir(), {
+    mocked_res <- mockery::mock(TRUE)
+    mockery::stub(download.url, 'url_found', TRUE)
+    mockery::stub(download.url, 'curl::curl_download', mocked_res)
+    res <- download.url('http://localhost/', 'test/index.html')    
+    expect_true(file.exists('test'))
+    args <- mockery::mock_args(mocked_res)
+    expect_equal(args[[1]]$url, 'http://localhost/')
+    expect_equal(args[[1]]$destfile, 'test/index.html')
+  })
+})

base/utils/tests/testthat/test.get.ensemble.inputs.R

@@ -0,0 +1,16 @@
+test_that("`get.ensemble.inputs()` able to return desired ensemble inputs from settings", {
+  settings <- list(
+    run = list(
+      inputs = list(
+        input1 = c(1, 2, 3),
+        input2 = c("A", "B", "C"),
+        input3 = c(TRUE, FALSE, TRUE)
+      )
+    )
+  )
+  res <- get.ensemble.inputs(settings)
+  expect_equal(
+    res, 
+    list(input1 = c(1, 2, 3), input2 = c(1, 2, 3), input3 = c(1, 2, 3))
+  )
+})

base/utils/tests/testthat/test.listToArgString.R

@@ -0,0 +1,19 @@
+test_that("`listToArgString()` able to format list of named function args in a comma separated list", {
+  expect_equal(
+    listToArgString(c(host = 'pecan', settings = 'test', id = 2020)),
+    "host='pecan', settings='test', id='2020'"
+  )
+})
+
+test_that("`.parseArg()` works for all different types of entries in the list of function args passed to listToArgString", {
+  # character
+  expect_equal(.parseArg('pecan'), "'pecan'")
+  # NULL
+  expect_equal(.parseArg(NULL), "NULL")
+  # list
+  expect_equal(.parseArg(list(a = 1, b = 2)), "list(a='1', b='2')")
+  # data.frame
+  expect_equal(.parseArg(data.frame(a = 1, b = 2)), "data.frame(a =c(' 1 '),b =c(' 2 '))")
+  # nested list
+  expect_equal(.parseArg(list(a = 1, b = list(c = 3, d = 4))), "list(a='1', b=list(c='3', d='4'))")
+})

base/utils/tests/testthat/test.load_local.R

@@ -0,0 +1,10 @@
+test_that("`load_local()` able to load file into a list", {
+  withr::with_tempfile("tf", {
+    x <- 1:10
+    y <- 11:15
+    save(x, y, file = tf)
+    test_list <- load_local(tf)
+    expect_equal(test_list$x, x)
+    expect_equal(test_list$y, y)
+  })
+})

base/utils/tests/testthat/test.n_leap_day.R

@@ -0,0 +1,9 @@
+test_that("`n_leap_day()` able to correctly return number of leap days between 2 specified dates", {
+
+  # having leap days
+  expect_equal(n_leap_day("2000-01-01", "2003-12-31"), 1)
+  expect_equal(n_leap_day("2000-01-01", "2004-12-31"), 2)
+
+  # no leap days
+  expect_equal(n_leap_day("2001-01-01", "2003-12-31"), 0)
+})

base/utils/tests/testthat/test.need_packages.R

@@ -0,0 +1,11 @@
+test_that("`need_packages()` correctly checks if the required packages are installed", {
+
+  # normal condition : when packages exist
+  expect_equal(need_packages("stats", "methods"), c("stats", "methods"))
+
+  # error condition
+  expect_error(
+    need_packages("notapackage"), 
+    "The following packages are required but not installed: `notapackage`"
+  )
+})

base/utils/tests/testthat/test.r2bugs.distributions.R

@@ -0,0 +1,19 @@
+test_that("`r2bugs.distributions()` able to convert R parameterization to BUGS parameterization", {
+  priors <- data.frame(distn = c('weibull', 'lnorm', 'norm', 'gamma'),
+                      parama = c(1, 1, 1, 1),
+                      paramb = c(2, 2, 2, 2))
+  res <- r2bugs.distributions(priors)
+  expect_equal(res$distn, c("weib", "lnorm", "norm", "gamma"))
+  expect_equal(res$parama, c(1, 1, 1, 1))
+  expect_equal(res$paramb, c(0.50, 0.25, 0.25, 2.00))
+})
+
+test_that("`bugs2r.distributions()` able to convert BUGS parameterization to R parameterization", {
+  priors <- data.frame(distn = c('weib', 'lnorm', 'norm', 'gamma'),
+                      parama = c(1, 1, 1, 1),
+                      paramb = c(0.50, 0.25, 0.25, 2.00))
+  res <- bugs2r.distributions(priors)
+  expect_equal(res$distn, c("weibull", "lnorm", "norm", "gamma"))
+  expect_equal(res$parama, c(1, 1, 1, 1))
+  expect_equal(res$paramb, c(2, 2, 2, 2))
+})

base/utils/tests/testthat/test.seconds_in_year.R

@@ -0,0 +1,8 @@
+test_that("`seconds_in_year()` able to return number of seconds in a given year(also for a vector of years)", {
+  # leap year
+  expect_equal(seconds_in_year(2000), 31622400)
+  # non leap year
+  expect_equal(seconds_in_year(2001), 31536000)
+  # vector of years
+  expect_equal(seconds_in_year(2000:2004), c(31622400, 31536000, 31536000, 31536000, 31622400))
+})

base/utils/tests/testthat/test.sendmail.R

@@ -0,0 +1,18 @@
+test_that("`sendmail()` able to create the file with contents to email correctly, also able to build correct command to send the email", {
+  withr::with_tempfile("tf", {
+    mocked_res <- mockery::mock(TRUE)
+    mockery::stub(sendmail, 'system2', mocked_res)
+    mockery::stub(sendmail, 'tempfile', tf)
+    mockery::stub(sendmail, 'unlink', NULL)
+    sendmail('pecan@@example.com', 'carya@@example.com', 'Hi', 'Message from pecan.')
+    sendmailfile <- readLines(tf)
+    expect_equal(sendmailfile[1], 'From: pecan@@example.com')
+    expect_equal(sendmailfile[2], 'Subject: Hi')
+    expect_equal(sendmailfile[3], 'To: carya@@example.com')
+    expect_equal(sendmailfile[5], 'Message from pecan.')
+    args <- mockery::mock_args(mocked_res)
+    expect_equal(args[[1]][[2]][[1]], '-f')
+    expect_equal(args[[1]][[2]][[2]], '"pecan@@example.com"')
+    expect_equal(args[[1]][[2]][[3]], '"carya@@example.com"')
+  })
+})

base/utils/tests/testthat/test.timezone_hour.R

@@ -0,0 +1,7 @@
+test_that("`timezone_hour()` able to correctly return number of hours offset to UTC for a timezone", {
+  expect_equal(timezone_hour('US/Pacific'), -8)
+  expect_equal(timezone_hour('US/Eastern'), -5)
+
+  # for numeric
+  expect_equal(timezone_hour(-8), -8)
+})

base/utils/tests/testthat/test.units_are_equivalent.R

@@ -0,0 +1,6 @@
+test_that("`units_are_equivalent()` able to identify if the units are equivalent or not", {
+  # Equivalent units
+  expect_true(units_are_equivalent("m/s", "m s-1"))
+  # Non-equivalent units
+  expect_error(units_are_equivalent("m/s", "m s-2"))
+})

base/utils/tests/testthat/test.utils.R

@@ -161,3 +161,135 @@ test_that("mstmipvar works with args specified", {
 #     "Don't know about variable banana in standard_vars in PEcAn.utils"
 #   )
 # })
+
+
+test_that("`left.pad.zeros()` able to add zeros to the left of a number based on `digits`", {
+  expect_equal(left.pad.zeros(123), "00123")
+  expect_equal(left.pad.zeros(42, digits = 3), "042")
+  expect_equal(left.pad.zeros(42, digits = 1), "42")
+})
+
+test_that("`zero.truncate()` able to truncate vector at zero", {
+  input <- c(1, NA, -3, NA, 5)
+  expect_equal(zero.truncate(input), c(1, 0, 0, 0, 5))
+})
+
+test_that("`tabnum()` able to convert positive and negative numbers to `n` significant figures", {
+
+  # case where n specified
+  x <- c(-2.345, 6.789)
+  result <- tabnum(x, 2)
+  expect_equal(result, c(-2.3, 6.8))
+
+  # case where n is default
+  result <- tabnum(3.5435)
+  expect_equal(result, 3.54)
+})
+
+test_that("`capitalize()` able to capitalize words in a sentence", {
+  # single word
+  expect_equal(capitalize("pecan"), "Pecan")
+
+  # sentence with leading and trailing spaces
+  expect_equal(capitalize("    pecan project    "), "    Pecan Project   ")
+})
+
+test_that("`bibtexify()` able to convert parameters passed to bibtex citation format", {
+  expect_equal(bibtexify("author", "1999", "Here Goes The Title"), "author1999HGTT")
+})
+
+test_that("`rsync()` able to correctly make the command passed to `system` function", {
+  mocked_res <- mockery::mock(0)
+  mockery::stub(rsync, 'system', mocked_res)
+  rsync(args = '-avz', from = 'pecan:test_src', to = 'pecan:test_des')
+  args <- mockery::mock_args(mocked_res)
+  expect_equal(args[[1]][[1]], "rsync -avz pecan:test_src pecan:test_des")
+})
+
+test_that("`ssh()` able to correctly make the command passed to `system` function", {
+  mocked_res <- mockery::mock(0)
+  mockery::stub(ssh, 'system', mocked_res)
+  ssh(host = 'pecan')
+  args <- mockery::mock_args(mocked_res)
+  expect_equal(args[[1]][[1]], "ssh -T pecan \"\" ")
+})
+
+test_that("`temp.settings()` able to create a temporary settings file", {
+  expect_equal(temp.settings('<pecan></pecan>'), '<pecan></pecan>')
+})
+
+test_that("`misc.convert()` able to unit conversions for known and unknown units to the function", {
+
+  # units known to misc.convert
+  expect_equal(misc.convert(1, "kg C m-2 s-1", "umol C m-2 s-1"), 83259094)
+  # units not known to misc.convert
+  expect_equal(misc.convert(10, "kg", "g"), 10000)
+})
+
+test_that("`misc.are.convertible()` able to check if units are convertible by `misc.convert`", {
+  # units known to misc.convert
+  expect_true(misc.are.convertible("kg C m-2 s-1", "umol C m-2 s-1"))
+  # units known but not interconvertible
+  expect_false(misc.are.convertible("kg C m-2 s-1", "Mg ha-1"))
+  # units not known to misc.convert
+  expect_false(misc.are.convertible("kg", "g"))
+})
+
+test_that("`convert.expr()` able to convert expression to variable names", {
+  res <- convert.expr("a+b=c+d")
+  expect_equal(res$variable.drv, "a+b")
+  expect_equal(res$variable.eqn$variables, c("c", "d"))
+  expect_equal(res$variable.eqn$expression, "c+d")
+})
+
+test_that("`paste.stats()` able to print inputs to specific format(for building a Latex Table)", {
+  expect_equal(paste.stats(3.333333, 5.00001, 6.88888, n = 3), "$3.33(5,6.89)$")
+})
+
+test_that("`zero.bounded.density()` returns output containing required components", {
+  res <- zero.bounded.density(c(1, 2, 3))
+  expect_true("x" %in% names(res))
+  expect_true("y" %in% names(res))
+})
+
+test_that("`pdf.stats()` able to calculate mean, variance statistics, and CI from a known distribution", {
+  expect_equal(
+    pdf.stats("beta", 1, 2), 
+    unlist(list(mean = 0.33333333, var = 0.05555556, lcl = 0.01257912, ucl = 0.84188612))
+  )
+})
+
+test_that("`newxtable()` generates correct xtable object", {
+  data <- data.frame(A = c(1, 2, 3), B = c(4, 5, 6))
+  expect_true(grepl("\\hline.*& A & B.*& 1.00 & 4.00.*& 2.00 & 5.00.*& 3.00 & 6.00", newxtable(data)))
+})
+
+test_that("`tryl()` able to check if a function gives an error when called", {
+  # case where function does not give an error
+  expect_true(tryl(1+1))
+
+  # case where function gives an error
+  expect_false(tryl(log("a")))
+})
+
+test_that("`download_file()` able to correctly construct the inputs command to system function", {
+  mocked_res <- mockery::mock(0)
+  mockery::stub(download_file, 'system', mocked_res)
+  download_file("ftp://testpecan.com", "test", "ncftpget")
+  args <- mockery::mock_args(mocked_res)
+  expect_equal(args[[1]][[1]], "ncftpget -c ftp://testpecan.com > test")
+})
+
+test_that("`retry.func()` able to retry a function before returning an error", {
+  defaultW <- getOption("warn") 
+  options(warn = -1)
+  on.exit(options(warn = defaultW))
+  expect_error(
+    retry.func(ncdf4::nc_open("http://pecan"), maxErrors = 2, sleep = 2),
+    "retry: too many retries"
+  )
+
+  # case where function does not give an error
+  expect_equal(retry.func(1+1, maxErrors = 2, sleep = 2), 2)
+})
+