diff --git a/R/RcppExports.R b/R/RcppExports.R index 79db9a701..870e2f1dd 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -29,8 +29,8 @@ CPL_get_layers <- function(datasource, options, do_count = FALSE) { .Call('_sf_CPL_get_layers', PACKAGE = 'sf', datasource, options, do_count) } -CPL_read_ogr <- function(datasource, layer, options, quiet, toTypeUser, promote_to_multi = TRUE, int64_as_string = FALSE) { - .Call('_sf_CPL_read_ogr', PACKAGE = 'sf', datasource, layer, options, quiet, toTypeUser, promote_to_multi, int64_as_string) +CPL_read_ogr <- function(datasource, layer, query, options, quiet, toTypeUser, promote_to_multi = TRUE, int64_as_string = FALSE) { + .Call('_sf_CPL_read_ogr', PACKAGE = 'sf', datasource, layer, query, options, quiet, toTypeUser, promote_to_multi, int64_as_string) } CPL_gdalinfo <- function(obj, options) { diff --git a/R/read.R b/R/read.R index cb1cec43d..ea2e1dc83 100644 --- a/R/read.R +++ b/R/read.R @@ -105,7 +105,7 @@ st_read.default = function(dsn, layer, ...) { #' to the current working directory (see \link{getwd}). "Shapefiles" consist of several files with the same basename #' that reside in the same directory, only one of them having extension \code{.shp}. #' @export -st_read.character = function(dsn, layer, ..., options = NULL, quiet = FALSE, geometry_column = 1L, type = 0, +st_read.character = function(dsn, layer, ..., query = NA, options = NULL, quiet = FALSE, geometry_column = 1L, type = 0, promote_to_multi = TRUE, stringsAsFactors = default.stringsAsFactors(), int64_as_string = FALSE, check_ring_dir = FALSE) { @@ -120,7 +120,7 @@ st_read.character = function(dsn, layer, ..., options = NULL, quiet = FALSE, geo if (length(promote_to_multi) > 1) stop("`promote_to_multi' should have length one, and applies to all geometry columns") - x = CPL_read_ogr(dsn, layer, as.character(options), quiet, type, promote_to_multi, int64_as_string) + x = CPL_read_ogr(dsn, layer, query, as.character(options), quiet, type, promote_to_multi, int64_as_string) which.geom = which(vapply(x, function(f) inherits(f, "sfc"), TRUE)) diff --git a/inst/include/sf_RcppExports.h b/inst/include/sf_RcppExports.h index 21aa39db0..3100161ff 100644 --- a/inst/include/sf_RcppExports.h +++ b/inst/include/sf_RcppExports.h @@ -38,8 +38,6 @@ namespace sf { } if (rcpp_result_gen.inherits("interrupted-error")) throw Rcpp::internal::InterruptedException(); - if (Rcpp::internal::isLongjumpSentinel(rcpp_result_gen)) - throw Rcpp::LongjumpException(rcpp_result_gen); if (rcpp_result_gen.inherits("try-error")) throw Rcpp::exception(Rcpp::as(rcpp_result_gen).c_str()); return Rcpp::as(rcpp_result_gen); @@ -59,8 +57,6 @@ namespace sf { } if (rcpp_result_gen.inherits("interrupted-error")) throw Rcpp::internal::InterruptedException(); - if (Rcpp::internal::isLongjumpSentinel(rcpp_result_gen)) - throw Rcpp::LongjumpException(rcpp_result_gen); if (rcpp_result_gen.inherits("try-error")) throw Rcpp::exception(Rcpp::as(rcpp_result_gen).c_str()); return Rcpp::as(rcpp_result_gen); diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp index 789c03283..6114ab5b2 100644 --- a/src/RcppExports.cpp +++ b/src/RcppExports.cpp @@ -92,19 +92,20 @@ BEGIN_RCPP END_RCPP } // CPL_read_ogr -Rcpp::List CPL_read_ogr(Rcpp::CharacterVector datasource, Rcpp::CharacterVector layer, Rcpp::CharacterVector options, bool quiet, Rcpp::NumericVector toTypeUser, bool promote_to_multi, bool int64_as_string); -RcppExport SEXP _sf_CPL_read_ogr(SEXP datasourceSEXP, SEXP layerSEXP, SEXP optionsSEXP, SEXP quietSEXP, SEXP toTypeUserSEXP, SEXP promote_to_multiSEXP, SEXP int64_as_stringSEXP) { +Rcpp::List CPL_read_ogr(Rcpp::CharacterVector datasource, Rcpp::CharacterVector layer, Rcpp::CharacterVector query, Rcpp::CharacterVector options, bool quiet, Rcpp::NumericVector toTypeUser, bool promote_to_multi, bool int64_as_string); +RcppExport SEXP _sf_CPL_read_ogr(SEXP datasourceSEXP, SEXP layerSEXP, SEXP querySEXP, SEXP optionsSEXP, SEXP quietSEXP, SEXP toTypeUserSEXP, SEXP promote_to_multiSEXP, SEXP int64_as_stringSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type datasource(datasourceSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type layer(layerSEXP); + Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type query(querySEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type options(optionsSEXP); Rcpp::traits::input_parameter< bool >::type quiet(quietSEXP); Rcpp::traits::input_parameter< Rcpp::NumericVector >::type toTypeUser(toTypeUserSEXP); Rcpp::traits::input_parameter< bool >::type promote_to_multi(promote_to_multiSEXP); Rcpp::traits::input_parameter< bool >::type int64_as_string(int64_as_stringSEXP); - rcpp_result_gen = Rcpp::wrap(CPL_read_ogr(datasource, layer, options, quiet, toTypeUser, promote_to_multi, int64_as_string)); + rcpp_result_gen = Rcpp::wrap(CPL_read_ogr(datasource, layer, query, options, quiet, toTypeUser, promote_to_multi, int64_as_string)); return rcpp_result_gen; END_RCPP } @@ -878,10 +879,6 @@ RcppExport SEXP _sf_CPL_read_wkb(SEXP wkb_listSEXP, SEXP EWKBSEXP, SEXP spatiali UNPROTECT(1); Rf_onintr(); } - bool rcpp_isLongjump_gen = Rcpp::internal::isLongjumpSentinel(rcpp_result_gen); - if (rcpp_isLongjump_gen) { - Rcpp::internal::resumeJump(rcpp_result_gen); - } Rboolean rcpp_isError_gen = Rf_inherits(rcpp_result_gen, "try-error"); if (rcpp_isError_gen) { SEXP rcpp_msgSEXP_gen = Rf_asChar(rcpp_result_gen); @@ -913,10 +910,6 @@ RcppExport SEXP _sf_CPL_write_wkb(SEXP sfcSEXP, SEXP EWKBSEXP) { UNPROTECT(1); Rf_onintr(); } - bool rcpp_isLongjump_gen = Rcpp::internal::isLongjumpSentinel(rcpp_result_gen); - if (rcpp_isLongjump_gen) { - Rcpp::internal::resumeJump(rcpp_result_gen); - } Rboolean rcpp_isError_gen = Rf_inherits(rcpp_result_gen, "try-error"); if (rcpp_isError_gen) { SEXP rcpp_msgSEXP_gen = Rf_asChar(rcpp_result_gen); @@ -953,7 +946,7 @@ static const R_CallMethodDef CallEntries[] = { {"_sf_CPL_gdal_segmentize", (DL_FUNC) &_sf_CPL_gdal_segmentize, 2}, {"_sf_CPL_gdal_linestring_sample", (DL_FUNC) &_sf_CPL_gdal_linestring_sample, 2}, {"_sf_CPL_get_layers", (DL_FUNC) &_sf_CPL_get_layers, 3}, - {"_sf_CPL_read_ogr", (DL_FUNC) &_sf_CPL_read_ogr, 7}, + {"_sf_CPL_read_ogr", (DL_FUNC) &_sf_CPL_read_ogr, 8}, {"_sf_CPL_gdalinfo", (DL_FUNC) &_sf_CPL_gdalinfo, 2}, {"_sf_CPL_gdalwarp", (DL_FUNC) &_sf_CPL_gdalwarp, 3}, {"_sf_CPL_gdalrasterize", (DL_FUNC) &_sf_CPL_gdalrasterize, 3}, diff --git a/src/gdal_read.cpp b/src/gdal_read.cpp index 011bb0a91..57945cd9b 100644 --- a/src/gdal_read.cpp +++ b/src/gdal_read.cpp @@ -183,12 +183,14 @@ Rcpp::List CPL_get_layers(Rcpp::CharacterVector datasource, Rcpp::CharacterVecto } // [[Rcpp::export]] -Rcpp::List CPL_read_ogr(Rcpp::CharacterVector datasource, Rcpp::CharacterVector layer, +Rcpp::List CPL_read_ogr(Rcpp::CharacterVector datasource, Rcpp::CharacterVector layer, + Rcpp::CharacterVector query, Rcpp::CharacterVector options, bool quiet, Rcpp::NumericVector toTypeUser, bool promote_to_multi = true, bool int64_as_string = false) { // adapted from the OGR tutorial @ www.gdal.org std::vector open_options = create_options(options, quiet); GDALDataset *poDS; + poDS = (GDALDataset *) GDALOpenEx( datasource[0], GDAL_OF_VECTOR | GDAL_OF_READONLY, NULL, open_options.data(), NULL ); if( poDS == NULL ) { @@ -196,6 +198,7 @@ Rcpp::List CPL_read_ogr(Rcpp::CharacterVector datasource, Rcpp::CharacterVector Rcpp::stop("Open failed.\n"); } + if (layer.size() == 0) { // no layer specified switch (poDS->GetLayerCount()) { case 0: { // error: @@ -221,6 +224,10 @@ Rcpp::List CPL_read_ogr(Rcpp::CharacterVector datasource, Rcpp::CharacterVector } } + if(!Rcpp::CharacterVector::is_na(query[0])){ + poDS->ExecuteSQL(query[0], NULL, NULL); + }; + OGRLayer *poLayer = poDS->GetLayerByName(layer[0]); if (poLayer == NULL) { Rcpp::Rcout << "Cannot open layer " << layer[0] << std::endl; diff --git a/tests/testthat/test_postgis_ODBC.R b/tests/testthat/test_postgis_ODBC.R deleted file mode 100644 index 325301f40..000000000 --- a/tests/testthat/test_postgis_ODBC.R +++ /dev/null @@ -1,322 +0,0 @@ -library(sf) -library(DBI) -library(RPostgreSQL) -library(testthat) -context("sf: postgis using ODBC") - -can_con <- function(x) inherits(x, "DBIObject") - -db_drop_table_schema <- function(con, schema, table = NULL) { - if (is.null(table)) { - table <- paste(c("public", schema), collapse = ".") - } else { - table <- paste(c(schema, table), collapse = ".") - } - DBI::dbSendQuery(pg, paste("DROP TABLE ", table, " CASCADE;")) -} -require("sp") -data(meuse) -pts <- st_as_sf(meuse, coords = c("x", "y"), crs = 28992) - -epsg_31370 = paste0("+proj=lcc +lat_1=51.16666723333333 +lat_2=49.8333339 ", - "+lat_0=90 +lon_0=4.367486666666666 +x_0=150000.013 ", - "+y_0=5400088.438 +ellps=intl +towgs84=-106.869,52.2978,", - "-103.724,0.3366,-0.457,1.8422,-1.2747 +units=m +no_defs") - -pg <- NULL -test_that("check utils", expect_false(can_con(pg))) -# requires to apt-get install odbc-postgresql -try(pg <- dbConnect(odbc::odbc(), "PostgreSQL"), silent=TRUE) -pg <- NULL -# tests ------------------------------------------------------------------------ -test_that("can write to db", { - skip_if_not(can_con(pg), "could not connect to postgis database") - expect_silent(suppressMessages(st_write(pts, pg, "sf_meuse__"))) - expect_error(st_write(pts, pg, "sf_meuse__"), "exists") - expect_true(st_write(pts, pg, "sf_meuse__", overwrite = TRUE)) - expect_true(st_write(pts, pg, "sf_meuse2__", binary = FALSE)) - expect_warning(z <- st_set_crs(pts, epsg_31370)) - expect_message(st_write(z, pg, "sf_meuse3__"), "Inserted local crs") - expect_silent(st_write(z, pg, "sf_meuse3__", append = TRUE)) - expect_warning(expect_equal(nrow(DBI::dbReadTable(pg, "sf_meuse3__")), nrow(z) * 2), "Unknown field type") - expect_silent(st_write(z, pg, "sf_meuse3__", overwrite = TRUE)) -}) - -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)) - expect_silent(st_write(multi, pg, "meuse_multi", overwrite = TRUE)) - expect_silent(x <- st_read("PG:host=localhost dbname=postgis", "meuse_multi", quiet = TRUE)) - expect_equal(st_crs(x[["geometry"]]), st_crs(multi[["geometry"]])) - expect_equal(st_crs(x[["geometry.1"]]), st_crs(multi[["geometry.1"]])) - expect_silent(x <- st_read("PG:host=localhost dbname=postgis", "meuse_multi", quiet = TRUE, type = c(1,4))) - expect_silent(x <- st_read("PG:host=localhost dbname=postgis", "meuse_multi", quiet = TRUE, type = c(4,4))) - expect_silent(x <- st_read("PG:host=localhost dbname=postgis", "meuse_multi", quiet = TRUE, promote_to_multi = FALSE)) - expect_silent(x <- st_read("PG:host=localhost dbname=postgis", "meuse_multi", quiet = TRUE, geometry_column = "geometry.1")) - x <- st_layers("PG:host=localhost dbname=postgis") - multi2 <- cbind(pts[["geometry"]], st_set_crs(st_transform(pts, 4326), NA)) - expect_silent(st_write(multi2, pg, "meuse_multi2", overwrite = TRUE)) - expect_silent(x <- st_read(pg, "meuse_multi2")) - expect_equal(st_crs(x[["geometry"]]), st_crs(multi2[["geometry"]])) - expect_equal(st_crs(x[["geometry.1"]]), st_crs(multi2[["geometry.1"]])) - expect_silent(x <- st_read("PG:host=localhost dbname=postgis", "meuse_multi2", quiet = TRUE)) - #expect_equal(st_crs(x[["geometry"]]), st_crs(multi2[["geometry"]])) - expect_equal(st_crs(x[["geometry.1"]]), st_crs(multi2[["geometry.1"]])) -}) - -test_that("sf can write units to database (#264)", { - skip_if_not(can_con(pg), "could not connect to postgis database") - ptsu <- pts - ptsu[["u"]] <- ptsu[["cadmium"]] - units(ptsu[["u"]]) <- units::make_unit("km") - expect_silent(st_write(ptsu, pg, "sf_units__", overwrite = TRUE)) - r <- st_read(pg, "sf_units__") - expect_is(r[["u"]], "numeric") - expect_equal(sort(r[["u"]]), sort(as.numeric(ptsu[["u"]]))) - dbRemoveTable(pg, "sf_units__") -}) - -test_that("sf can preserve types (#592)", { - skip_if_not(can_con(pg), "could not connect to postgis database") - dtypes <- data.frame( - logi = c(TRUE, FALSE, NA), - chara = c("a", "", NA), - nume = c(1.1e1, 2.2e2, NA), - inte = c(1L, 2L, NA), - fact = factor(c("a", "b", NA), levels = letters), - #comp = c(complex(1, 2), complex(2, 3)), - date = c(rep(Sys.Date(), 2), NA), - time = c(rep(Sys.time(), 2), NA), - x = c(1, 2, 4), - y = c(1, 2, 4), stringsAsFactors = FALSE) - # cannot write lists - #dtypes$lst <- c(list(matrix("a")), list(matrix(c("b", "c"))), list(NA)) - dtypes <- st_as_sf(dtypes, coords = c("x", "y")) - st_write(dtypes, pg, overwrite = TRUE) - x <- st_read(pg, "dtypes") - dtypes$fact <- as.character(dtypes$fact) - expect_equal(x, dtypes) - DBI::dbRemoveTable(pg, "dtypes") -}) - -test_that("can write to other schema", { - skip_if_not(can_con(pg), "could not connect to postgis database") - try(DBI::dbSendQuery(pg, "CREATE SCHEMA sf_test__;"), silent = TRUE) - q <- "SELECT schema_name FROM information_schema.schemata WHERE schema_name = 'sf_test__';" - suppressWarnings(could_schema <- DBI::dbGetQuery(pg, q) %>% nrow() > 0) - - skip_if_not(could_schema, "Could not create schema (might need to run 'GRANT CREATE ON DATABASE postgis TO ')") - expect_error(st_write(pts, pg, Id(schema = "public", table = "sf_meuse__")), "exists") - expect_silent(st_write(pts, pg, Id(schema = "sf_test__", table = "sf_meuse__"))) - expect_error(st_write(pts, pg, Id(schema = "sf_test__", table = "sf_meuse__")), "exists") - expect_silent(st_write(pts, pg, Id(schema = "sf_test__", table = "sf_meuse__"), overwrite = TRUE)) - expect_warning(z <- st_set_crs(pts, epsg_31370)) - expect_silent(st_write(z, pg, Id(schema = "sf_test__", table = "sf_meuse33__"))) - expect_silent(st_write(z, pg, Id(schema = "sf_test__", table = "sf_meuse4__"))) - - # weird name work - expect_silent(st_write(pts, pg, c(NULL, "sf_test__.meuse__"), overwrite = TRUE)) - expect_silent(st_write(pts.2 <- pts, pg, overwrite = TRUE)) - expect_true(DBI::dbRemoveTable(pg, "pts.2 <- pts")) -}) - -test_that("support for capital names (#571)", { - skip_if_not(can_con(pg), "could not connect to postgis database") - expect_silent(st_write(pts, pg, "Meuse_tbl")) - expect_true(DBI::dbRemoveTable(pg, "Meuse_tbl")) - try(DBI::dbSendQuery(pg, "CREATE SCHEMA \"CAP__\";"), silent = TRUE) - q <- "SELECT schema_name FROM information_schema.schemata WHERE schema_name = 'CAP__';" - suppressWarnings(could_schema <- DBI::dbGetQuery(pg, q) %>% nrow() > 0) - skip_if_not(could_schema, "Could not create schema (might need to run 'GRANT CREATE ON DATABASE postgis TO ')") - expect_silent(st_write(pts, pg, Id(schema = "CAP__", table = "Meuse_tbl"))) - expect_true(DBI::dbRemoveTable(pg, Id(schema = "CAP__", table = "Meuse_tbl"))) - dbExecute(pg, 'DROP SCHEMA "CAP__" CASCADE;') -}) - -test_that("can read from db", { - skip_if_not(can_con(pg), "could not connect to postgis database") - q <- "select * from sf_meuse__" - #expect_warning(x <- st_read(pg, query = q), "crs") - expect_silent(x <- st_read(pg, query = q)) - - expect_error(st_read(pg), "table name or a query") - - y <- st_read(pg, "sf_meuse__") - expect_equal(dim(pts), dim(y)) - expect_identical(st_crs(pts), st_crs(y)) - expect_identical(st_precision(pts), st_precision(y)) - - expect_warning(z <- st_read(pg, "sf_meuse3__"), "code \\d+ not found") - expect_equal(dim(pts), dim(z)) - #expect_identical(st_crs(NA), st_crs(z)) - expect_true(st_crs(epsg_31370) == st_crs(z)) - expect_identical(st_precision(pts), st_precision(z)) - - w <- st_read(pg, c("sf_test__", "sf_meuse__")) - expect_equal(dim(y), dim(w)) - expect_identical(st_crs(y), st_crs(w)) - expect_identical(st_precision(y), st_precision(w)) - - expect_error(st_read(pg, "missing"), "not exist") - expect_error(st_read(pg, c("missing", "missing")), "not exist") - # make sure it reads in the correct schema - expect_error(st_read(pg, c("sf_test__", "sf_meuse3__")), "not exist") -}) - -test_that("can read views (#212)", { - skip_if_not(Sys.getenv("USER") != "edzer") # this stopped working for me - skip_if_not(can_con(pg), "could not connect to postgis database") - expect_equal(DBI::dbExecute(pg, - "CREATE VIEW sf_view__ AS SELECT * FROM sf_meuse__;"), 0) - expect_equal(DBI::dbExecute(pg, - "CREATE VIEW sf_test__.sf_view__ AS SELECT * FROM sf_meuse__;"), 0) - expect_equal(DBI::dbExecute(pg, - "CREATE MATERIALIZED VIEW sf_viewm__ AS SELECT * FROM sf_meuse__;"), 155) - expect_equal(DBI::dbExecute(pg, - "CREATE MATERIALIZED VIEW sf_test__.sf_viewm__ AS SELECT * FROM sf_meuse__;"), 155) - x <- st_read(pg, "sf_meuse__") - expect_identical(st_read(pg, "sf_view__"), x) - expect_identical(st_read(pg, c("public", "sf_view__")), x) - expect_identical(st_read(pg, c("sf_test__", "sf_view__")), x) - expect_identical(st_read(pg, c("sf_viewm__")), x) - expect_identical(st_read(pg, c("sf_test__", "sf_viewm__")), x) - - try(DBI::dbExecute(pg, "DROP VIEW sf_view__"), silent = TRUE) - try(DBI::dbExecute(pg, "DROP VIEW sf_test__.sf_view__"), silent = TRUE) - try(DBI::dbExecute(pg, "DROP MATERIALIZED VIEW sf_viewm__"), silent = TRUE) - try(DBI::dbExecute(pg, "DROP MATERIALIZED VIEW sf_test__.sf_viewm__"), silent = TRUE) -}) - -test_that("round trips", { - skip_if_not(can_con(pg), "could not connect to postgis database") - round_trip = function(conn, wkt) { - query = paste0("SELECT '", wkt, "'::geometry;") - returnstr = suppressWarnings(DBI::dbGetQuery(conn, query)$geometry) - wkb = structure(returnstr, class = "WKB") - ret = st_as_sfc(wkb, EWKB = TRUE) - message(paste("IN: ", wkt, "\n")) - # OUT contains WKB created in PostGIS from wkt, interpreted to R by sf, printed as WKT by sf - message(paste("OUT: ", txt <- st_as_text(ret, EWKT=TRUE)[[1]], "\n")) - if (length(grep("SRID", txt)) == 0) { - query = paste0("SELECT ST_AsText('",sf:::CPL_raw_to_hex(st_as_binary(ret[[1]])),"');") - received = suppressWarnings(DBI::dbGetQuery(conn, query)$st_astext) - # PG: contains the PostGIS WKT, after reading the WKB created by sf from R native - message(paste("PG: ", received, "\n")) - } - expect_equal(wkt, txt) - } - round_trip(pg, "SRID=4326;POINT M (0 0 0)") - round_trip(pg, "POINT Z (0 0 0)") - round_trip(pg, "POINT ZM (0 0 0 0)") - round_trip(pg, "POINT (0 0)") - round_trip(pg, "LINESTRING (0 0, 1 1, 2 2)") - round_trip(pg, "MULTIPOINT (0 0, 1 1, 2 2)") - round_trip(pg, "POLYGON ((0 0, 1 0, 1 1, 0 0))") - round_trip(pg, "MULTIPOLYGON (((0 0, 1 0, 1 1, 0 0)), ((2 2, 3 2, 3 3, 2 2)))") - round_trip(pg, paste("MULTIPOLYGON (((0 0, 1 0, 1 1, 0 0),", - "(0.2 0.2, 0.8 0.2, 0.8 0.8, 0.2 0.2)),", - "((2 2, 3 2, 3 3, 2 2)))")) - round_trip(pg, paste("MULTILINESTRING ((0 0, 1 0, 1 1, 0 0),", - "(0.2 0.2, 0.8 0.2, 0.8 0.8, 0.2 0.2),", - "(2 2, 3 2, 3 3, 2 2))")) - - # other types; examples taken from the PostGIS manuals (ch 4): - round_trip(pg, "CIRCULARSTRING (0 0, 1 1, 1 0)") - round_trip(pg, "CIRCULARSTRING (0 0, 4 0, 4 4, 0 4, 0 0)") - round_trip(pg, paste("CURVEPOLYGON (CIRCULARSTRING (0 0, 4 0, 4 4, 0 4, 0 0),", - "LINESTRING (1 1, 3 3, 3 1, 1 1))")) - round_trip(pg, paste("COMPOUNDCURVE (CIRCULARSTRING (0 0, 1 1, 1 0),", - "LINESTRING (1 0, 0 1))")) - round_trip(pg, paste0("CURVEPOLYGON (COMPOUNDCURVE (CIRCULARSTRING (0 0, 2 0, 2 1, 2 3, 4 3), ", - "LINESTRING (4 3, 4 5, 1 4, 0 0)), ", - "CIRCULARSTRING (1.7 1, 1.4 0.4, 1.6 0.4, 1.6 0.5, 1.7 1))")) - round_trip(pg, "MULTICURVE (LINESTRING (0 0, 5 5), CIRCULARSTRING (4 0, 4 4, 8 4))") - round_trip(pg, paste("MULTISURFACE (CURVEPOLYGON (CIRCULARSTRING (0 0, 4 0, 4 4, 0 4, 0 0),", - "LINESTRING (1 1, 3 3, 3 1, 1 1)),", - "POLYGON ((10 10, 14 12, 11 10, 10 10),", - "(11 11, 11.5 11, 11 11.5, 11 11)))")) - - round_trip(pg, paste("MULTICURVE (LINESTRING (0 0, 5 5),", - "CIRCULARSTRING (4 0, 4 4, 8 4))")) - round_trip(pg, paste("POLYHEDRALSURFACE Z (((0 0 0, 0 0 1, 0 1 1, 0 1 0, 0 0 0)),", - "((0 0 0, 0 1 0, 1 1 0, 1 0 0, 0 0 0)),", - "((0 0 0, 1 0 0, 1 0 1, 0 0 1, 0 0 0)),", - "((1 1 0, 1 1 1, 1 0 1, 1 0 0, 1 1 0)),", - "((0 1 0, 0 1 1, 1 1 1, 1 1 0, 0 1 0)),", - "((0 0 1, 1 0 1, 1 1 1, 0 1 1, 0 0 1)))")) - round_trip(pg, "TRIANGLE ((0 0, 0 9, 9 0, 0 0))") - round_trip(pg, "TIN Z (((0 0 0, 0 0 1, 0 1 0, 0 0 0)), ((0 0 0, 0 1 0, 1 1 0, 0 0 0)))") -}) - -test_that("can read using driver", { - skip_if_not(can_con(pg), "could not connect to postgis database") - layers <- st_layers("PG:host=localhost dbname=postgis") - lyr_expect <- sort(c("sf_meuse__", "sf_meuse2__", "sf_meuse3__", "meuse_multi2", - "sf_test__.sf_meuse__", "sf_test__.meuse__", - "sf_test__.sf_meuse33__", "sf_test__.sf_meuse4__")) - expect_true(all(lyr_expect %in% layers$name)) - expect_true(all(layers$features == 155)) - expect_true(all(layers$fields == 12)) - - skip_if_not(can_con(try(DBI::dbConnect(RPostgres::Postgres(), dbname = "empty"), silent=TRUE)), - "could not connect to 'empty' database") - expect_error(st_read("PG:host=localhost dbname=empty", quiet = TRUE), "No layers") -}) - -test_that("Can safely manipulate crs", { - skip_if_not(can_con(pg), "could not connect to postgis database") - srid <- 4326 - expect_true(get_postgis_crs(pg, srid) == st_crs(srid)) - expect_error(set_postgis_crs(pg, st_crs(srid))) - expect_warning(expect_true(is.na(st_crs(get_new_postgis_srid(pg)))), "not found") - new_crs <- st_crs(get_new_postgis_srid(pg), "+proj=longlat +datum=WGS84 +no_defs", valid = FALSE) - expect_message(set_postgis_crs(pg, new_crs, auth_name = "sf_test"), "Inserted local crs") - expect_warning(expect_error(set_postgis_crs(pg, new_crs), "duplicate key"), - "not found") - expect_equal(delete_postgis_crs(pg, new_crs), 1) - expect_equal(delete_postgis_crs(pg, new_crs), 0) -}) - -test_that("new SRIDs are handled correctly", { - skip_if_not(can_con(pg), "could not connect to postgis database") - data(meuse, package = "sp") - meuse_sf = st_as_sf(meuse, coords = c("x", "y"), crs = NA_crs_) - - crs = st_crs(NA_integer_, paste("+proj=sterea +lat_0=52 +lon_0=5", # creates FALSE, but new one - "+k=1.0 +x_0=155000 +y_0=463000 +ellps=bessel", - "+towgs84=565.4171,50.3319,465.5524,-0.398957,0.343988,", - "-1.87740,4.0725 +units=m +no_defs"), valid = FALSE) - st_crs(meuse_sf) = crs - expect_message(st_write(meuse_sf, pg, overwrite = TRUE), "Inserted local crs") - expect_warning(x <- st_read(pg, query = "select * from meuse_sf limit 3;"), - "not found in EPSG support files") - expect_true(st_crs(x)$proj4string == crs$proj4string) - expect_silent(st_write(meuse_sf, pg, overwrite = TRUE)) -}) - -test_that("schema_table", { - expect_error(sf:::schema_table(pg, NA), "character vector") - expect_error(sf:::schema_table(pg, NA_character_), "cannot be NA") - expect_error(sf:::schema_table(pg, "a", NA), "cannot be NA") - expect_error(sf:::schema_table(pg, letters), "longer than 2") - expect_equal(sf:::schema_table(pg, "a", "b"), c("b", "a")) - expect_equal(sf:::schema_table(pg, "a"), c("public", "a")) -}) - -if (can_con(pg)) { - # cleanup - try(db_drop_table_schema(pg, "meuse_sf"), silent = TRUE) - try(db_drop_table_schema(pg, "meuse_multi"), silent = TRUE) - try(db_drop_table_schema(pg, "sf_meuse__"), silent = TRUE) - try(db_drop_table_schema(pg, "sf_meuse2__"), silent = TRUE) - try(db_drop_table_schema(pg, "sf_meuse3__"), silent = TRUE) - try(db_drop_table_schema(pg, "meuse_multi2"), silent = TRUE) - try(db_drop_table_schema(pg, '"sf_test__.meuse__"'), silent = TRUE) - try(db_drop_table_schema(pg, "sf_test__", "sf_meuse__"), silent = TRUE) - try(db_drop_table_schema(pg, "sf_test__", "sf_meuse2__"), silent = TRUE) - try(db_drop_table_schema(pg, "sf_test__", "sf_meuse33__"), silent = TRUE) - try(db_drop_table_schema(pg, "sf_test__", "sf_meuse4__"), silent = TRUE) - try(DBI::dbExecute(pg, "DROP SCHEMA sf_test__ CASCADE;"), silent = TRUE) - try(DBI::dbExecute(pg, "DELETE FROM spatial_ref_sys WHERE auth_name = 'sf';"), silent = TRUE) - try(DBI::dbDisconnect(pg), silent = TRUE) -} diff --git a/tests/testthat/test_postgis_RPostgreSQL.R b/tests/testthat/test_postgis_RPostgreSQL.R deleted file mode 100644 index 8ab084f62..000000000 --- a/tests/testthat/test_postgis_RPostgreSQL.R +++ /dev/null @@ -1,324 +0,0 @@ -library(sf) -library(DBI) -library(RPostgreSQL) -library(testthat) -context("sf: postgis using RPostgreSQL") - -can_con <- function(x) inherits(x, "PostgreSQLConnection") - -db_drop_table_schema <- function(con, schema, table = NULL) { - if (is.null(table)) { - table <- paste(c("public", schema), collapse = ".") - } else { - table <- paste(c(schema, table), collapse = ".") - } - DBI::dbExecute(pg, paste("DROP TABLE ", table, " CASCADE;")) -} -require("sp") -data(meuse) -pts <- st_as_sf(meuse, coords = c("x", "y"), crs = 28992) - -epsg_31370 = paste0("+proj=lcc +lat_1=51.16666723333333 +lat_2=49.8333339 ", - "+lat_0=90 +lon_0=4.367486666666666 +x_0=150000.013 ", - "+y_0=5400088.438 +ellps=intl +towgs84=-106.869,52.2978,", - "-103.724,0.3366,-0.457,1.8422,-1.2747 +units=m +no_defs") - -pg <- NULL -test_that("check utils", expect_false(can_con(pg))) -try(pg <- RPostgreSQL::dbConnect(RPostgreSQL::PostgreSQL(), host = "localhost", dbname = "postgis"), silent=TRUE) - - -# tests ------------------------------------------------------------------------ -test_that("can write to db", { - skip_if_not(can_con(pg), "could not connect to postgis database") - expect_silent(suppressMessages(st_write(pts, pg, "sf_meuse__"))) - expect_error(st_write(pts, pg, "sf_meuse__"), "exists") - expect_true(st_write(pts, pg, "sf_meuse__", overwrite = TRUE)) - expect_true(st_write(pts, pg, "sf_meuse2__", binary = FALSE)) - expect_warning(z <- st_set_crs(pts, epsg_31370)) - expect_message(st_write(z, pg, "sf_meuse3__"), "Inserted local crs") - expect_silent(st_write(z, pg, "sf_meuse3__", append = TRUE)) - expect_warning(expect_equal(nrow(DBI::dbReadTable(pg, "sf_meuse3__")), nrow(z) * 2), "unrecognized PostgreSQL field type geometry") - expect_silent(st_write(z, pg, "sf_meuse3__", overwrite = TRUE)) -}) - -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)) - expect_silent(st_write(multi, pg, "meuse_multi", overwrite = TRUE)) - multi2 <- cbind(pts[["geometry"]], st_set_crs(st_transform(pts, 4326), NA)) - expect_silent(st_write(multi2, pg, "meuse_multi2", overwrite = TRUE)) - skip_on_travis() - expect_silent(x <- st_read("PG:host=localhost dbname=postgis", "meuse_multi", quiet = TRUE)) - # expect_equal(st_crs(x[["geometry"]]), st_crs(multi[["geometry"]])) -->> not generally true in case of different EPSG databases - expect_equal(st_crs(x[["geometry.1"]]), st_crs(multi[["geometry.1"]])) - expect_silent(x <- st_read("PG:host=localhost dbname=postgis", "meuse_multi", quiet = TRUE, type = c(1,4))) - expect_silent(x <- st_read("PG:host=localhost dbname=postgis", "meuse_multi", quiet = TRUE, type = c(4,4))) - expect_silent(x <- st_read("PG:host=localhost dbname=postgis", "meuse_multi", quiet = TRUE, promote_to_multi = FALSE)) - expect_silent(x <- st_read("PG:host=localhost dbname=postgis", "meuse_multi", quiet = TRUE, geometry_column = "geometry.1")) - x <- st_layers("PG:host=localhost dbname=postgis") - expect_silent(x <- st_read(pg, "meuse_multi2")) - # expect_equal(st_crs(x[["geometry"]]), st_crs(multi2[["geometry"]])) #-->> not generally the case, this CRS varies accross installations (EPSG db versions) - expect_equal(st_crs(x[["geometry.1"]]), st_crs(multi2[["geometry.1"]])) - expect_silent(x <- st_read("PG:host=localhost dbname=postgis", "meuse_multi2", quiet = TRUE)) - #expect_equal(st_crs(x[["geometry"]]), st_crs(multi2[["geometry"]])) - expect_equal(st_crs(x[["geometry.1"]]), st_crs(multi2[["geometry.1"]])) -}) - -test_that("sf can write units to database (#264)", { - skip_if_not(can_con(pg), "could not connect to postgis database") - ptsu <- pts - ptsu[["u"]] <- ptsu[["cadmium"]] - units(ptsu[["u"]]) <- units::make_unit("km") - expect_silent(st_write(ptsu, pg, "sf_units__", overwrite = TRUE)) - r <- st_read(pg, "sf_units__") - expect_is(r[["u"]], "numeric") - expect_equal(sort(r[["u"]]), sort(as.numeric(ptsu[["u"]]))) - dbRemoveTable(pg, "sf_units__") -}) - -test_that("sf can preserve types (#592)", { - skip_if_not(can_con(pg), "could not connect to postgis database") - dtypes <- data.frame( - logi = c(TRUE, FALSE, NA), - chara = c("a", "", NA), - nume = c(1.1e1, 2.2e2, NA), - inte = c(1L, 2L, NA), - fact = factor(c("a", "b", NA), levels = letters), - #comp = c(complex(1, 2), complex(2, 3)), - date = rep(Sys.Date(), 3), - time = rep(Sys.time(), 3), - x = c(1, 2, 4), - y = c(1, 2, 4), stringsAsFactors = FALSE) - # cannot write lists - #dtypes$lst <- c(list(matrix("a")), list(matrix(c("b", "c"))), list(NA)) - dtypes <- st_as_sf(dtypes, coords = c("x", "y")) - st_write(dtypes, pg, overwrite = TRUE) - x <- st_read(pg, "dtypes") - dtypes$fact <- as.character(dtypes$fact) - dtypes$fact <- as.character(dtypes$fact) - expect_equal(x[-7], dtypes[-7]) # ignore POSIXct timezone issue - DBI::dbRemoveTable(pg, "dtypes") -}) - -test_that("can write to other schema", { - skip_if_not(can_con(pg), "could not connect to postgis database") - try(DBI::dbSendQuery(pg, "CREATE SCHEMA sf_test__;"), silent = TRUE) - q <- "SELECT schema_name FROM information_schema.schemata WHERE schema_name = 'sf_test__';" - suppressWarnings(could_schema <- DBI::dbGetQuery(pg, q) %>% nrow() > 0) - - skip_if_not(could_schema, "Could not create schema (might need to run 'GRANT CREATE ON DATABASE postgis TO ')") - expect_error(st_write(pts, pg, c("public", "sf_meuse__")), "exists") - expect_silent(st_write(pts, pg, c("sf_test__", "sf_meuse__"))) - expect_error(st_write(pts, pg, c("sf_test__", "sf_meuse__")), "exists") - expect_silent(st_write(pts, pg, c("sf_test__", "sf_meuse__"), overwrite = TRUE)) - expect_warning(z <- st_set_crs(pts, epsg_31370)) - expect_silent(st_write(z, pg, c("sf_test__", "sf_meuse33__"))) - expect_silent(st_write(z, pg, c("sf_test__", "sf_meuse4__"))) - - # weird name work - expect_silent(st_write(pts, pg, c(NULL, "sf_test__.meuse__"), overwrite = TRUE)) - expect_silent(st_write(pts.2 <- pts, pg, overwrite = TRUE)) - expect_true(DBI::dbRemoveTable(pg, "pts.2 <- pts")) -}) - -test_that("support for capital names (#571)", { - skip_if_not(can_con(pg), "could not connect to postgis database") - expect_silent(st_write(pts, pg, "Meuse_tbl")) - expect_true(DBI::dbRemoveTable(pg, "Meuse_tbl")) - try(DBI::dbSendQuery(pg, "CREATE SCHEMA \"CAP__\";"), silent = TRUE) - q <- "SELECT schema_name FROM information_schema.schemata WHERE schema_name = 'CAP__';" - suppressWarnings(could_schema <- DBI::dbGetQuery(pg, q) %>% nrow() > 0) - skip_if_not(could_schema, "Could not create schema (might need to run 'GRANT CREATE ON DATABASE postgis TO ')") - expect_silent(st_write(pts, pg, c("CAP__", "Meuse_tbl"))) - expect_true(DBI::dbRemoveTable(pg, c("CAP__", "Meuse_tbl"))) - dbExecute(pg, 'DROP SCHEMA "CAP__" CASCADE;') -}) - -test_that("can read from db", { - skip_if_not(can_con(pg), "could not connect to postgis database") - q <- "select * from sf_meuse__" - #expect_warning(x <- st_read(pg, query = q), "crs") - expect_silent(x <- st_read(pg, query = q)) - - expect_error(st_read(pg), "Provide either a `layer` or a `query`") - - y <- st_read(pg, "sf_meuse__") - expect_equal(dim(pts), dim(y)) - expect_identical(st_crs(pts), st_crs(y)) - expect_identical(st_precision(pts), st_precision(y)) - - expect_warning(z <- st_read(pg, "sf_meuse3__"), "code \\d+ not found") - expect_equal(dim(pts), dim(z)) - #expect_identical(st_crs(NA), st_crs(z)) - expect_true(st_crs(epsg_31370) == st_crs(z)) - expect_identical(st_precision(pts), st_precision(z)) - - w <- st_read(pg, c("sf_test__", "sf_meuse__")) - expect_equal(dim(y), dim(w)) - expect_identical(st_crs(y), st_crs(w)) - expect_identical(st_precision(y), st_precision(w)) - - expect_error(st_read(pg, "missing"), "attempt to set an attribute on NULL") - expect_error(st_read(pg, c("missing", "missing")), "attempt to set an attribute on NULL") - # make sure it reads in the correct schema - expect_error(st_read(pg, c("sf_test__", "sf_meuse3__")), "attempt to set an attribute on NULL") -}) - -test_that("can read views (#212)", { - skip_if_not(Sys.getenv("USER") != "edzer") # this stopped working for me - skip_if_not(can_con(pg), "could not connect to postgis database") - expect_equal(DBI::dbExecute(pg, - "CREATE VIEW sf_view__ AS SELECT * FROM sf_meuse__;"), 0) - expect_equal(DBI::dbExecute(pg, - "CREATE VIEW sf_test__.sf_view__ AS SELECT * FROM sf_meuse__;"), 0) - expect_equal(DBI::dbExecute(pg, - "CREATE MATERIALIZED VIEW sf_viewm__ AS SELECT * FROM sf_meuse__;"), 155) - expect_equal(DBI::dbExecute(pg, - "CREATE MATERIALIZED VIEW sf_test__.sf_viewm__ AS SELECT * FROM sf_meuse__;"), 155) - x <- st_read(pg, "sf_meuse__") - expect_identical(st_read(pg, "sf_view__"), x) - expect_identical(st_read(pg, c("public", "sf_view__")), x) - expect_identical(st_read(pg, c("sf_test__", "sf_view__")), x) - expect_identical(st_read(pg, c("sf_viewm__")), x) - expect_identical(st_read(pg, c("sf_test__", "sf_viewm__")), x) - - try(DBI::dbExecute(pg, "DROP VIEW sf_view__"), silent = TRUE) - try(DBI::dbExecute(pg, "DROP VIEW sf_test__.sf_view__"), silent = TRUE) - try(DBI::dbExecute(pg, "DROP MATERIALIZED VIEW sf_viewm__"), silent = TRUE) - try(DBI::dbExecute(pg, "DROP MATERIALIZED VIEW sf_test__.sf_viewm__"), silent = TRUE) -}) - -test_that("round trips", { - skip_if_not(can_con(pg), "could not connect to postgis database") - round_trip = function(conn, wkt) { - query = paste0("SELECT '", wkt, "'::geometry;") - returnstr = suppressWarnings(DBI::dbGetQuery(conn, query)$geometry) - wkb = structure(returnstr, class = "WKB") - ret = st_as_sfc(wkb, EWKB = TRUE) - message(paste("IN: ", wkt, "\n")) - # OUT contains WKB created in PostGIS from wkt, interpreted to R by sf, printed as WKT by sf - message(paste("OUT: ", txt <- st_as_text(ret, EWKT=TRUE)[[1]], "\n")) - if (length(grep("SRID", txt)) == 0) { - query = paste0("SELECT ST_AsText('",sf:::CPL_raw_to_hex(st_as_binary(ret[[1]])),"');") - received = suppressWarnings(DBI::dbGetQuery(conn, query)$st_astext) - # PG: contains the PostGIS WKT, after reading the WKB created by sf from R native - message(paste("PG: ", received, "\n")) - } - expect_equal(wkt, txt) - } - round_trip(pg, "SRID=4326;POINT M (0 0 0)") - round_trip(pg, "POINT Z (0 0 0)") - round_trip(pg, "POINT ZM (0 0 0 0)") - round_trip(pg, "POINT (0 0)") - round_trip(pg, "LINESTRING (0 0, 1 1, 2 2)") - round_trip(pg, "MULTIPOINT (0 0, 1 1, 2 2)") - round_trip(pg, "POLYGON ((0 0, 1 0, 1 1, 0 0))") - round_trip(pg, "MULTIPOLYGON (((0 0, 1 0, 1 1, 0 0)), ((2 2, 3 2, 3 3, 2 2)))") - round_trip(pg, paste("MULTIPOLYGON (((0 0, 1 0, 1 1, 0 0),", - "(0.2 0.2, 0.8 0.2, 0.8 0.8, 0.2 0.2)),", - "((2 2, 3 2, 3 3, 2 2)))")) - round_trip(pg, paste("MULTILINESTRING ((0 0, 1 0, 1 1, 0 0),", - "(0.2 0.2, 0.8 0.2, 0.8 0.8, 0.2 0.2),", - "(2 2, 3 2, 3 3, 2 2))")) - - # other types; examples taken from the PostGIS manuals (ch 4): - round_trip(pg, "CIRCULARSTRING (0 0, 1 1, 1 0)") - round_trip(pg, "CIRCULARSTRING (0 0, 4 0, 4 4, 0 4, 0 0)") - round_trip(pg, paste("CURVEPOLYGON (CIRCULARSTRING (0 0, 4 0, 4 4, 0 4, 0 0),", - "LINESTRING (1 1, 3 3, 3 1, 1 1))")) - round_trip(pg, paste("COMPOUNDCURVE (CIRCULARSTRING (0 0, 1 1, 1 0),", - "LINESTRING (1 0, 0 1))")) - round_trip(pg, paste0("CURVEPOLYGON (COMPOUNDCURVE (CIRCULARSTRING (0 0, 2 0, 2 1, 2 3, 4 3), ", - "LINESTRING (4 3, 4 5, 1 4, 0 0)), ", - "CIRCULARSTRING (1.7 1, 1.4 0.4, 1.6 0.4, 1.6 0.5, 1.7 1))")) - round_trip(pg, "MULTICURVE (LINESTRING (0 0, 5 5), CIRCULARSTRING (4 0, 4 4, 8 4))") - round_trip(pg, paste("MULTISURFACE (CURVEPOLYGON (CIRCULARSTRING (0 0, 4 0, 4 4, 0 4, 0 0),", - "LINESTRING (1 1, 3 3, 3 1, 1 1)),", - "POLYGON ((10 10, 14 12, 11 10, 10 10),", - "(11 11, 11.5 11, 11 11.5, 11 11)))")) - - round_trip(pg, paste("MULTICURVE (LINESTRING (0 0, 5 5),", - "CIRCULARSTRING (4 0, 4 4, 8 4))")) - round_trip(pg, paste("POLYHEDRALSURFACE Z (((0 0 0, 0 0 1, 0 1 1, 0 1 0, 0 0 0)),", - "((0 0 0, 0 1 0, 1 1 0, 1 0 0, 0 0 0)),", - "((0 0 0, 1 0 0, 1 0 1, 0 0 1, 0 0 0)),", - "((1 1 0, 1 1 1, 1 0 1, 1 0 0, 1 1 0)),", - "((0 1 0, 0 1 1, 1 1 1, 1 1 0, 0 1 0)),", - "((0 0 1, 1 0 1, 1 1 1, 0 1 1, 0 0 1)))")) - round_trip(pg, "TRIANGLE ((0 0, 0 9, 9 0, 0 0))") - round_trip(pg, "TIN Z (((0 0 0, 0 0 1, 0 1 0, 0 0 0)), ((0 0 0, 0 1 0, 1 1 0, 0 0 0)))") -}) - -test_that("can read using driver", { - skip_if_not(can_con(pg), "could not connect to postgis database") - layers <- st_layers("PG:host=localhost dbname=postgis") - lyr_expect <- sort(c("sf_meuse__", "sf_meuse2__", "sf_meuse3__", "meuse_multi2", - "sf_test__.sf_meuse__", "sf_test__.meuse__", - "sf_test__.sf_meuse33__", "sf_test__.sf_meuse4__")) - expect_true(all(lyr_expect %in% layers$name)) - expect_true(all(layers$features == 155)) - expect_true(all(layers$fields == 12)) - - skip_if_not(can_con(try(DBI::dbConnect(RPostgres::Postgres(), dbname = "empty"), silent=TRUE)), - "could not connect to 'empty' database") - expect_error(st_read("PG:host=localhost dbname=empty", quiet = TRUE), "No layers") -}) - -test_that("Can safely manipulate crs", { - skip_if_not(can_con(pg), "could not connect to postgis database") - srid <- 4326 - expect_true(sf:::get_postgis_crs(pg, srid) == st_crs(srid)) - expect_error(sf:::set_postgis_crs(pg, st_crs(srid))) - expect_warning(expect_true(is.na(st_crs(sf:::get_new_postgis_srid(pg)))), "not found") - new_crs <- st_crs(sf:::get_new_postgis_srid(pg), "+proj=longlat +datum=WGS84 +no_defs", valid = FALSE) - expect_message(sf:::set_postgis_crs(pg, new_crs, auth_name = "sf_test"), "Inserted local crs") - expect_warning(expect_error(sf:::set_postgis_crs(pg, new_crs), "duplicate key"), - "not found") - expect_equal(sf:::delete_postgis_crs(pg, new_crs), 1) - expect_equal(sf:::delete_postgis_crs(pg, new_crs), 0) -}) - -test_that("new SRIDs are handled correctly", { - skip_if_not(can_con(pg), "could not connect to postgis database") - data(meuse, package = "sp") - meuse_sf = st_as_sf(meuse, coords = c("x", "y"), crs = NA_crs_) - - crs = st_crs(NA_integer_, paste("+proj=sterea +lat_0=52 +lon_0=5", # creates FALSE, but new one - "+k=1.0 +x_0=155000 +y_0=463000 +ellps=bessel", - "+towgs84=565.4171,50.3319,465.5524,-0.398957,0.343988,", - "-1.87740,4.0725 +units=m +no_defs"), valid = FALSE) - st_crs(meuse_sf) = crs - expect_message(st_write(meuse_sf, pg, overwrite = TRUE), "Inserted local crs") - expect_warning(x <- st_read(pg, query = "select * from meuse_sf limit 3;"), - "not found in EPSG support files") - expect_true(st_crs(x)$proj4string == crs$proj4string) - expect_silent(st_write(meuse_sf, pg, overwrite = TRUE)) -}) - -test_that("schema_table", { - expect_error(sf:::schema_table(pg, NA), "character vector") - expect_error(sf:::schema_table(pg, NA_character_), "cannot be NA") - expect_error(sf:::schema_table(pg, "a", NA), "cannot be NA") - expect_error(sf:::schema_table(pg, letters), "longer than 2") - expect_equal(sf:::schema_table(pg, "a", "b"), c("b", "a")) - expect_equal(sf:::schema_table(pg, "a"), c("public", "a")) -}) - -if (can_con(pg)) { - # cleanup - try(db_drop_table_schema(pg, "meuse_sf"), silent = TRUE) - try(db_drop_table_schema(pg, "meuse_multi"), silent = TRUE) - try(db_drop_table_schema(pg, "sf_meuse__"), silent = TRUE) - try(db_drop_table_schema(pg, "sf_meuse2__"), silent = TRUE) - try(db_drop_table_schema(pg, "sf_meuse3__"), silent = TRUE) - try(db_drop_table_schema(pg, "meuse_multi2"), silent = TRUE) - try(db_drop_table_schema(pg, '"sf_test__.meuse__"'), silent = TRUE) - try(db_drop_table_schema(pg, "sf_test__", "sf_meuse__"), silent = TRUE) - try(db_drop_table_schema(pg, "sf_test__", "sf_meuse2__"), silent = TRUE) - try(db_drop_table_schema(pg, "sf_test__", "sf_meuse33__"), silent = TRUE) - try(db_drop_table_schema(pg, "sf_test__", "sf_meuse4__"), silent = TRUE) - try(DBI::dbExecute(pg, "DROP SCHEMA sf_test__ CASCADE;"), silent = TRUE) - try(DBI::dbExecute(pg, " DELETE FROM spatial_ref_sys WHERE auth_name = 'sf';"), silent = TRUE) - try(DBI::dbDisconnect(pg), silent = TRUE) -} diff --git a/tests/testthat/test_postgis_RPostgres.R b/tests/testthat/test_postgis_RPostgres.R deleted file mode 100644 index 62fd769bc..000000000 --- a/tests/testthat/test_postgis_RPostgres.R +++ /dev/null @@ -1,359 +0,0 @@ -library(sf) -library(DBI) -library(RPostgreSQL) -library(testthat) -context("sf: postgis using RPostgres") - -can_con <- function(x) inherits(x, "PqConnection") - -db_drop_table_schema <- function(con, schema, table = NULL) { - if (is.null(table)) { - table <- paste(c("public", schema), collapse = ".") - } else { - table <- paste(c(schema, table), collapse = ".") - } - DBI::dbExecute(pg, paste("DROP TABLE ", table, " CASCADE;")) -} -require("sp") -data(meuse) -pts <- st_as_sf(meuse, coords = c("x", "y"), crs = 28992) - -epsg_31370 = paste0("+proj=lcc +lat_1=51.16666723333333 +lat_2=49.8333339 ", - "+lat_0=90 +lon_0=4.367486666666666 +x_0=150000.013 ", - "+y_0=5400088.438 +ellps=intl +towgs84=-106.869,52.2978,", - "-103.724,0.3366,-0.457,1.8422,-1.2747 +units=m +no_defs") - -pg <- NULL -test_that("check utils", expect_false(can_con(pg))) -try(pg <- DBI::dbConnect(RPostgres::Postgres(), host = "localhost", dbname = "postgis"), silent=TRUE) - -# tests ------------------------------------------------------------------------ -test_that("can write to db", { - skip_if_not(can_con(pg), "could not connect to postgis database") - expect_silent(suppressMessages(st_write(pts, pg, "sf_meuse__"))) - expect_error(st_write(pts, pg, "sf_meuse__"), "exists") - expect_true(st_write(pts, pg, "sf_meuse__", overwrite = TRUE)) - expect_true(st_write(pts, pg, "sf_meuse2__", binary = FALSE)) - expect_warning(z <- st_set_crs(pts, epsg_31370)) - expect_message(st_write(z, pg, "sf_meuse3__"), "Inserted local crs") - expect_silent(st_write(z, pg, "sf_meuse3__", append = TRUE)) - expect_equal(nrow(DBI::dbReadTable(pg, "sf_meuse3__")), nrow(z) * 2) - expect_silent(st_write(z, pg, "sf_meuse3__", overwrite = TRUE)) -}) - -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)) - expect_silent(st_write(multi, pg, "meuse_multi", overwrite = TRUE)) - expect_silent(x <- st_read("PG:host=localhost dbname=postgis", "meuse_multi", quiet = TRUE)) - # expect_equal(st_crs(x[["geometry"]]), st_crs(multi[["geometry"]])) -> fails if EPSG databases differ - expect_equal(st_crs(x[["geometry.1"]]), st_crs(multi[["geometry.1"]])) - expect_silent(x <- st_read("PG:host=localhost dbname=postgis", "meuse_multi", quiet = TRUE, type = c(1,4))) - expect_silent(x <- st_read("PG:host=localhost dbname=postgis", "meuse_multi", quiet = TRUE, type = c(4,4))) - expect_silent(x <- st_read("PG:host=localhost dbname=postgis", "meuse_multi", quiet = TRUE, promote_to_multi = FALSE)) - expect_silent(x <- st_read("PG:host=localhost dbname=postgis", "meuse_multi", quiet = TRUE, geometry_column = "geometry.1")) - x <- st_layers("PG:host=localhost dbname=postgis") - multi2 <- cbind(pts[["geometry"]], st_set_crs(st_transform(pts, 4326), NA)) - expect_silent(st_write(multi2, pg, "meuse_multi2", overwrite = TRUE)) - expect_silent(x <- st_read(pg, "meuse_multi2")) - expect_equal(st_crs(x[["geometry"]]), st_crs(multi2[["geometry"]])) - expect_equal(st_crs(x[["geometry.1"]]), st_crs(multi2[["geometry.1"]])) - expect_silent(x <- st_read("PG:host=localhost dbname=postgis", "meuse_multi2", quiet = TRUE)) - #expect_equal(st_crs(x[["geometry"]]), st_crs(multi2[["geometry"]])) - expect_equal(st_crs(x[["geometry.1"]]), st_crs(multi2[["geometry.1"]])) -}) - -test_that("sf can write units to database (#264)", { - skip_if_not(can_con(pg), "could not connect to postgis database") - ptsu <- pts - ptsu[["u"]] <- ptsu[["cadmium"]] - units(ptsu[["u"]]) <- units::make_unit("km") - expect_silent(st_write(ptsu, pg, "sf_units__", overwrite = TRUE)) - r <- st_read(pg, "sf_units__") - expect_is(r[["u"]], "numeric") - expect_equal(sort(r[["u"]]), sort(as.numeric(ptsu[["u"]]))) - dbRemoveTable(pg, "sf_units__") -}) - -test_that("sf can read non-sf tables with geometries", { - skip_if_not(can_con(pg), "could not connect to postgis database") - expect_warning(st_read(pg, query = "select 1 as a"), "Could not find a simple features geometry column.") - expect_silent(st_read(pg, query = "SELECT 'POINT(1 1)'::geometry")) - expect_silent(st_read(pg, query = "SELECT 'POINT(1 1)'::geometry as a, 'POINT(2 2)'::geometry as b")) -}) - -test_that("validates arguments", { - skip_if_not(can_con(pg), "could not connect to postgis database") - expect_error(st_read(pg), "Provide either a `layer` or a `query`") - expect_warning(st_read(pg, "sf_meuse__", query = "select * from sf_meuse__"), "You provided both `layer` and `query`") - expect_error(st_read(pg, "sf_meuse__", random_arg = "a"), "Unused arguments:") - expect_error(st_read(pg, "sf_meuse__", table = "a"), "`layer` rather than `table`") - expect_error(st_read(pg, "sf_meuse__", table = "a", x = 1, y = 2), "`layer` rather than `table`") -}) - -test_that("sf can preserve types (#592)", { - skip_if_not(can_con(pg), "could not connect to postgis database") - dtypes <- data.frame( - logi = c(TRUE, FALSE, NA), - chara = c("a", "", NA), - nume = c(1.1e1, 2.2e2, NA), - inte = c(1L, 2L, NA), - fact = factor(c("a", "b", NA), levels = letters), - #comp = c(complex(1, 2), complex(2, 3)), - date = c(rep(Sys.Date(), 2), NA), - time = c(rep(Sys.time(), 2), NA), - x = c(1, 2, 4), - y = c(1, 2, 4), stringsAsFactors = FALSE) - # cannot write lists - #dtypes$lst <- c(list(matrix("a")), list(matrix(c("b", "c"))), list(NA)) - dtypes <- st_as_sf(dtypes, coords = c("x", "y")) - st_write(dtypes, pg, overwrite = TRUE) - x <- st_read(pg, "dtypes") - dtypes$fact <- as.character(dtypes$fact) - expect_equal(x, dtypes) - DBI::dbRemoveTable(pg, "dtypes") -}) - -test_that("can write to other schema", { - # skip_if_not(FALSE) # tmp switch off -- EJP - skip_if_not(can_con(pg), "could not connect to postgis database") - try(DBI::dbSendQuery(pg, "CREATE SCHEMA sf_test__;"), silent = TRUE) - q <- "SELECT schema_name FROM information_schema.schemata WHERE schema_name = 'sf_test__';" - suppressWarnings(could_schema <- DBI::dbGetQuery(pg, q) %>% nrow() > 0) - - skip_if_not(could_schema, "Could not create schema (might need to run 'GRANT CREATE ON DATABASE postgis TO ')") - expect_error(st_write(pts, pg, Id(schema = "public", table = "sf_meuse__")), "exists") - expect_silent(st_write(pts, pg, Id(schema = "sf_test__", table = "sf_meuse__"))) - expect_error(st_write(pts, pg, Id(schema = "sf_test__", table = "sf_meuse__")), "exists") - expect_silent(st_write(pts, pg, Id(schema = "sf_test__", table = "sf_meuse__"), overwrite = TRUE)) - expect_warning(z <- st_set_crs(pts, epsg_31370)) - expect_silent(st_write(z, pg, Id(schema = "sf_test__", table = "sf_meuse33__"))) - expect_silent(st_write(z, pg, Id(schema = "sf_test__", table = "sf_meuse4__"))) - - # weird name work - expect_silent(st_write(pts, pg, c(NULL, "sf_test__.meuse__"), overwrite = TRUE)) - expect_silent(st_write(pts.2 <- pts, pg, overwrite = TRUE)) - expect_true(DBI::dbRemoveTable(pg, "pts.2 <- pts")) -}) - -test_that("support for capital names (#571)", { - skip_if_not(can_con(pg), "could not connect to postgis database") - expect_silent(st_write(pts, pg, "Meuse_tbl")) - expect_true(DBI::dbRemoveTable(pg, "Meuse_tbl")) - try(DBI::dbSendQuery(pg, "CREATE SCHEMA \"CAP__\";"), silent = TRUE) - q <- "SELECT schema_name FROM information_schema.schemata WHERE schema_name = 'CAP__';" - suppressWarnings(could_schema <- DBI::dbGetQuery(pg, q) %>% nrow() > 0) - skip_if_not(could_schema, "Could not create schema (might need to run 'GRANT CREATE ON DATABASE postgis TO ')") - expect_silent(st_write(pts, pg, Id(schema = "CAP__", table = "Meuse_tbl"))) - expect_true(DBI::dbRemoveTable(pg, Id(schema = "CAP__", table = "Meuse_tbl"))) - dbExecute(pg, 'DROP SCHEMA "CAP__" CASCADE;') -}) - -test_that("can read from db", { - skip_if_not(can_con(pg), "could not connect to postgis database") - q <- "select * from sf_meuse__" - #expect_warning(x <- st_read(pg, query = q), "crs") - expect_silent(x <- st_read(pg, query = q)) - - expect_error(st_read(pg), "Provide either a `layer` or a `query`") - - y <- st_read(pg, "sf_meuse__") - expect_equal(dim(pts), dim(y)) - expect_identical(st_crs(pts), st_crs(y)) - expect_identical(st_precision(pts), st_precision(y)) - - expect_warning(z <- st_read(pg, "sf_meuse3__"), "code \\d+ not found") - expect_equal(dim(pts), dim(z)) - #expect_identical(st_crs(NA), st_crs(z)) - expect_true(st_crs(epsg_31370) == st_crs(z)) - expect_identical(st_precision(pts), st_precision(z)) - - w <- st_read(pg, DBI::Id(schema = "sf_test__", table = "sf_meuse__")) - expect_equal(dim(y), dim(w)) - expect_identical(st_crs(y), st_crs(w)) - expect_identical(st_precision(y), st_precision(w)) - - expect_error(st_read(pg, "missing"), "not exist") - expect_error(st_read(pg, DBI::Id(schema = "missing", table = "missing")), "not exist") - # make sure it reads in the correct schema - expect_error(st_read(pg, DBI::Id(schema = "sf_test__", table = "sf_meuse3__")), "not exist") -}) - -test_that("can read views (#212)", { - skip_if_not(Sys.getenv("USER") != "edzer") # this stopped working for me - skip_if_not(can_con(pg), "could not connect to postgis database") - expect_equal(DBI::dbExecute(pg, - "CREATE VIEW sf_view__ AS SELECT * FROM sf_meuse__;"), 0) - expect_equal(DBI::dbExecute(pg, - "CREATE VIEW sf_test__.sf_view__ AS SELECT * FROM sf_meuse__;"), 0) - expect_equal(DBI::dbExecute(pg, - "CREATE MATERIALIZED VIEW sf_viewm__ AS SELECT * FROM sf_meuse__;"), 155) - expect_equal(DBI::dbExecute(pg, - "CREATE MATERIALIZED VIEW sf_test__.sf_viewm__ AS SELECT * FROM sf_meuse__;"), 155) - x <- st_read(pg, "sf_meuse__") - expect_identical(st_read(pg, "sf_view__"), x) - expect_identical(st_read(pg, DBI::Id(schema = "public", table = "sf_view__")), x) - expect_identical(st_read(pg, DBI::Id(schema = "sf_test__", table = "sf_view__")), x) - expect_identical(st_read(pg, "sf_viewm__"), x) - expect_identical(st_read(pg, DBI::Id(schema = "sf_test__", table = "sf_viewm__")), x) - - try(DBI::dbExecute(pg, "DROP VIEW sf_view__"), silent = TRUE) - try(DBI::dbExecute(pg, "DROP VIEW sf_test__.sf_view__"), silent = TRUE) - try(DBI::dbExecute(pg, "DROP MATERIALIZED VIEW sf_viewm__"), silent = TRUE) - try(DBI::dbExecute(pg, "DROP MATERIALIZED VIEW sf_test__.sf_viewm__"), silent = TRUE) -}) - -test_that("round trips", { - skip_if_not(can_con(pg), "could not connect to postgis database") - round_trip = function(conn, wkt) { - query = paste0("SELECT '", wkt, "'::geometry;") - returnstr = suppressWarnings(DBI::dbGetQuery(conn, query)$geometry) - wkb = structure(returnstr, class = "WKB") - ret = st_as_sfc(wkb, EWKB = TRUE) - message(paste("IN: ", wkt, "\n")) - # OUT contains WKB created in PostGIS from wkt, interpreted to R by sf, printed as WKT by sf - message(paste("OUT: ", txt <- st_as_text(ret, EWKT=TRUE)[[1]], "\n")) - if (length(grep("SRID", txt)) == 0) { - query = paste0("SELECT ST_AsText('",sf:::CPL_raw_to_hex(st_as_binary(ret[[1]])),"');") - received = suppressWarnings(DBI::dbGetQuery(conn, query)$st_astext) - # PG: contains the PostGIS WKT, after reading the WKB created by sf from R native - message(paste("PG: ", received, "\n")) - } - expect_equal(wkt, txt) - } - round_trip(pg, "SRID=4326;POINT M (0 0 0)") - round_trip(pg, "POINT Z (0 0 0)") - round_trip(pg, "POINT ZM (0 0 0 0)") - round_trip(pg, "POINT (0 0)") - round_trip(pg, "LINESTRING (0 0, 1 1, 2 2)") - round_trip(pg, "MULTIPOINT (0 0, 1 1, 2 2)") - round_trip(pg, "POLYGON ((0 0, 1 0, 1 1, 0 0))") - round_trip(pg, "MULTIPOLYGON (((0 0, 1 0, 1 1, 0 0)), ((2 2, 3 2, 3 3, 2 2)))") - round_trip(pg, paste("MULTIPOLYGON (((0 0, 1 0, 1 1, 0 0),", - "(0.2 0.2, 0.8 0.2, 0.8 0.8, 0.2 0.2)),", - "((2 2, 3 2, 3 3, 2 2)))")) - round_trip(pg, paste("MULTILINESTRING ((0 0, 1 0, 1 1, 0 0),", - "(0.2 0.2, 0.8 0.2, 0.8 0.8, 0.2 0.2),", - "(2 2, 3 2, 3 3, 2 2))")) - - # other types; examples taken from the PostGIS manuals (ch 4): - round_trip(pg, "CIRCULARSTRING (0 0, 1 1, 1 0)") - round_trip(pg, "CIRCULARSTRING (0 0, 4 0, 4 4, 0 4, 0 0)") - round_trip(pg, paste("CURVEPOLYGON (CIRCULARSTRING (0 0, 4 0, 4 4, 0 4, 0 0),", - "LINESTRING (1 1, 3 3, 3 1, 1 1))")) - round_trip(pg, paste("COMPOUNDCURVE (CIRCULARSTRING (0 0, 1 1, 1 0),", - "LINESTRING (1 0, 0 1))")) - round_trip(pg, paste0("CURVEPOLYGON (COMPOUNDCURVE (CIRCULARSTRING (0 0, 2 0, 2 1, 2 3, 4 3), ", - "LINESTRING (4 3, 4 5, 1 4, 0 0)), ", - "CIRCULARSTRING (1.7 1, 1.4 0.4, 1.6 0.4, 1.6 0.5, 1.7 1))")) - round_trip(pg, "MULTICURVE (LINESTRING (0 0, 5 5), CIRCULARSTRING (4 0, 4 4, 8 4))") - round_trip(pg, paste("MULTISURFACE (CURVEPOLYGON (CIRCULARSTRING (0 0, 4 0, 4 4, 0 4, 0 0),", - "LINESTRING (1 1, 3 3, 3 1, 1 1)),", - "POLYGON ((10 10, 14 12, 11 10, 10 10),", - "(11 11, 11.5 11, 11 11.5, 11 11)))")) - - round_trip(pg, paste("MULTICURVE (LINESTRING (0 0, 5 5),", - "CIRCULARSTRING (4 0, 4 4, 8 4))")) - round_trip(pg, paste("POLYHEDRALSURFACE Z (((0 0 0, 0 0 1, 0 1 1, 0 1 0, 0 0 0)),", - "((0 0 0, 0 1 0, 1 1 0, 1 0 0, 0 0 0)),", - "((0 0 0, 1 0 0, 1 0 1, 0 0 1, 0 0 0)),", - "((1 1 0, 1 1 1, 1 0 1, 1 0 0, 1 1 0)),", - "((0 1 0, 0 1 1, 1 1 1, 1 1 0, 0 1 0)),", - "((0 0 1, 1 0 1, 1 1 1, 0 1 1, 0 0 1)))")) - round_trip(pg, "TRIANGLE ((0 0, 0 9, 9 0, 0 0))") - round_trip(pg, "TIN Z (((0 0 0, 0 0 1, 0 1 0, 0 0 0)), ((0 0 0, 0 1 0, 1 1 0, 0 0 0)))") -}) - -test_that("can read using driver", { - skip_if_not(can_con(pg), "could not connect to postgis database") - layers <- st_layers("PG:host=localhost dbname=postgis") - lyr_expect <- sort(c("sf_meuse__", "sf_meuse2__", "sf_meuse3__", "meuse_multi2", - "sf_test__.sf_meuse__", "sf_test__.meuse__", - "sf_test__.sf_meuse33__", "sf_test__.sf_meuse4__")) - expect_true(all(lyr_expect %in% layers$name)) - expect_true(all(layers$features == 155)) - expect_true(all(layers$fields == 12)) - - skip_if_not(can_con(try(DBI::dbConnect(RPostgres::Postgres(), dbname = "empty"), silent=TRUE)), - "could not connect to 'empty' database") - expect_error(st_read("PG:dbname=empty", quiet = TRUE), "No layers") # EJP: removed host=localhost -}) - -test_that("Can safely manipulate crs", { - skip_if_not(can_con(pg), "could not connect to postgis database") - srid <- 4326 - crs <- st_crs(srid) - expect_true(get_postgis_crs(pg, srid) == st_crs(srid)) - expect_error(set_postgis_crs(pg, st_crs(srid)), "already exists") - expect_warning(expect_true(is.na(st_crs(get_new_postgis_srid(pg)))), "not found") - new_crs <- st_crs(get_new_postgis_srid(pg), "+proj=longlat +datum=WGS84 +no_defs", valid = FALSE) - expect_message(set_postgis_crs(pg, new_crs, auth_name = "sf_test"), "Inserted local crs") - expect_warning(expect_error(set_postgis_crs(pg, new_crs), "duplicate key"), - "not found") - expect_equal(delete_postgis_crs(pg, new_crs), 1) - expect_equal(delete_postgis_crs(pg, new_crs), 0) - - # set and delete - crs$epsg <- NA - expect_message(new_srid <- set_postgis_crs(pg, crs), "Inserted local crs") - expect_error(delete_postgis_crs(pg, crs), "Missing SRID") - crs2 <- st_crs(new_srid$epsg, proj4text = st_crs(3857)$proj4string, valid = FALSE) - expect_equal(delete_postgis_crs(pg, crs2), 0) # crs doesn't match any crs - expect_equal(delete_postgis_crs(pg, new_srid), 1) - - # udpate - expect_message(set_postgis_crs(pg, new_srid), "Inserted local crs") - new_srid$proj4string <- crs2$proj4string - expect_error(set_postgis_crs(pg, new_srid), "already exists") - expect_message(set_postgis_crs(pg, new_srid, update = TRUE), "Inserted local crs") -}) - - -test_that("new SRIDs are handled correctly", { - skip_if_not(can_con(pg), "could not connect to postgis database") - data(meuse, package = "sp") - meuse_sf = st_as_sf(meuse, coords = c("x", "y"), crs = NA_crs_) - - crs = st_crs(NA_integer_, paste("+proj=sterea +lat_0=52 +lon_0=5", # creates FALSE, but new one - "+k=1.0 +x_0=155000 +y_0=463000 +ellps=bessel", - "+towgs84=565.4171,50.3319,465.5524,-0.398957,0.343988,", - "-1.87740,4.0725 +units=m +no_defs"), valid = FALSE) - st_crs(meuse_sf) = crs - expect_message(st_write(meuse_sf, pg, overwrite = TRUE), "Inserted local crs") - expect_warning(x <- st_read(pg, query = "select * from meuse_sf limit 3;"), - "not found in EPSG support files") - expect_true(st_crs(x)$proj4string == crs$proj4string) - expect_silent(st_write(meuse_sf, pg, overwrite = TRUE)) -}) - -test_that("schema_table", { - expect_error(sf:::schema_table(pg, NA), "character vector") - expect_error(sf:::schema_table(pg, NA_character_), "cannot be NA") - expect_error(sf:::schema_table(pg, "a", NA), "cannot be NA") - expect_error(sf:::schema_table(pg, letters), "longer than 2") - expect_equal(sf:::schema_table(pg, "a", "b"), c("b", "a")) - expect_equal(sf:::schema_table(pg, "a"), c("public", "a")) -}) - -test_that("get_postgis_crs", { - expect_equal(sf:::get_postgis_crs(pg, NA), st_crs(NA)) - expect_error(sf:::delete_postgis_crs(pg, st_crs(NA)), "Missing SRID") -}) - -if (can_con(pg)) { - # cleanup - try(db_drop_table_schema(pg, "meuse_sf"), silent = TRUE) - try(db_drop_table_schema(pg, "meuse_multi"), silent = TRUE) - try(db_drop_table_schema(pg, "sf_meuse__"), silent = TRUE) - try(db_drop_table_schema(pg, "sf_meuse2__"), silent = TRUE) - try(db_drop_table_schema(pg, "sf_meuse3__"), silent = TRUE) - try(db_drop_table_schema(pg, "meuse_multi2"), silent = TRUE) - try(db_drop_table_schema(pg, '"sf_test__.meuse__"'), silent = TRUE) - try(db_drop_table_schema(pg, "sf_test__", "sf_meuse__"), silent = TRUE) - try(db_drop_table_schema(pg, "sf_test__", "sf_meuse2__"), silent = TRUE) - try(db_drop_table_schema(pg, "sf_test__", "sf_meuse33__"), silent = TRUE) - try(db_drop_table_schema(pg, "sf_test__", "sf_meuse4__"), silent = TRUE) - try(DBI::dbExecute(pg, "DROP SCHEMA sf_test__ CASCADE;"), silent = TRUE) - try(DBI::dbExecute(pg, " DELETE FROM spatial_ref_sys WHERE auth_name = 'sf';"), silent = TRUE) - try(DBI::dbDisconnect(pg), silent = TRUE) -} diff --git a/tests/testthat/test_read.R b/tests/testthat/test_read.R index 1d9ba6f25..b2a23654f 100644 --- a/tests/testthat/test_read.R +++ b/tests/testthat/test_read.R @@ -6,6 +6,12 @@ test_that("we can read a shapefile using st_read", { expect_equal(dim(nc), c(100, 15)) }) +test_that("we can read shapefiles with a query string", { + nc <- st_read(system.file("shape/nc.shp", package="sf"), "nc", crs = 4267, quiet = TRUE) + nc_all <- st_read(system.file("shape/nc.shp", package="sf"), "nc", query = "select * from nc", crs = 4267, quiet = TRUE) + nc_some <- st_read(system.file("shape/nc.shp", package="sf"), "nc", query = "select * from nc where SID79 > 50", crs = 4267, quiet = TRUE) +}) + test_that("st_read.default gives error messages", { expect_error(st_read(), "dsn should specify a data source or filename") expect_error(st_read(NULL), "no st_read method available for objects of class NULL") @@ -178,3 +184,5 @@ test_that("reading non-spatial table works", { expect_is(read_sf(system.file("gpkg/nospatial.gpkg", package = "sf")), "tbl_df") }) + +