diff --git a/base/utils/DESCRIPTION b/base/utils/DESCRIPTION index 7a6df1a73c4..de9cae9a3a4 100644 --- a/base/utils/DESCRIPTION +++ b/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 diff --git a/base/utils/R/mail.R b/base/utils/R/mail.R index 82d22390644..d188b43275b 100644 --- a/base/utils/R/mail.R +++ b/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) diff --git a/base/utils/R/utils.R b/base/utils/R/utils.R index 5e155f2e294..5e13ddedf1a 100644 --- a/base/utils/R/utils.R +++ b/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) ##' } diff --git a/base/utils/man/retry.func.Rd b/base/utils/man/retry.func.Rd index ad501ab215e..e5b250e9f1e 100644 --- a/base/utils/man/retry.func.Rd +++ b/base/utils/man/retry.func.Rd @@ -37,7 +37,7 @@ Retry function X times before stopping in error "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) } diff --git a/base/utils/tests/testthat/test.cf2date.R b/base/utils/tests/testthat/test.cf2date.R new file mode 100644 index 00000000000..d45df781b9a --- /dev/null +++ b/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) +}) \ No newline at end of file diff --git a/base/utils/tests/testthat/test.clear.scratch.R b/base/utils/tests/testthat/test.clear.scratch.R new file mode 100644 index 00000000000..1d4ca0ced1e --- /dev/null +++ b/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.*all.q@compute-0-0.local" + ) + args <- mockery::mock_args(mocked_res) + expect_true( + grepl( + "ssh -T cluster qlogin -q all.q@compute-0-0.local.*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.*" + ) +}) \ No newline at end of file diff --git a/base/utils/tests/testthat/test.days_in_year.R b/base/utils/tests/testthat/test.days_in_year.R new file mode 100644 index 00000000000..6b55cd20fd8 --- /dev/null +++ b/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)) +}) \ No newline at end of file diff --git a/base/utils/tests/testthat/test.download.url.R b/base/utils/tests/testthat/test.download.url.R new file mode 100644 index 00000000000..3180de253cc --- /dev/null +++ b/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') + }) +}) \ No newline at end of file diff --git a/base/utils/tests/testthat/test.get.ensemble.inputs.R b/base/utils/tests/testthat/test.get.ensemble.inputs.R new file mode 100644 index 00000000000..025486c81ff --- /dev/null +++ b/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)) + ) +}) \ No newline at end of file diff --git a/base/utils/tests/testthat/test.listToArgString.R b/base/utils/tests/testthat/test.listToArgString.R new file mode 100644 index 00000000000..dfa1f996a92 --- /dev/null +++ b/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'))") +}) \ No newline at end of file diff --git a/base/utils/tests/testthat/test.load_local.R b/base/utils/tests/testthat/test.load_local.R new file mode 100644 index 00000000000..16f35f848fe --- /dev/null +++ b/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) + }) +}) \ No newline at end of file diff --git a/base/utils/tests/testthat/test.n_leap_day.R b/base/utils/tests/testthat/test.n_leap_day.R new file mode 100644 index 00000000000..0b6c55a4180 --- /dev/null +++ b/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) +}) \ No newline at end of file diff --git a/base/utils/tests/testthat/test.need_packages.R b/base/utils/tests/testthat/test.need_packages.R new file mode 100644 index 00000000000..6ae98f05a30 --- /dev/null +++ b/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`" + ) +}) \ No newline at end of file diff --git a/base/utils/tests/testthat/test.r2bugs.distributions.R b/base/utils/tests/testthat/test.r2bugs.distributions.R new file mode 100644 index 00000000000..dcd414681fd --- /dev/null +++ b/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)) +}) \ No newline at end of file diff --git a/base/utils/tests/testthat/test.seconds_in_year.R b/base/utils/tests/testthat/test.seconds_in_year.R new file mode 100644 index 00000000000..c7db4e92d6a --- /dev/null +++ b/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)) +}) \ No newline at end of file diff --git a/base/utils/tests/testthat/test.sendmail.R b/base/utils/tests/testthat/test.sendmail.R new file mode 100644 index 00000000000..990e0d394ae --- /dev/null +++ b/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"') + }) +}) \ No newline at end of file diff --git a/base/utils/tests/testthat/test.timezone_hour.R b/base/utils/tests/testthat/test.timezone_hour.R new file mode 100644 index 00000000000..e1ca8dd44d5 --- /dev/null +++ b/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) +}) \ No newline at end of file diff --git a/base/utils/tests/testthat/test.units_are_equivalent.R b/base/utils/tests/testthat/test.units_are_equivalent.R new file mode 100644 index 00000000000..d5d8b4c4240 --- /dev/null +++ b/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")) +}) \ No newline at end of file diff --git a/base/utils/tests/testthat/test.utils.R b/base/utils/tests/testthat/test.utils.R index 62112b39873..93337ba0856 100644 --- a/base/utils/tests/testthat/test.utils.R +++ b/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(''), '') +}) + +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) +}) +