From 5ea08975667f7af591329128c96e4c923799351c Mon Sep 17 00:00:00 2001
From: David <david.dorchies@inrae.fr>
Date: Fri, 17 Feb 2023 18:07:09 +0100
Subject: [PATCH] test: Add test for crash with ungauged node and upstream
Diversion node
This commit is going to crash!!!
Refs #113
---
tests/testthat/test-RunModel_Ungauged.R | 29 +++++++++++++++++++++++++
1 file changed, 29 insertions(+)
diff --git a/tests/testthat/test-RunModel_Ungauged.R b/tests/testthat/test-RunModel_Ungauged.R
index 54b1335..02e4d98 100644
--- a/tests/testthat/test-RunModel_Ungauged.R
+++ b/tests/testthat/test-RunModel_Ungauged.R
@@ -54,3 +54,32 @@ test_that("RunModel_Ungauged works with a diversion as donor (#110)", {
OCdiv <- Calibration(InputsModel, RunOptions, IC, CO)
expect_equal(OCdiv, OC)
})
+
+test_that("RunModel_Ungauged works with a diversion as upstream node (#113)", {
+ nodes <- loadSevernNodes()
+ nodes <- nodes[!nodes$id %in% c("54002", "54057"), ]
+ nodes[nodes$id == "54032", c("down", "length")] <- c(NA, NA)
+ nodes$model[nodes$id == "54001"] <- "Ungauged"
+ nodes <- rbind(nodes,
+ data.frame(id = "54095", down = "54029", length = 30, area = NA, model = "Diversion"))
+ g <- CreateGRiwrm(nodes)
+ Qobs2 <- matrix(0, ncol = 1, nrow = 11536)
+ colnames(Qobs2) <- "54095"
+ e <- setupRunModel(griwrm = g, runRunModel = FALSE, Qobs2 = Qobs2)
+ for(x in ls(e)) assign(x, get(x, e))
+ np <- getAllNodesProperties(griwrm)
+
+ IC <- CreateInputsCrit(
+ InputsModel,
+ FUN_CRIT = ErrorCrit_KGE2,
+ RunOptions = RunOptions,
+ Obs = Qobs[IndPeriod_Run, np$id[np$RunOff & np$calibration == "Gauged"], drop = FALSE],
+ AprioriIds = c("54032" = "54029"),
+ transfo = "sqrt",
+ k = 0.15
+ )
+
+ CO <- CreateCalibOptions(InputsModel)
+ OCdiv <- Calibration(InputsModel, RunOptions, IC, CO)
+ expect_s3_class(OCdiv, "GRiwrmOutputsCalib")
+})
--
GitLab