Merge pull request #2223 from etiennebr/force-field-type

Force field type when appending to unexisting table (Fix #2206)

NAMESPACE

@@ -565,5 +565,6 @@ importFrom(utils,packageVersion)
 importFrom(utils,str)
 importFrom(utils,tail)
 importMethodsFrom(DBI,dbDataType)
+importMethodsFrom(DBI,dbExistsTable)
 importMethodsFrom(DBI,dbWriteTable)
 useDynLib(sf, .registration=TRUE)

R/db.R

@@ -466,22 +466,27 @@ setMethod("dbWriteTable", c("PostgreSQLConnection", "character", "sf"),
 #' to PostgreSQL. See `dbDataType()` for details.
 #' @md
 #' @rdname dbWriteTable
-#' @importMethodsFrom DBI dbWriteTable
+#' @importMethodsFrom DBI dbWriteTable dbExistsTable
 #' @export
 setMethod("dbWriteTable", c("DBIObject", "character", "sf"),
-          function(conn, name, value, ..., row.names = FALSE, overwrite = FALSE,
-                   append = FALSE, field.types = NULL, binary = TRUE) {
-          	if (is.null(field.types)) field.types <- dbDataType(conn, value)
-              # DBI cannot set field types with append
-              if (append) field.types <- NULL
-              #tryCatch({
-                  dbWriteTable(conn, name, to_postgis(conn, value, binary),..., row.names = row.names,
-                               overwrite = overwrite, append = append,
-                               field.types = field.types)
-              # }, warning=function(w) {
-              #     stop(conditionMessage(w), call. = FALSE)  # nocov
-              # })
-          }
+		  function(conn, name, value, ..., row.names = FALSE, overwrite = FALSE,
+		  		 append = FALSE, field.types = NULL, binary = TRUE) {
+		  	if (is.null(field.types)) field.types <- dbDataType(conn, value)
+
+		   	# DBI cannot set field types with append, but if the table does not exist,
+		  	# we need to set the field type.
+		  	if (append) {
+		  		if (!dbExistsTable(conn, name)) {
+		  			append <- FALSE
+		  		} else {
+		  			field.types <- NULL
+		  		}
+		  	}
+
+		  	dbWriteTable(conn, name, to_postgis(conn, value, binary),..., row.names = row.names,
+		  				 overwrite = overwrite, append = append,
+		  				 field.types = field.types)
+		  }
 )
 
 to_postgis <- function(conn, x, binary) {

tests/testthat/test_postgis_RPostgres.R

@@ -69,6 +69,15 @@ test_that("can write to db", {
     expect_silent(write_sf(pts, pg, "sf_meuse__", delete_layer = TRUE))
 })
 
+test_that("can create a missing table even if append is TRUE (#2206)", {
+	skip_if_not(can_con(pg), "could not connect to postgis database")
+	x <- st_sf(geometry = st_sfc(st_point(1:2)))
+	dbWriteTable(pg, "x", x, append = TRUE, temporary = TRUE)
+	col_type <- dbGetQuery(pg, "SELECT pg_typeof(geometry) as col_type FROM x")
+	expect_equal(unclass(col_type[["col_type"]]), "geometry")
+	dbExecute(pg, "drop table if exists x")
+})
+
 test_that("can handle multiple geom columns", {
     skip_if_not(can_con(pg), "could not connect to postgis database")
     multi <- cbind(pts[["geometry"]], st_transform(pts, 4326))