From 04141e89a523e6f4809829096c04bc05b73de9c4 Mon Sep 17 00:00:00 2001
From: David <david.dorchies@inrae.fr>
Date: Mon, 2 Dec 2024 17:12:17 +0100
Subject: [PATCH] tests(Runmodel.Supervision): missing attributes for GR models
Refs #177
---
tests/testthat/test-RunModel.R | 12 ------------
tests/testthat/test-RunModel.Supervisor.R | 16 ++++++++++++++++
2 files changed, 16 insertions(+), 12 deletions(-)
diff --git a/tests/testthat/test-RunModel.R b/tests/testthat/test-RunModel.R
index db0a522..971a86f 100644
--- a/tests/testthat/test-RunModel.R
+++ b/tests/testthat/test-RunModel.R
@@ -32,18 +32,6 @@ test_that("RunModel.GRiwrmInputsModel should return same result with separated w
})
})
-test_that("RunModel.Supervisor with no regulation should returns same results as RunModel.GRiwrmInputsModel", {
- sv <- CreateSupervisor(InputsModel)
- OM_Supervisor <- RunModel(
- sv,
- RunOptions = RunOptions,
- Param = ParamMichel
- )
- lapply(griwrm$id, function(id) {
- expect_equal(OM_Supervisor[[!!id]]$Qsim, OM_GriwrmInputs[[!!id]]$Qsim)
- })
-})
-
test_that("RunModel.GRiwrmInputsModel handles CemaNeige", {
l <- setUpCemaNeigeData()
l$griwrm[l$griwrm$id == "Down", "model"] <- "RunModel_GR4J"
diff --git a/tests/testthat/test-RunModel.Supervisor.R b/tests/testthat/test-RunModel.Supervisor.R
index 07c2e55..3fae05c 100644
--- a/tests/testthat/test-RunModel.Supervisor.R
+++ b/tests/testthat/test-RunModel.Supervisor.R
@@ -6,6 +6,22 @@ e <- setupRunModel()
# https://stackoverflow.com/questions/9965577/r-copy-move-one-environment-to-another
for(x in ls(e)) assign(x, get(x, e))
+test_that("RunModel.Supervisor with no regulation should returns same results as RunModel.GRiwrmInputsModel", {
+ sv <- CreateSupervisor(InputsModel)
+ OM_Supervisor <- RunModel(
+ sv,
+ RunOptions = RunOptions,
+ Param = ParamMichel
+ )
+ lapply(griwrm$id, function(id) {
+ expect_equal(sort(names(OM_GriwrmInputs[[!!id]])),
+ sort(names(OM_Supervisor[[!!id]])))
+ lapply(names(OM_Supervisor[[id]]), function(x) {
+ expect_equal(OM_Supervisor[[!!id]][[!!x]], OM_GriwrmInputs[[!!id]][[!!x]])
+ })
+ }) |> invisible()
+})
+
# Add 2 nodes to the network
nodes2 <- rbind(nodes,
data.frame(
--
GitLab