Resolve "`CreateGRiwrm` crashes when keeping all columns and rename some"

Closes #64 (closed)

R/CreateGRiwrm.R

@@ -50,7 +50,8 @@ CreateGRiwrm <- function(db,
                         down = "character",
                         length = "double",
                         model = "character",
-                        area = "double"))
+                        area = "double"),
+                   keep_all)
   checkNetworkConsistency(db)
 
   class(db) <- c("GRiwrm", class(db))
@@ -61,6 +62,7 @@ CreateGRiwrm <- function(db,
 #'
 #' @param df [data.frame] to check
 #' @param coltypes named [list] with the name of the columns to check as key and the required type as value
+#' @param keep_all [logical] if `df` contains extra columns
 #'
 #' @return [NULL] or error message if a wrong type is detected
 
@@ -70,17 +72,19 @@ CreateGRiwrm <- function(db,
 #'   list(string = "character", numeric = "double")
 #' )
 #' @noRd
-CheckColumnTypes <- function(df, coltypes) {
+CheckColumnTypes <- function(df, coltypes, keep_all) {
   lapply(names(df), function(x) {
-    if (typeof(df[[x]]) != coltypes[[x]]) {
-      stop(
-        sprintf(
-          "The '%s' column is of type %s, a column of type %s is required",
-          x,
-          typeof(df[[x]]),
-          coltypes[[x]]
+    if (x %in% names(coltypes)) {
+      if (typeof(df[[x]]) != coltypes[[x]]) {
+        stop(
+          sprintf(
+            "The '%s' column is of type %s, a column of type %s is required",
+            x,
+            typeof(df[[x]]),
+            coltypes[[x]]
+          )
         )
-      )
+      }
     }
   })
   return(NULL)

tests/testthat/test-createGRiwrm.R

+test_that("extra columns work (#64)", {
+  text = "id_amont	lambert2.x	lambert2.y	area	nom	id_aval	distance_aval	model
+H8100021	537912.994	2455749.314	64420.94	La Seine à Vernon	NA	NA	RunModel_CemaNeigeGR4J
+H7900010	578113	2437649	61642.28	La Seine à Poissy	H8100021	76.28	RunModel_CemaNeigeGR4J
+H5920010	602213	2427449	43824.66	La Seine à Paris [Austerlitz après création lacs]	H7900010	82.26	RunModel_CemaNeigeGR4J"
+
+  BS_reseau <- read.csv(text = text, sep = "\t")
+
+  expect_s3_class(CreateGRiwrm(
+    BS_reseau,
+    cols = list(
+      id = "id_amont",
+      down = "id_aval",
+      length = "distance_aval"
+    ),
+    keep_all = TRUE
+  ),
+  "GRiwrm")
+
+})