From 6b0cd0be99ef1c47d9df65da4c0f162bf7538c64 Mon Sep 17 00:00:00 2001 From: meetagrawal09 Date: Wed, 7 Jun 2023 18:18:58 +0530 Subject: [PATCH 01/17] tested take.samples, append.covariate, filter_sunleaf_traits --- .../tests/testthat/test.covariate.functions.R | 32 +++++++++++++++++++ base/db/tests/testthat/test.take.samples.R | 10 ++++++ 2 files changed, 42 insertions(+) create mode 100644 base/db/tests/testthat/test.covariate.functions.R create mode 100644 base/db/tests/testthat/test.take.samples.R diff --git a/base/db/tests/testthat/test.covariate.functions.R b/base/db/tests/testthat/test.covariate.functions.R new file mode 100644 index 00000000000..27fccd4eabe --- /dev/null +++ b/base/db/tests/testthat/test.covariate.functions.R @@ -0,0 +1,32 @@ +test_that("`append.covariate` able to append new column for covariates in given data based on id", { + data <- data.frame( + id = c(1, 2, 3, 4), + name = c("a", "b", "c", "d") + ) + covariates.data <- data.frame( + trait_id = c( 1, 2, 3, 4, 4), + level = c("A", "B", "C", "D", "E"), + name = c("a", "b", "c", "d", "e") + ) + updated_data <- append.covariate(data, "new_covariates_col", covariates.data) + expect_equal(updated_data$new_covariates_col, c("A", "B", "C", "D")) + expect_equal(colnames(updated_data), c("id", "new_covariates_col", "name")) +}) + +test_that("`filter_sunleaf_traits`able to filter out upper canopy leaves", { + data <- data.frame( + id = c(1, 2, 3, 4), + name = c("a", "b", "c", "d") + ) + covariates <- data.frame( + trait_id = c(1, 2, 3, 4), + name = c("leaf", "canopy_layer", "canopy_layer", "sunlight"), + level = c(1.2, 0.5, 0.7, 0.67) + ) + + updated_data <- filter_sunleaf_traits(data, covariates) + expect_equal(updated_data$name, c("a", "c", "d")) + + # temporary column gets removed + expect_equal(colnames(updated_data), c("id", "name")) +}) \ No newline at end of file diff --git a/base/db/tests/testthat/test.take.samples.R b/base/db/tests/testthat/test.take.samples.R new file mode 100644 index 00000000000..738bd6fab61 --- /dev/null +++ b/base/db/tests/testthat/test.take.samples.R @@ -0,0 +1,10 @@ +test_that("`take.samples` returns mean when stat is NA", { + summary = list(mean = 10, stat = NA) + expect_equal(take.samples(summary = summary), summary$mean) +}) + +test_that("`take.samples` returns a vector of length sample.size for given summary stats", { + summary = list(mean = 10, stat = 10) + sample.size = 10 + expect_equal(length(take.samples(summary = summary, sample.size = sample.size)), sample.size) +}) \ No newline at end of file From 2f99ed472304bd3a34d0fcb3991e45a2bb744d0a Mon Sep 17 00:00:00 2001 From: meetagrawal09 Date: Wed, 7 Jun 2023 21:04:58 +0530 Subject: [PATCH 02/17] moved around tests --- base/db/tests/testthat/test.derive.traits.R | 7 ------- base/db/tests/testthat/test.take.samples.R | 5 +++++ 2 files changed, 5 insertions(+), 7 deletions(-) diff --git a/base/db/tests/testthat/test.derive.traits.R b/base/db/tests/testthat/test.derive.traits.R index ae4b4ba93c9..4ba88caf3ed 100644 --- a/base/db/tests/testthat/test.derive.traits.R +++ b/base/db/tests/testthat/test.derive.traits.R @@ -6,13 +6,6 @@ # which accompanies this distribution, and is available at # http://opensource.ncsa.illinois.edu/license.html #------------------------------------------------------------------------------- -test_that("take.samples works",{ - expect_equal(take.samples(summary = data.frame(mean = 1, stat = NA)), 1) - set.seed(0) - test.sample <- take.samples(summary = data.frame(mean = 1, stat = 1), - sample.size = 2) - expect_equal(test.sample, c(2.26295428488079, 0.673766639294351)) -}) test_that("derive.traits works",{ set.seed(0) diff --git a/base/db/tests/testthat/test.take.samples.R b/base/db/tests/testthat/test.take.samples.R index 738bd6fab61..dee2e479b44 100644 --- a/base/db/tests/testthat/test.take.samples.R +++ b/base/db/tests/testthat/test.take.samples.R @@ -7,4 +7,9 @@ test_that("`take.samples` returns a vector of length sample.size for given summa summary = list(mean = 10, stat = 10) sample.size = 10 expect_equal(length(take.samples(summary = summary, sample.size = sample.size)), sample.size) + + # Testing for exact return values for a simple example + test.sample <- take.samples(summary = data.frame(mean = 1, stat = 1), + sample.size = 2) + expect_equal(test.sample, c(2.26295428488079, 0.673766639294351)) }) \ No newline at end of file From b1a3b01a8aacd1b06cfe2b0e7b33292397f0c49d Mon Sep 17 00:00:00 2001 From: meetagrawal09 Date: Thu, 8 Jun 2023 11:21:11 +0530 Subject: [PATCH 03/17] tested check.lists, assign.treatments, drop.columns --- base/db/R/assign.treatments.R | 2 +- base/db/man/assign.treatments.Rd | 2 +- .../tests/testthat/test.assign.treatments.R | 33 +++++++++++++++++++ base/db/tests/testthat/test.check.lists.R | 23 +++++++++++++ 4 files changed, 58 insertions(+), 2 deletions(-) create mode 100644 base/db/tests/testthat/test.assign.treatments.R create mode 100644 base/db/tests/testthat/test.check.lists.R diff --git a/base/db/R/assign.treatments.R b/base/db/R/assign.treatments.R index 5e22285e837..d75f6b20b3a 100644 --- a/base/db/R/assign.treatments.R +++ b/base/db/R/assign.treatments.R @@ -13,7 +13,7 @@ ##' Assigns all control treatments the same value, then assigns unique treatments ##' within each site. Each site is required to have a control treatment. ##' The algorithm (incorrectly) assumes that each site has a unique set of experimental -##' treatments. This assumption is required by the data in BETTdb that does not always consistently name treatments or quantity them in the managements table. Also it avoids having the need to estimate treatment by site interactions in the meta analysis model. This model uses data in the control treatment to estimate model parameters so the impact of the assumption is minimal. +##' treatments. This assumption is required by the data in BETYdb that does not always consistently name treatments or quantity them in the managements table. Also it avoids having the need to estimate treatment by site interactions in the meta analysis model. This model uses data in the control treatment to estimate model parameters so the impact of the assumption is minimal. ##' @name assign.treatments ##' @title assign.treatments ##' @param data input data diff --git a/base/db/man/assign.treatments.Rd b/base/db/man/assign.treatments.Rd index 30365dc8468..c1b6509217d 100644 --- a/base/db/man/assign.treatments.Rd +++ b/base/db/man/assign.treatments.Rd @@ -19,7 +19,7 @@ Change treatments to sequential integers Assigns all control treatments the same value, then assigns unique treatments within each site. Each site is required to have a control treatment. The algorithm (incorrectly) assumes that each site has a unique set of experimental -treatments. This assumption is required by the data in BETTdb that does not always consistently name treatments or quantity them in the managements table. Also it avoids having the need to estimate treatment by site interactions in the meta analysis model. This model uses data in the control treatment to estimate model parameters so the impact of the assumption is minimal. +treatments. This assumption is required by the data in BETYdb that does not always consistently name treatments or quantity them in the managements table. Also it avoids having the need to estimate treatment by site interactions in the meta analysis model. This model uses data in the control treatment to estimate model parameters so the impact of the assumption is minimal. } \author{ David LeBauer, Carl Davidson, Alexey Shiklomanov diff --git a/base/db/tests/testthat/test.assign.treatments.R b/base/db/tests/testthat/test.assign.treatments.R new file mode 100644 index 00000000000..a51c40f4804 --- /dev/null +++ b/base/db/tests/testthat/test.assign.treatments.R @@ -0,0 +1,33 @@ +test_that("`assign.treatments` correctly assigns control treatment", { + data <- data.frame( + site_id = c(1, 1, 2, 2, 3, 3), + citation_id = c(101, 101, 201, 201, 301, 301), + control = c(1, 0, 0, 1, 0, 0), + trt_id = NA + ) + + updated_data <- assign.treatments(data) + expect_equal(updated_data$trt_id, c("control", NA, NA, "control", "control", "control")) +}) + +test_that("`assign.treatments` gives an error if no control treatment is set for a site", { + data <- data.frame( + site_id = c(1, 1, 2, 2, 3, 3), + citation_id = c(101, 101, 201, 201, 301, 301), + control = c(0, 0, 0, 1, 0, 0), + trt_id = c(NA, NA, NA, NA, "not_control", NA) + ) + + expect_error(assign.treatments(data), "No control treatment set") +}) + +test_that("`drop.columns` able to drop specified columns from data", { + data <- data.frame( + id = c(1, 2, 3), + name = c("a", "b", "c"), + value = c(1.2, 4.5, 6.7) + ) + + updated_data <- drop.columns(data, c("name", "not_a_column")) + expect_equal(colnames(updated_data), c("id", "value")) +}) \ No newline at end of file diff --git a/base/db/tests/testthat/test.check.lists.R b/base/db/tests/testthat/test.check.lists.R new file mode 100644 index 00000000000..e434c29a2e7 --- /dev/null +++ b/base/db/tests/testthat/test.check.lists.R @@ -0,0 +1,23 @@ +test_that("`check.lists` returns false for appropriate cases", { + x <- data.frame(id = c(1, 2, 3)) + y <- data.frame(id = c(1, 2, 3, 4)) + + # for unequal number of rows + expect_false(check.lists(x, y)) + + # for wrong filename passed + expect_false(check.lists(x, y, filename = "wrong.csv")) + + # if x and y are actually unequal + y <- data.frame(id = c(1, 2, 4)) + expect_false(check.lists(x, y, filename = "species.csv")) +}) + +test_that("`check.lists` able to correctly work for matching data frames to lists read from csv files", { + withr::with_tempfile("tf", fileext = ".csv",{ + x <- data.frame(id = c(1, 2, 3)) + y <- data.frame(id = c(1, 2, 3)) + write.csv(y, file = tf) + expect_true(check.lists(x, read.csv(tf), filename = "species.csv")) + }) +}) \ No newline at end of file From 73698d50078f96af4562388f71428e2a7a2036dd Mon Sep 17 00:00:00 2001 From: meetagrawal09 Date: Sat, 10 Jun 2023 22:28:29 +0530 Subject: [PATCH 04/17] tested stamp_started, stamp_finished --- base/db/DESCRIPTION | 4 +++- base/db/tests/testthat/test.stamp.R | 15 +++++++++++++++ 2 files changed, 18 insertions(+), 1 deletion(-) create mode 100644 base/db/tests/testthat/test.stamp.R diff --git a/base/db/DESCRIPTION b/base/db/DESCRIPTION index 0e302137980..37172d20f3d 100644 --- a/base/db/DESCRIPTION +++ b/base/db/DESCRIPTION @@ -66,13 +66,15 @@ Suggests: data.table, here, knitr, + mockery, RPostgreSQL, RPostgres, RSQLite, rcrossref, rmarkdown (>= 2.19), testthat (>= 2.0.0), - tidyverse + tidyverse, + withr X-Comment-Remotes: Installing markdown from GitHub because as of 2023-02-05, this is the easiest way to get version >= 2.19 onto Docker images that use older diff --git a/base/db/tests/testthat/test.stamp.R b/base/db/tests/testthat/test.stamp.R new file mode 100644 index 00000000000..c566e073ee4 --- /dev/null +++ b/base/db/tests/testthat/test.stamp.R @@ -0,0 +1,15 @@ +test_that("`stamp_started()` able to correctly update the query for run_id passed", { + mock_function <- mockery::mock() + mockery::stub(stamp_started, 'PEcAn.DB::db.query', mock_function) + stamp_started(1, 1) + args <- mockery::mock_args(mock_function) + expect_true(grepl("started_at .* WHERE id = 1", args[[1]]$query)) +}) + +test_that("`stamp_finished()` able to correctly update the query for run_id passed", { + mock_function <- mockery::mock() + mockery::stub(stamp_finished, 'PEcAn.DB::db.query', mock_function) + stamp_finished(1, 1) + args <- mockery::mock_args(mock_function) + expect_true(grepl("finished_at .* WHERE id = 1", args[[1]]$query)) +}) \ No newline at end of file From 27e06e3ae5b038114e2d038544b1d3c52b62e3b9 Mon Sep 17 00:00:00 2001 From: meetagrawal09 Date: Sun, 11 Jun 2023 23:34:02 +0530 Subject: [PATCH 05/17] query.priors, query.site --- base/db/tests/testthat/test.query.priors.R | 13 +++++++++++++ base/db/tests/testthat/test.query.site.R | 14 ++++++++++++++ 2 files changed, 27 insertions(+) create mode 100644 base/db/tests/testthat/test.query.priors.R create mode 100644 base/db/tests/testthat/test.query.site.R diff --git a/base/db/tests/testthat/test.query.priors.R b/base/db/tests/testthat/test.query.priors.R new file mode 100644 index 00000000000..4f0311a9e8f --- /dev/null +++ b/base/db/tests/testthat/test.query.priors.R @@ -0,0 +1,13 @@ +test_that("`query.priors()` correctly forms the query based on the parameters passed and returns priors",{ + mocked_function <- mockery::mock(data.frame(name = c("A", "B"), value = c(0.1, 0.2))) + mockery::stub(query.priors, 'db.query', mocked_function) + priors <- query.priors("ebifarm.pavi", c("SLA"), con = 1) + expect_equal(priors, c(0.1, 0.2)) + args <- mockery::mock_args(mocked_function) + expect_true( + grepl( + "WHERE pfts.id = ebifarm.pavi AND variables.name IN .* SLA", + args[[1]]$query + ) + ) +}) \ No newline at end of file diff --git a/base/db/tests/testthat/test.query.site.R b/base/db/tests/testthat/test.query.site.R new file mode 100644 index 00000000000..ec61c210581 --- /dev/null +++ b/base/db/tests/testthat/test.query.site.R @@ -0,0 +1,14 @@ +test_that("`query.site()` correctly forms the query and returns the site", { + mock_site_data <- data.frame(id = c(1), lon = c(1), lat = c(1)) + mocked_function <- mockery::mock(mock_site_data) + mockery::stub(query.site, 'db.query', mocked_function) + site <- query.site(1, con = 1) + expect_equal(site, mock_site_data) + args <- mockery::mock_args(mocked_function) + expect_true( + grepl( + "WHERE id = 1", + args[[1]]$query + ) + ) +}) \ No newline at end of file From a969778a9cd19da3d17fdd8258d8e363886fa4b8 Mon Sep 17 00:00:00 2001 From: meetagrawal09 Date: Tue, 13 Jun 2023 17:38:58 +0530 Subject: [PATCH 06/17] tested:query.data, query.yields & bug fix:query.yields --- base/db/R/query.yields.R | 11 +++++- base/db/tests/testthat/test.query.data.R | 20 ++++++++++ base/db/tests/testthat/test.query.yields.R | 43 ++++++++++++++++++++++ 3 files changed, 72 insertions(+), 2 deletions(-) create mode 100644 base/db/tests/testthat/test.query.data.R create mode 100644 base/db/tests/testthat/test.query.yields.R diff --git a/base/db/R/query.yields.R b/base/db/R/query.yields.R index d28c8bf10dd..416ba462420 100644 --- a/base/db/R/query.yields.R +++ b/base/db/R/query.yields.R @@ -24,13 +24,20 @@ query.yields <- function(trait = 'yield', spstr, extra.columns = '', con = NULL, ids_are_cultivars = FALSE, ...){ member_column <- if (ids_are_cultivars) {"cultivar_id"} else {"specie_id"} + + if(!is.null(extra.columns)) { + if(!is.character(extra.columns) || length(extra.columns) != 1) { + PEcAn.logger::logger.severe("`extra.columns` must be a string") + } + } + query <- paste("select yields.id, yields.citation_id, yields.site_id, treatments.name, yields.date, yields.time, yields.cultivar_id, yields.specie_id, yields.mean, yields.statname, yields.stat, yields.n, variables.name as vname, month(yields.date) as month,", - extra.columns, + if(extra.columns != '') { paste(extra.columns, ",", sep = "") } else {""}, "treatments.control, sites.greenhouse from yields left join treatments on (yields.treatment_id = treatments.id) @@ -38,7 +45,7 @@ query.yields <- function(trait = 'yield', spstr, extra.columns = '', con = NULL, left join variables on (yields.variable_id = variables.id) where ", member_column, " in (", spstr,");", sep = "") if(!trait == 'yield'){ - query <- gsub(");", paste(" and variables.name in ('", trait,"');", sep = ""), query) + query <- gsub(");", paste(") and variables.name in ('", trait,"');", sep = ""), query) } return(fetch.stats2se(connection = con, query = query)) diff --git a/base/db/tests/testthat/test.query.data.R b/base/db/tests/testthat/test.query.data.R new file mode 100644 index 00000000000..87cafba5787 --- /dev/null +++ b/base/db/tests/testthat/test.query.data.R @@ -0,0 +1,20 @@ +test_that("`query.data()` able to correctly form the query and return result in SE", { + mocked_function <- mockery::mock(data.frame(Y=rep(1,5), stat=rep(1,5), n=rep(4,5), mean = rep(3,5), statname=c('SD', 'MSE', 'LSD', 'HSD', 'MSD'))) + mockery::stub(query.data, 'db.query', mocked_function, 2) + result <- query.data(con = 1, trait = "test_trait", spstr = "test_spstr", store.unconverted = TRUE) + args <- mockery::mock_args(mocked_function) + expect_true( + grepl( + paste( + "ST_X\\(ST_CENTROID\\(sites\\.geometry\\)\\) AS lon,", + "ST_Y\\(ST_CENTROID\\(sites\\.geometry\\)\\) AS lat,.*", + "where specie_id in \\(test_spstr\\).*", + "variables.name in \\('test_trait'\\);" + ), + args[[1]]$query + ) + ) + expect_equal(result$mean_unconverted, result$mean) + expect_equal(result$stat_unconverted, result$stat) + expect_equal(result$statname, rep('SE', 5)) +}) \ No newline at end of file diff --git a/base/db/tests/testthat/test.query.yields.R b/base/db/tests/testthat/test.query.yields.R new file mode 100644 index 00000000000..c8a7905d51f --- /dev/null +++ b/base/db/tests/testthat/test.query.yields.R @@ -0,0 +1,43 @@ +test_that("`query.yields()` able to form the query correctly for trait set to 'yield' and with no extra columns", { + mocked_function <- mockery::mock(data.frame(Y=rep(1,5), stat=rep(1,5), n=rep(4,5), mean = rep(3,5), statname=c('SD', 'MSE', 'LSD', 'HSD', 'MSD'))) + mockery::stub(query.yields, 'db.query', mocked_function, 2) + result <- query.yields(spstr = "test_spstr", con = 1) + + args <- mockery::mock_args(mocked_function) + expect_true( + grepl( + paste0( + "month\\(yields.date\\) as month,treatments.control.*", + "where specie_id in \\(test_spstr\\);" + ), + args[[1]]$query + ) + ) +}) + +test_that("`query.yields()` throws an error if extra columns is not a string", { + expect_error( + query.yields(spstr = "test_spstr", con = 1, extra.columns = 1), + "`extra.columns` must be a string" + ) + expect_error( + query.yields(spstr = "test_spstr", con = 1, extra.columns = c("a","b")), + "`extra.columns` must be a string" + ) +}) + +test_that("`query.yields()` able to form the query correctly for trait not equal to 'yield' and with extra columns",{ + mocked_function <- mockery::mock(data.frame(Y=rep(1,5), stat=rep(1,5), n=rep(4,5), mean = rep(3,5), statname=c('SD', 'MSE', 'LSD', 'HSD', 'MSD'))) + mockery::stub(query.yields, 'db.query', mocked_function, 2) + result <- query.yields(trait = 'test_trait', spstr = "test_spstr", extra.columns = 'test_col', con = 1) + args <- mockery::mock_args(mocked_function) + expect_true( + grepl( + paste0( + "month\\(yields.date\\) as month,test_col,treatments.control.*", + "where specie_id in \\(test_spstr\\) and variables.name in \\('test_trait'\\)" + ), + args[[1]]$query + ) + ) +}) \ No newline at end of file From 1c435c5507cafe6ce45914b42e176e24a55cf5a5 Mon Sep 17 00:00:00 2001 From: meetagrawal09 Date: Thu, 15 Jun 2023 20:45:29 +0530 Subject: [PATCH 07/17] tested query.dplyr --- base/db/R/query.dplyr.R | 4 +- base/db/R/query.yields.R | 2 +- base/db/tests/testthat/test.query.dplyr.R | 77 +++++++++++++++++++++++ 3 files changed, 80 insertions(+), 3 deletions(-) create mode 100644 base/db/tests/testthat/test.query.dplyr.R diff --git a/base/db/R/query.dplyr.R b/base/db/R/query.dplyr.R index b0501a9abcb..d1f0a1a401a 100644 --- a/base/db/R/query.dplyr.R +++ b/base/db/R/query.dplyr.R @@ -61,7 +61,7 @@ dplyr.count <- function(df) { #' @param unit string containing CF-style time unit including origin (e.g. "days since 2010-01-01") #' @export ncdays2date <- function(time, unit) { - date <- lubridate::parse_date_time(unit, c("ymd_hms", "ymd_h", "ymd")) + date <- lubridate::parse_date_time(unit, c("ymd_HMS", "ymd_H", "ymd")) days <- PEcAn.utils::ud_convert(time, unit, paste("days since ", date)) seconds <- PEcAn.utils::ud_convert(days, "days", "seconds") return(as.POSIXct.numeric(seconds, origin = date, tz = "UTC")) @@ -124,7 +124,7 @@ workflows <- function(bety, ensemble = FALSE) { #' @export workflow <- function(bety, workflow_id) { workflows(bety) %>% - dplyr::filter(.data$workflow_id == !!.data$workflow_id) + dplyr::filter(.data$workflow_id == !!workflow_id) } # workflow diff --git a/base/db/R/query.yields.R b/base/db/R/query.yields.R index 416ba462420..4f07ef01b74 100644 --- a/base/db/R/query.yields.R +++ b/base/db/R/query.yields.R @@ -45,7 +45,7 @@ query.yields <- function(trait = 'yield', spstr, extra.columns = '', con = NULL, left join variables on (yields.variable_id = variables.id) where ", member_column, " in (", spstr,");", sep = "") if(!trait == 'yield'){ - query <- gsub(");", paste(") and variables.name in ('", trait,"');", sep = ""), query) + query <- gsub(";", paste(" and variables.name in ('", trait,"');", sep = ""), query) } return(fetch.stats2se(connection = con, query = query)) diff --git a/base/db/tests/testthat/test.query.dplyr.R b/base/db/tests/testthat/test.query.dplyr.R new file mode 100644 index 00000000000..52e15f959b4 --- /dev/null +++ b/base/db/tests/testthat/test.query.dplyr.R @@ -0,0 +1,77 @@ +test_that("`fancy_scientific()` converts numbers to scientific expressions with proper formatting", { + result <- fancy_scientific(1234567890) + expect_equal(result, expression("1.234568" %*% 10^+9)) + + result <- fancy_scientific(0.00000123) + expect_equal(result, expression("1.23" %*% 10^-6)) + + result <- fancy_scientific(1e-20) + expect_equal(result, expression("1" %*% 10^-20)) +}) + +test_that("`dplyr.count()` returns the correct count of rows in a dataframe", { + + df <- data.frame( + x = c(1, 2, 3, 2, 1, 3), + y = c("a", "b", "a", "b", "a", "b") + ) + result <- dplyr.count(df) + expect_equal(result, 6) + + df <- data.frame() + result <- dplyr.count(df) + expect_equal(result, 0) +}) + +test_that("`dbHostInfo()` able to return correct host information", { + mockery::stub(dbHostInfo, 'db.query', data.frame(floor = 10)) + mockery::stub( + dbHostInfo, + 'dplyr::tbl', + data.frame( + data.frame( + sync_host_id = c(10, 11), + hostname = c("test_host_1", "test_host_2"), + sync_start = c("20190201", "20190201"), + sync_end = c("20200101", "20200101"), + sync_url = c("http://test_url_1", "http://test_url_2"), + sync_contact = c("test_contact_1", "test_contact_2") + ) + ) + ) + result <- dbHostInfo(bety = 1) + expect_equal(result$hostid, 10) + expect_equal(result$hostname, "test_host_1") + expect_equal(result$start, "20190201") + expect_equal(result$end, "20200101") + expect_equal(result$sync_url, "http://test_url_1") + expect_equal(result$sync_contact, "test_contact_1") +}) + +test_that("`workflows()` able to correctly return a list of workflows", { + mockery::stub( + workflows, + 'dbHostInfo', + list( + hostid = 10, + hostname = "test_host_1", + start = 3, + end = 10, + sync_url = "http://test_url_1", + sync_contact = "test_contact_1" + ) + ) + mockery::stub(workflows, 'dplyr::tbl', data.frame(workflow_id = c(1, 2, 3, 4, 5, 6))) + result <- workflows(bety = 1, ensemble = TRUE) + expect_equal(result, data.frame(workflow_id = c(3, 4, 5, 6))) +}) + +test_that("`workflow()` able to get a workflow data by id", { + mockery::stub( + workflow, + 'workflows', + data.frame(workflow_id = c(1, 2, 3, 4, 5, 6), workflow_name = c("A", "B", "C", "D", "E", "F")) + ) + result <- workflow(bety = 1, workflow_id = 3) + expect_equal(result, data.frame(workflow_id = 3, workflow_name = "C")) +}) \ No newline at end of file From eadfb184b2b3615439c80f659ad82eb74a09ca4a Mon Sep 17 00:00:00 2001 From: meetagrawal09 Date: Thu, 15 Jun 2023 23:04:20 +0530 Subject: [PATCH 08/17] updated mockery version --- base/db/DESCRIPTION | 3 ++- docker/depends/pecan.depends.R | 1 + 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/base/db/DESCRIPTION b/base/db/DESCRIPTION index 37172d20f3d..e8d4f273b84 100644 --- a/base/db/DESCRIPTION +++ b/base/db/DESCRIPTION @@ -82,7 +82,8 @@ X-Comment-Remotes: When building on a system that finds a new enough version on CRAN, OK to remove the Remotes line and this comment. Remotes: - github::rstudio/rmarkdown@v2.20 + github::rstudio/rmarkdown@v2.20, + github::r-lib/mockery@v0.4.3 License: BSD_3_clause + file LICENSE VignetteBuilder: knitr Copyright: Authors diff --git a/docker/depends/pecan.depends.R b/docker/depends/pecan.depends.R index 7b8986b2117..a6349e617eb 100644 --- a/docker/depends/pecan.depends.R +++ b/docker/depends/pecan.depends.R @@ -13,6 +13,7 @@ remotes::install_github(c( 'chuhousen/amerifluxr', 'ebimodeling/biocro@0.951', 'MikkoPeltoniemi/Rpreles', +'r-lib/mockery@v0.4.3' 'r-lib/testthat@v3.1.6', 'r-lib/vdiffr@v1.0.4', 'ropensci/geonames', From 487cbb4d6d8e6ebe4984271fdf6a0ce9e3b15a40 Mon Sep 17 00:00:00 2001 From: meetagrawal09 Date: Thu, 15 Jun 2023 23:06:22 +0530 Subject: [PATCH 09/17] typo fix --- docker/depends/pecan.depends.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docker/depends/pecan.depends.R b/docker/depends/pecan.depends.R index a6349e617eb..68986a3895c 100644 --- a/docker/depends/pecan.depends.R +++ b/docker/depends/pecan.depends.R @@ -13,7 +13,7 @@ remotes::install_github(c( 'chuhousen/amerifluxr', 'ebimodeling/biocro@0.951', 'MikkoPeltoniemi/Rpreles', -'r-lib/mockery@v0.4.3' +'r-lib/mockery@v0.4.3', 'r-lib/testthat@v3.1.6', 'r-lib/vdiffr@v1.0.4', 'ropensci/geonames', From 3f95e7ddd127f37ff139e652b18cea29d031ccd7 Mon Sep 17 00:00:00 2001 From: meetagrawal09 Date: Sat, 24 Jun 2023 10:22:21 +0530 Subject: [PATCH 10/17] tested runs, get_workflow_ids, get_users, get_run_ids --- base/db/tests/testthat/test.query.dplyr.R | 73 ++++++++++++++++++++++- 1 file changed, 72 insertions(+), 1 deletion(-) diff --git a/base/db/tests/testthat/test.query.dplyr.R b/base/db/tests/testthat/test.query.dplyr.R index 52e15f959b4..8be24e8f555 100644 --- a/base/db/tests/testthat/test.query.dplyr.R +++ b/base/db/tests/testthat/test.query.dplyr.R @@ -74,4 +74,75 @@ test_that("`workflow()` able to get a workflow data by id", { ) result <- workflow(bety = 1, workflow_id = 3) expect_equal(result, data.frame(workflow_id = 3, workflow_name = "C")) -}) \ No newline at end of file +}) + +test_that("`runs()` is able to get table of runs for a corresponding workflow", { + mockery::stub( + runs, + 'workflow', + data.frame( + workflow_id = c(1, 1), + folder = c("test_folder_1", "test_folder_2") + ) + ) + mocked_res <- mockery::mock( + data.frame( + id = c(1, 2, 3, 4, 5, 6), + workflow_id = c(1, 1, 3, 4, 5, 6) + ), + data.frame( + id = c(1, 2, 3), + ensemble_id = c(1, 1, 2) + ) + ) + mockery::stub(runs, 'dplyr::tbl', mocked_res) + result <- runs(bety = 1, workflow_id = 1) + expect_equal(result$run_id, c(1, 1, 2, 2, 3, 3)) + expect_equal(result$folder, c("test_folder_1", "test_folder_2", "test_folder_1", "test_folder_2", "test_folder_1", "test_folder_2")) +}) + +test_that("`get_workflow_ids()` able to get a vector of unique workflow IDs", { + mockery::stub( + get_workflow_ids, + 'workflows', + data.frame( + workflow_id = c(1, 2, 2, 3, 4, 4), + workflow_name = c("A", "B", "C", "D", "E", "F") + ) + ) + result <- get_workflow_ids(bety = 1, query = 1, all.ids = TRUE) + expect_equal(result, c(4, 3, 2, 1)) +}) + +test_that("`get_users()` ", { + mockery::stub(get_users, 'dplyr::tbl', data.frame(id = c(20200101, 20200102, 20240103))) + mockery::stub( + get_users, + 'dbHostInfo', + data.frame( + start = 20190201, + end = 20230101 + ) + ) + result <- get_users(bety = 1) + expect_equal(result, data.frame(id = c(20200101, 20200102))) +}) + +test_that("`get_run_ids()` able to get vector of run ids (in sorted order) for a given workflow ID", { + mockery::stub( + get_run_ids, + 'runs', + data.frame( + run_id = c(3, 1, 2), + folder = c("test_folder_1", "test_folder_2", "test_folder_3") + ) + ) + + result <- get_run_ids(bety = 1, workflow_id = 1) + expect_equal(result, c(1, 2, 3)) + + # if no run ids are found + mockery::stub(get_run_ids, 'runs', data.frame()) + result <- get_run_ids(bety = 1, workflow_id = 1) + expect_equal(result, c("No runs found")) +}) From 11152e6986c999bf1d8ad2bc4b58c5e9d583649e Mon Sep 17 00:00:00 2001 From: meetagrawal09 Date: Sat, 1 Jul 2023 19:08:58 +0530 Subject: [PATCH 11/17] query.file.path, utils_db --- base/db/R/dbfiles.R | 12 ++++----- base/db/R/query.file.path.R | 4 +-- base/db/tests/testthat/test.insert.R | 8 ++++++ base/db/tests/testthat/test.query.dplyr.R | 6 +++++ base/db/tests/testthat/test.query.file.path.R | 21 +++++++++++++++ base/db/tests/testthat/test.utils_db.R | 26 +++++++++++++++++++ 6 files changed, 69 insertions(+), 8 deletions(-) create mode 100644 base/db/tests/testthat/test.query.file.path.R create mode 100644 base/db/tests/testthat/test.utils_db.R diff --git a/base/db/R/dbfiles.R b/base/db/R/dbfiles.R index 28509daef8f..e0f9556779b 100644 --- a/base/db/R/dbfiles.R +++ b/base/db/R/dbfiles.R @@ -71,7 +71,7 @@ dbfile.input.insert <- function(in.path, in.prefix, siteid, startdate, enddate, "SELECT * FROM inputs WHERE site_id=", siteid, " AND name= '", name, "' AND format_id=", formatid, - parent + parent, ";" ), con = con ) @@ -120,26 +120,26 @@ dbfile.input.insert <- function(in.path, in.prefix, siteid, startdate, enddate, "INSERT INTO inputs ", "(site_id, format_id, name) VALUES (", siteid, ", ", formatid, ", '", name, - "'", ") RETURNING id" + "'", ") RETURNING id;" ) } else if (parent == "" && !is.null(startdate)) { cmd <- paste0( "INSERT INTO inputs ", "(site_id, format_id, start_date, end_date, name) VALUES (", siteid, ", ", formatid, ", '", startdate, "', '", enddate, "','", name, - "') RETURNING id" + "') RETURNING id;" ) } else if (is.null(startdate)) { cmd <- paste0( "INSERT INTO inputs ", "(site_id, format_id, name, parent_id) VALUES (", - siteid, ", ", formatid, ", '", name, "',", parentid, ") RETURNING id" + siteid, ", ", formatid, ", '", name, "',", parentid, ") RETURNING id;" ) } else { cmd <- paste0( "INSERT INTO inputs ", "(site_id, format_id, start_date, end_date, name, parent_id) VALUES (", - siteid, ", ", formatid, ", '", startdate, "', '", enddate, "','", name, "',", parentid, ") RETURNING id" + siteid, ", ", formatid, ", '", startdate, "', '", enddate, "','", name, "',", parentid, ") RETURNING id;" ) } # This is the id that we just registered @@ -150,7 +150,7 @@ dbfile.input.insert <- function(in.path, in.prefix, siteid, startdate, enddate, inputid <- db.query( query = paste0( "SELECT id FROM inputs WHERE site_id=", siteid, - " AND format_id=", formatid + " AND format_id=", formatid, ";" ), con = con )$id diff --git a/base/db/R/query.file.path.R b/base/db/R/query.file.path.R index 071b6af12b8..ceb79f99685 100644 --- a/base/db/R/query.file.path.R +++ b/base/db/R/query.file.path.R @@ -8,11 +8,11 @@ ##' @author Betsy Cowdery query.file.path <- function(input.id, host_name, con){ machine.host <- PEcAn.DB::default_hostname(host_name) - machine <- db.query(query = paste0("SELECT * from machines where hostname = '",machine.host,"'"), con = con) + machine <- db.query(query = paste0("SELECT * from machines where hostname = '",machine.host,"';"), con = con) dbfile <- db.query( query = paste( "SELECT file_name,file_path from dbfiles where container_id =", input.id, - " and container_type = 'Input' and machine_id =", machine$id + " and container_type = 'Input' and machine_id =", machine$id, ";" ), con = con ) diff --git a/base/db/tests/testthat/test.insert.R b/base/db/tests/testthat/test.insert.R index 95dd80a459e..168bb4f4ae6 100644 --- a/base/db/tests/testthat/test.insert.R +++ b/base/db/tests/testthat/test.insert.R @@ -47,3 +47,11 @@ test_that( } ) }) + +test_that("`match_colnames()` returns intersection of column names of a dataframe to a table", { + mockery::stub(match_colnames, 'dplyr::tbl', data.frame(id = 1, name = 'test', value = 1)) + expect_equal( + match_colnames(values = data.frame(id = 1, name = 'test'), table = 'test', con = 1), + c('id', 'name') + ) +}) \ No newline at end of file diff --git a/base/db/tests/testthat/test.query.dplyr.R b/base/db/tests/testthat/test.query.dplyr.R index 8be24e8f555..cc3e6436eea 100644 --- a/base/db/tests/testthat/test.query.dplyr.R +++ b/base/db/tests/testthat/test.query.dplyr.R @@ -146,3 +146,9 @@ test_that("`get_run_ids()` able to get vector of run ids (in sorted order) for a result <- get_run_ids(bety = 1, workflow_id = 1) expect_equal(result, c("No runs found")) }) + +test_that("`var_names_all()` able get vector of variable names for a particular workflow and run ID removing variables not to be shown to user", { + mockery::stub(var_names_all, 'get_var_names', c('A', 'B', 'C', 'Year','FracJulianDay')) + result <- var_names_all(bety = 1, workflow_id = 1, run_id = 1) + expect_equal(result, c('A', 'B', 'C')) +}) \ No newline at end of file diff --git a/base/db/tests/testthat/test.query.file.path.R b/base/db/tests/testthat/test.query.file.path.R new file mode 100644 index 00000000000..1da98a019e6 --- /dev/null +++ b/base/db/tests/testthat/test.query.file.path.R @@ -0,0 +1,21 @@ +test_that("`query.file.path()`", { + # mock responses for subsequent calls to db.query + mocked_res <- mockery::mock(data.frame(id = '20210101'), data.frame(file_name = 'test_file', file_path = 'test_path')) + mockery::stub(query.file.path, 'db.query', mocked_res) + mockery::stub(query.file.path, 'PEcAn.remote::remote.execute.R', TRUE) + res <- query.file.path(input.id = 1, host_name = "pecan", con = 1) + args <- mockery::mock_args(mocked_res) + expect_true( + grepl( + "where hostname = 'pecan'", + args[[1]]$query + ) + ) + expect_true( + grepl( + "container_id = 1.* machine_id = 20210101", + args[[2]]$query + ) + ) + expect_equal(res, 'test_path/test_file') +}) \ No newline at end of file diff --git a/base/db/tests/testthat/test.utils_db.R b/base/db/tests/testthat/test.utils_db.R new file mode 100644 index 00000000000..f6d83a748c9 --- /dev/null +++ b/base/db/tests/testthat/test.utils_db.R @@ -0,0 +1,26 @@ +test_that("`db.print.connections()` able to log out details about connections", { + PEcAn.logger::logger.setUseConsole(TRUE, FALSE) + on.exit(PEcAn.logger::logger.setUseConsole(TRUE, TRUE), add = TRUE) + expect_output( + db.print.connections(), + paste0( + ".* Created 0 connections and executed 0 queries .* ", + "Created 0 connections and executed 0 queries.*", + "No open database connections." + ) + ) +}) + +test_that("`db.showQueries()` and `db.getShowQueries()` able to set and get the value of the .db.utils$showquery variable respectively", { + showquery_old <- db.getShowQueries() + on.exit(db.showQueries(showquery_old)) + db.showQueries(TRUE) + expect_equal(db.getShowQueries(), TRUE) +}) + +test_that("`default_hostname()` fixes hostname if the host is localhost", { + expect_equal(default_hostname("localhost"), PEcAn.remote::fqdn()) + + # if not localhost + expect_equal(default_hostname("pecan"), "pecan") +}) \ No newline at end of file From 7cb18ca76fc1c647dc1586574aa6568a28d9c3df Mon Sep 17 00:00:00 2001 From: meetagrawal09 Date: Tue, 11 Jul 2023 14:58:06 +0530 Subject: [PATCH 12/17] rolled back test --- base/db/tests/testthat/test.utils_db.R | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/base/db/tests/testthat/test.utils_db.R b/base/db/tests/testthat/test.utils_db.R index f6d83a748c9..b859baea575 100644 --- a/base/db/tests/testthat/test.utils_db.R +++ b/base/db/tests/testthat/test.utils_db.R @@ -1,15 +1,15 @@ -test_that("`db.print.connections()` able to log out details about connections", { - PEcAn.logger::logger.setUseConsole(TRUE, FALSE) - on.exit(PEcAn.logger::logger.setUseConsole(TRUE, TRUE), add = TRUE) - expect_output( - db.print.connections(), - paste0( - ".* Created 0 connections and executed 0 queries .* ", - "Created 0 connections and executed 0 queries.*", - "No open database connections." - ) - ) -}) +# test_that("`db.print.connections()` able to log out details about connections", { +# PEcAn.logger::logger.setUseConsole(TRUE, FALSE) +# on.exit(PEcAn.logger::logger.setUseConsole(TRUE, TRUE), add = TRUE) +# expect_output( +# db.print.connections(), +# paste0( +# ".* Created 0 connections and executed 0 queries .* ", +# "Created 0 connections and executed 0 queries.*", +# "No open database connections." +# ) +# ) +# }) test_that("`db.showQueries()` and `db.getShowQueries()` able to set and get the value of the .db.utils$showquery variable respectively", { showquery_old <- db.getShowQueries() From 6108996e9e8bd3cea65e6c15dd3ac315257c3fb1 Mon Sep 17 00:00:00 2001 From: meetagrawal09 Date: Thu, 17 Aug 2023 18:35:34 +0530 Subject: [PATCH 13/17] tested convert_input, .get.file.deletion.commands --- base/db/tests/testthat/test.convert_input.R | 39 +++++++++++++++++++++ 1 file changed, 39 insertions(+) create mode 100644 base/db/tests/testthat/test.convert_input.R diff --git a/base/db/tests/testthat/test.convert_input.R b/base/db/tests/testthat/test.convert_input.R new file mode 100644 index 00000000000..29513187c9e --- /dev/null +++ b/base/db/tests/testthat/test.convert_input.R @@ -0,0 +1,39 @@ +test_that("`convert_input()` able to call the respective download function for a data item with the correct arguments", { + mocked_res <- mockery::mock(list(c("A", "B"))) + + mockery::stub(convert_input, 'dbfile.input.check', data.frame()) + mockery::stub(convert_input, 'db.query', data.frame(id = 1)) + mockery::stub(convert_input, 'PEcAn.remote::remote.execute.R', mocked_res) + mockery::stub(convert_input, 'purrr::map_dfr', data.frame(missing = c(FALSE), empty = c(FALSE))) + + convert_input( + input.id = NA, + outfolder = "test", + formatname = NULL, + mimetype = NULL, + site.id = 1, + start_date = "2011-01-01", + end_date = "2011-12-31", + pkg = 'PEcAn.data.atmosphere', + fcn = 'download.AmerifluxLBL', + con = NULL, + host = data.frame(name = "localhost"), + browndog = NULL, + write = FALSE, + lat.in = 40, + lon.in = -88 + ) + + args <- mockery::mock_args(mocked_res) + expect_equal( + args[[1]]$script, + "PEcAn.data.atmosphere::download.AmerifluxLBL(lat.in=40, lon.in=-88, overwrite=FALSE, outfolder='test/', start_date='2011-01-01', end_date='2011-12-31')" + ) +}) + +test_that("`.get.file.deletion.commands()` able to return correct file deletion commands", { + res <- .get.file.deletion.commands(c("test")) + expect_equal(res$move.to.tmp, "dir.create(c('./tmp'), recursive=TRUE, showWarnings=FALSE); file.rename(from=c('test'), to=c('./tmp/test'))") + expect_equal(res$delete.tmp, "unlink(c('./tmp'), recursive=TRUE)") + expect_equal(res$replace.from.tmp, "file.rename(from=c('./tmp/test'), to=c('test'));unlink(c('./tmp'), recursive=TRUE)") +}) \ No newline at end of file From f794da8e2c0ddb88262bcfd57037ceeb97202e62 Mon Sep 17 00:00:00 2001 From: meetagrawal09 Date: Fri, 18 Aug 2023 15:47:18 +0530 Subject: [PATCH 14/17] tested dbfile.check, dbfile.file, dbfile.id --- base/db/tests/testthat/test.dbfiles.R | 44 +++++++++++++++++++++++++++ 1 file changed, 44 insertions(+) create mode 100644 base/db/tests/testthat/test.dbfiles.R diff --git a/base/db/tests/testthat/test.dbfiles.R b/base/db/tests/testthat/test.dbfiles.R new file mode 100644 index 00000000000..02fc2401fb9 --- /dev/null +++ b/base/db/tests/testthat/test.dbfiles.R @@ -0,0 +1,44 @@ +test_that("`dbfile.check()` able to return the most recent entries from `dbfiles` table associated with a container and machine", { + mockery::stub(dbfile.check, 'get.id', 1) + mockery::stub( + dbfile.check, + 'dplyr::tbl', + data.frame( + container_type = c('Input', 'Input', 'Model'), + container_id = c(7, 7, 7), + machine_id = c(1, 1, 2), + updated_at = c(20201112, 20210101, 20210102), + id = c(2, 3, 4), + filename = c('test_1', 'test_2', 'test_3'), + pathname = c('path_1', 'path_2', 'path_3') + ) + ) + res <- dbfile.check("Input", 7, con = NULL) + + expect_equal( + res, + data.frame(container_type = 'Input', container_id = 7, machine_id = 1, updated_at = 20210101, id = 3, filename = 'test_2', pathname = 'path_2') + ) +}) + +test_that("`dbfile.file()` able to return a correctly formed file path from entries in the `dbfiles` table for a particular container and machine", { + mockery::stub(dbfile.file, 'dbfile.check', data.frame(file_path = 'test/dir/path', file_name = 'test_file')) + expect_equal(dbfile.file('Input', 7, con = NULL), file.path('test/dir/path/test_file')) +}) + +test_that("`dbfile.id()` able to construct a correct database query to get id for a dbfile given the container type and filepath", { + mocked_res <- mockery::mock(data.frame(id = 1), data.frame(container_id = 2020)) + mockery::stub(dbfile.id, 'db.query', mocked_res) + + res <- dbfile.id('Model', '/usr/local/bin/sipnet', con = NULL) + args <- mockery::mock_args(mocked_res) + + expect_equal(res, 2020) + expect_true( + grepl( + "WHERE container_type='Model' AND file_path='/usr/local/bin' AND file_name='sipnet' AND machine_id=1", + args[[2]]$query + ) + ) +}) + From 92cada9a10b8525a4b75a23531c172b4739c23ca Mon Sep 17 00:00:00 2001 From: meetagrawal09 Date: Fri, 18 Aug 2023 17:35:43 +0530 Subject: [PATCH 15/17] tested dbfile.posterior.insert, dbfile.posterior.check, dbfile.insert --- base/db/tests/testthat/test.dbfiles.R | 41 ++++++++++++++++++++++++++- 1 file changed, 40 insertions(+), 1 deletion(-) diff --git a/base/db/tests/testthat/test.dbfiles.R b/base/db/tests/testthat/test.dbfiles.R index 02fc2401fb9..9dff33cc895 100644 --- a/base/db/tests/testthat/test.dbfiles.R +++ b/base/db/tests/testthat/test.dbfiles.R @@ -1,3 +1,43 @@ +test_that("`dbfile.posterior.insert()` able to make a correct query to insert a file into dbfiles table as a posterior", { + mocked_res <- mockery::mock(NULL, NULL, data.frame(id = 10)) + mockery::stub(dbfile.posterior.insert, 'get.id', 1) + mockery::stub(dbfile.posterior.insert, 'dbfile.insert', 1010) + mockery::stub(dbfile.posterior.insert, 'db.query', mocked_res) + + dbfile.posterior.insert('trait.data.Rdata', 'test-pft', 'application/x-RData', 'traits', con = NULL) + args <- mockery::mock_args(mocked_res) + expect_true(grepl("INSERT INTO posteriors \\(pft_id, format_id\\) VALUES \\(1, 1\\)", args[[2]]$query)) + +}) + +test_that("`dbfile.posterior.check()` able to form the correct query to retrieve correct posterior id to run further checks", { + mocked_res <- mockery::mock(data.frame(id = 2020)) + mockery::stub(dbfile.posterior.check, 'get.id', 1) + mockery::stub(dbfile.posterior.check, 'db.query', mocked_res) + mockery::stub(dbfile.posterior.check, 'dbfile.check', data.frame(id = 1, filename = 'test_1', pathname = 'path_1')) + + dbfile.posterior.check('testpft', 'application/x-RData', 'traits', con = NULL) + + args <- mockery::mock_args(mocked_res) + expect_true( + grepl( + "SELECT id FROM posteriors WHERE pft_id=1 AND format_id=1", + args[[1]]$query + ) + ) +}) + +test_that("`dbfile.insert()` able to add correct parameter values to the insert database query and return a file id", { + mocked_res <- mockery::mock(data.frame(), data.frame(id = 2020)) + mockery::stub(dbfile.insert, 'get.id', 1) + mockery::stub(dbfile.insert, 'db.query', mocked_res) + + res <- dbfile.insert(in.path = '/test/file/path', in.prefix = 'testfile.txt', 'Input', 7, con = NULL) + args <- mockery::mock_args(mocked_res) + expect_equal(res, 2020) + expect_true(grepl("VALUES \\('Input', 7, 'testfile.txt', '/test/file/path', 1\\) RETURNING id", args[[2]]$query)) +}) + test_that("`dbfile.check()` able to return the most recent entries from `dbfiles` table associated with a container and machine", { mockery::stub(dbfile.check, 'get.id', 1) mockery::stub( @@ -41,4 +81,3 @@ test_that("`dbfile.id()` able to construct a correct database query to get id fo ) ) }) - From 33c3f7fcc10dc8bb3a4439b347296d2ad0c29655 Mon Sep 17 00:00:00 2001 From: meetagrawal09 Date: Fri, 18 Aug 2023 18:57:04 +0530 Subject: [PATCH 16/17] tested dbfile.input.insert, dbfile.input.check --- base/db/tests/testthat/test.dbfiles.R | 69 ++++++++++++++++++++++++++- 1 file changed, 68 insertions(+), 1 deletion(-) diff --git a/base/db/tests/testthat/test.dbfiles.R b/base/db/tests/testthat/test.dbfiles.R index 9dff33cc895..4880a074cd8 100644 --- a/base/db/tests/testthat/test.dbfiles.R +++ b/base/db/tests/testthat/test.dbfiles.R @@ -1,3 +1,70 @@ +test_that("`dbfile.input.insert()` able to create correct sql queries to insert a file into dbfiles table", { + + mocked_res <- mockery::mock(data.frame(), 1, data.frame(id = 2023)) + mockery::stub(dbfile.input.insert, 'get.id', 1) + mockery::stub(dbfile.input.insert, 'db.query', mocked_res) + mockery::stub( + dbfile.input.insert, + 'dbfile.check', + data.frame(id = 101, file_name = 'test-file', file_path = 'trait.data.Rdata') + ) + + res <- dbfile.input.insert( + in.path = 'trait.data.Rdata', + in.prefix = 'test-file', + siteid = 'test-site', + startdate = '2021-01-01', + enddate = '2022-01-01', + mimetype = 'application/x-RData', + formatname = 'traits', + con = NULL + ) + + expect_equal(res$dbfile.id, 101) + expect_equal(res$input.id, 2023) + args <- mockery::mock_args(mocked_res) + + # finding appropriate input + expect_true( + grepl( + "WHERE site_id=test-site AND name= 'trait.data.Rdata' AND format_id=1;", + args[[1]]$query + ) + ) + + # parent == "" and startdate not NULL + expect_true( + grepl( + "VALUES \\(test-site, 1, '2021-01-01', '2022-01-01','trait.data.Rdata'\\)", + args[[2]]$query + ) + ) + + # startdate not NULL + expect_true( + grepl( + "WHERE site_id=test-site AND format_id=1 AND start_date='2021-01-01' AND end_date='2022-01-01'", + args[[3]]$query + ) + ) +}) + +test_that("`dbfile.input.check()` able to form the right query to check the dbfiles table to see if a file exists as an input", { + + mocked_res <- mockery::mock(NULL) + mockery::stub(dbfile.input.check, 'get.id', 1) + mockery::stub(dbfile.input.check, 'db.query', mocked_res) + + dbfile.input.check('US-Akn', '2021-01-01', '2022-01-01', 'application/x-RData', 'traits', con = NULL) + args <- mockery::mock_args(mocked_res) + expect_true( + grepl( + "WHERE site_id=US-Akn AND format_id=1", + args[[1]]$query + ) + ) +}) + test_that("`dbfile.posterior.insert()` able to make a correct query to insert a file into dbfiles table as a posterior", { mocked_res <- mockery::mock(NULL, NULL, data.frame(id = 10)) mockery::stub(dbfile.posterior.insert, 'get.id', 1) @@ -80,4 +147,4 @@ test_that("`dbfile.id()` able to construct a correct database query to get id fo args[[2]]$query ) ) -}) +}) \ No newline at end of file From a5612f9312830c79df060faa8d28be0b8fe422f5 Mon Sep 17 00:00:00 2001 From: meetagrawal09 Date: Sun, 27 Aug 2023 10:01:38 +0530 Subject: [PATCH 17/17] tested met_inputs --- base/db/tests/testthat/test.met_inputs.R | 10 ++++++++++ 1 file changed, 10 insertions(+) create mode 100644 base/db/tests/testthat/test.met_inputs.R diff --git a/base/db/tests/testthat/test.met_inputs.R b/base/db/tests/testthat/test.met_inputs.R new file mode 100644 index 00000000000..49d75b7b379 --- /dev/null +++ b/base/db/tests/testthat/test.met_inputs.R @@ -0,0 +1,10 @@ +test_that("`met_inputs()` able to correctly place input parameters in the database query to retrieve available met inputs", { + mocked_res <- mockery::mock(0) + mockery::stub(met_inputs, 'db.query', mocked_res) + met_inputs(dbcon = NULL, site_id = 100, model_id = 200, hostname = "pecan") + args <- mockery::mock_args(mocked_res) + + expect_true( + grepl("inputs.site_id = \\$1.*machines.hostname = \\$2.*models.id = \\$3", args[[1]][[1]]) + ) +}) \ No newline at end of file