From ee2718082c123271758dcd7b66ac9f1a702eaa72 Mon Sep 17 00:00:00 2001 From: olivroy Date: Mon, 11 Dec 2023 10:01:22 -0500 Subject: [PATCH 1/7] Lints to tests --- tests/testthat/test-normalize.R | 6 +++--- tests/testthat/test_crs.R | 18 ++++++++-------- tests/testthat/test_geos.R | 16 +++++++------- tests/testthat/test_sample.R | 2 +- tests/testthat/test_sf.R | 2 +- tests/testthat/test_sfc.R | 6 +++--- tests/testthat/test_sfg.R | 4 ++-- tests/testthat/test_sp.R | 2 +- tests/testthat/test_tidy.R | 38 ++++++++++++--------------------- tests/testthat/test_zm_range.R | 5 ++--- 10 files changed, 44 insertions(+), 55 deletions(-) diff --git a/tests/testthat/test-normalize.R b/tests/testthat/test-normalize.R index 90d235b51..7e7d08cad 100644 --- a/tests/testthat/test-normalize.R +++ b/tests/testthat/test-normalize.R @@ -6,16 +6,16 @@ test_that("normalize", { p1 <- st_multipoint(matrix(runif(20, max = 25), ncol = 2)) p1_norm <- st_normalize(p1) - expect_true(all(st_bbox(p1_norm) == c(0,0,1,1))) + expect_equal(unclass(st_bbox(p1_norm)), c(0,0,1,1), check.attributes = FALSE) p2 <- st_polygon(list(matrix(runif(10, max = 100), ncol = 2)[c(1:5, 1), ])) sfc <- st_sfc(p1, p2) sfc_norm <- st_normalize(sfc) - expect_true(all(st_bbox(sfc_norm) == c(0,0,1,1))) + expect_equal(unclass(st_bbox(sfc_norm)), c(0,0,1,1), check.attributes = FALSE) sf <- st_sf(geometry = sfc) sf_norm <- st_normalize(sf) - expect_true(all(st_bbox(sf_norm) == c(0,0,1,1))) + expect_equal(unclass(st_bbox(sf_norm)), c(0,0,1,1), check.attributes = FALSE) expect_equal(sfc_norm, sf_norm$geometry) }) diff --git a/tests/testthat/test_crs.R b/tests/testthat/test_crs.R index 635531145..c5eb7ecdc 100644 --- a/tests/testthat/test_crs.R +++ b/tests/testthat/test_crs.R @@ -36,8 +36,8 @@ test_that("sf_proj_info works", { expect_silent(x <- sf_proj_info("datum")) expect_silent(x <- sf_proj_info("units")) expect_silent(path <- sf_proj_info("path")) - expect_true(is.logical(sf_proj_info(path = path))) - expect_true(is.logical(sf_proj_info("network"))) + expect_type(sf_proj_info(path = path), "logical") + expect_type(sf_proj_info("network"), "logical") }) test_that("sf_proj_info works for datum files", { @@ -47,20 +47,20 @@ test_that("sf_proj_info works for datum files", { test_that("$.crs works", { skip_if_not(sf_extSoftVersion()[["proj.4"]] < "6.0.0") - expect_true(!is.null(st_crs("+init=epsg:3857")$epsg)) - expect_true(is.character(st_crs("+init=epsg:3857")$proj4string)) + expect_false(is.null(st_crs("+init=epsg:3857")$epsg)) + expect_type(st_crs("+init=epsg:3857")$proj4string, "character") }) test_that("$.crs works with +units", { skip_if_not(sf_extSoftVersion()[["proj.4"]] < "6.0.0") - expect_true(is.numeric(st_crs("+init=epsg:3857 +units=m")$b)) - expect_true(is.character(st_crs("+init=epsg:3857 +units=m")$units)) + expect_type(st_crs("+init=epsg:3857 +units=m")$b, "double") + expect_type(st_crs("+init=epsg:3857 +units=m")$units, "character") }) test_that("$.crs works 2", { skip_if_not(sf_extSoftVersion()[["GDAL"]] < "2.5.0" && sf_extSoftVersion()[["proj.4"]] < "6.0.0") - expect_true(is.numeric(st_crs("+init=epsg:3857 +units=km")$b)) - expect_true(is.character(st_crs("+init=epsg:3857 +units=km")$units)) + expect_type(st_crs("+init=epsg:3857 +units=km")$b, "double") + expect_type(st_crs("+init=epsg:3857 +units=km")$units, "character") }) test_that("CRS comparison uses ellipsoid and datum (#180)", { @@ -108,5 +108,5 @@ test_that("crs.Raster works", { library(raster) r = raster() x = st_crs(r) - expect_equal(class(x), "crs") + expect_s3_class(x, "crs", exact = TRUE) }) diff --git a/tests/testthat/test_geos.R b/tests/testthat/test_geos.R index 7795cffa8..489f0b678 100644 --- a/tests/testthat/test_geos.R +++ b/tests/testthat/test_geos.R @@ -17,7 +17,7 @@ test_that("CPL_geos_is_valid works", { test_that("geos ops give warnings and errors on longlat", { skip_if_not_installed("lwgeom") - skip_if_not(!sf_use_s2()) + skip_if(sf_use_s2()) nc = st_read(system.file("shape/nc.shp", package="sf"), quiet = TRUE) x = nc[1:2,] @@ -92,9 +92,9 @@ test_that("geom operations work on sfg or sfc or sf", { expect_s3_class(st_boundary(gpnc), "sfc_MULTILINESTRING") expect_s3_class(st_boundary(gpnc[[1L]]), "MULTILINESTRING") - expect_true(inherits(st_convex_hull(pnc)$geometry, "sfc_POLYGON")) - expect_true(inherits(st_convex_hull(gpnc), "sfc_POLYGON")) - expect_true(inherits(st_convex_hull(gpnc[[1L]]), "POLYGON")) + expect_s3_class(st_convex_hull(pnc)$geometry, "sfc_POLYGON") + expect_s3_class(st_convex_hull(gpnc), "sfc_POLYGON") + expect_s3_class(st_convex_hull(gpnc[[1L]]), "POLYGON") expect_silent(st_simplify(pnc, FALSE, 1e4)) expect_silent(st_simplify(gpnc, FALSE, 1e4)) @@ -198,7 +198,7 @@ test_that("st_difference works with partially overlapping geometries", { expect_equal(attr(out1, "crs"), attr(in1, "crs")) expect_equal(st_crs(out2), st_crs(in2)) # check that output geometries are actually correct - expect_equal(length(out1), 3) + expect_length(out1, 3) expect_equal(nrow(out2), 3) expect_equal(out1[[1]][[1]], correct_geom[[1]][[1]]) expect_equal(out1[[2]][[1]], correct_geom[[2]][[1]]) @@ -228,8 +228,8 @@ test_that("st_difference works with fully contained geometries", { expect_equal(attr(out1, "crs"), attr(in1, "crs")) expect_equal(st_crs(out2), st_crs(in2)) # check that output geometries are actually correct - expect_equal(length(out1), 2) - expect_equal(length(out2), 2) + expect_length(out1, 2) + expect_length(out2, 2) expect_equal(out1[[1]][[1]], correct_geom[[1]][[1]]) #expect_equal(out1[[2]][[1]], correct_geom[[2]][[1]]) #expect_equal(out2[[1]][[1]], correct_geom[[1]][[1]]) @@ -257,5 +257,5 @@ test_that("binary operations work on sf objects with common column names", { test_that("binary operations on empty sfg objects return NA", { x = st_point() == st_linestring() - expect_true(is.na(x)) + expect_equal(x, NA) }) diff --git a/tests/testthat/test_sample.R b/tests/testthat/test_sample.R index 75f47a24f..6e3e03542 100644 --- a/tests/testthat/test_sample.R +++ b/tests/testthat/test_sample.R @@ -5,5 +5,5 @@ test_that("st_sample works", { sample_default = st_sample(x = nc, size = n) expect_s3_class(sample_default, "sfc") sample_exact = st_sample(x = nc, size = n, exact = TRUE) - expect_equal(length(sample_exact), n) + expect_length(sample_exact, n) }) diff --git a/tests/testthat/test_sf.R b/tests/testthat/test_sf.R index 4d707d450..80ffd0dd5 100644 --- a/tests/testthat/test_sf.R +++ b/tests/testthat/test_sf.R @@ -86,7 +86,7 @@ test_that("transform work", { data(meuse, package = "sp") x = st_as_sf(meuse, coords = c("x", "y"), crs = 28992) x2 = transform(x, elev2 = elev^2, lead_zinc = lead/zinc) - expect_true(inherits(x, 'sf')) + expect_s3_class(x, 'sf') expect_identical(class(x2), class(x)) expect_identical(st_bbox(x), st_bbox(x)) expect_identical(st_crs(x), st_crs(x)) diff --git a/tests/testthat/test_sfc.R b/tests/testthat/test_sfc.R index ce609621e..2806c8e0b 100644 --- a/tests/testthat/test_sfc.R +++ b/tests/testthat/test_sfc.R @@ -4,7 +4,7 @@ test_that("we can print sfc objects", { s1 = st_sf(a = c("x", "y"), geom = st_sfc(pt1, pt2)) expect_output(print(s1), "Simple feature collection") expect_output(print(st_sfc()), "Geometry set for 0 features") - expect_equal(length(st_sfc()), 0) + expect_length(st_sfc(), 0) }) test_that("st_is_longlat works", { @@ -33,8 +33,8 @@ test_that("st_as_binary handles non-native big endian", { as.raw(1) } r[2:5] = rev(r[2:5]) # swap bytes - expect_identical(gc, st_as_sfc(structure(list(r), class = "WKB"), pureR = T)[[1]]) - expect_identical(gc, st_as_sfc(structure(list(r), class = "WKB"), pureR = T, EWKB = TRUE)[[1]]) + expect_identical(gc, st_as_sfc(structure(list(r), class = "WKB"), pureR = TRUE)[[1]]) + expect_identical(gc, st_as_sfc(structure(list(r), class = "WKB"), pureR = TRUE, EWKB = TRUE)[[1]]) }) test_that("st_crs<- gives warnings on changing crs", { diff --git a/tests/testthat/test_sfg.R b/tests/testthat/test_sfg.R index bb0872396..fc458feec 100644 --- a/tests/testthat/test_sfg.R +++ b/tests/testthat/test_sfg.R @@ -62,11 +62,11 @@ test_that("Ops work for sfc", { hole1 = matrix(c(1,1,1,2,2,2,2,1,1,1),ncol=2, byrow=TRUE) hole2 = matrix(c(5,5,5,6,6,6,6,5,5,5),ncol=2, byrow=TRUE) pts = list(outer, hole1, hole2) - expect_true(inherits(st_multipolygon(list(pts)) * 2 + 3, "MULTIPOLYGON")) + expect_s3_class(st_multipolygon(list(pts)) * 2 + 3, "MULTIPOLYGON") gc = st_geometrycollection(list(st_multipolygon(list(pts)), st_point(c(2,2)))) m = matrix(0, 2, 2) diag(m) = c(1, 3) - expect_true(inherits(gc * m - 3, "GEOMETRYCOLLECTION")) + expect_s3_class(gc * m - 3, "GEOMETRYCOLLECTION") }) test_that("Ops work for sfg", { diff --git a/tests/testthat/test_sp.R b/tests/testthat/test_sp.R index 5ab4cfcf7..deda5f61b 100644 --- a/tests/testthat/test_sp.R +++ b/tests/testthat/test_sp.R @@ -45,7 +45,7 @@ test_that("we can convert SpatialPolygons objects without SF comments to sfc and lp <- list(p1, p2, p13, p7, p7a, p6, p5, p4, p3, p8, p11, p12, p9, p9a, p10) spls <- SpatialPolygons(list(Polygons(lp, ID="1"))) expect_equal(comment(spls), "FALSE") - expect_true(is.null(comment(slot(spls, "polygons")[[1]]))) + expect_null(comment(slot(spls, "polygons")[[1]])) spls_sfc <- sf::st_as_sfc(spls) # rsbivand fork coerce_comments 2022-12-21 spls_rt <- as(spls_sfc, "Spatial") diff --git a/tests/testthat/test_tidy.R b/tests/testthat/test_tidy.R index 651cc5e5e..375ac46c4 100644 --- a/tests/testthat/test_tidy.R +++ b/tests/testthat/test_tidy.R @@ -3,8 +3,8 @@ nc <- st_read(system.file("shape/nc.shp", package="sf"), quiet = TRUE) test_that("select works", { skip_if_not_installed("dplyr") - expect_true(nc %>% select_("AREA", attr(., "sf_column")) %>% inherits("sf")) - expect_true(nc %>% select(AREA) %>% inherits("sf")) + expect_s3_class(nc %>% select("AREA", attr(., "sf_column")), "sf") + expect_s3_class(nc %>% select(AREA), "sf") }) test_that("filter to sfc works", { @@ -24,9 +24,9 @@ suppressMessages(require(tidyr, quietly = TRUE)) test_that("separate and unite work", { skip_if_not_installed("dplyr") skip_if_not_installed("tidyr") - expect_true(nc %>% separate(CNTY_ID, c("a", "b"), sep = 2) %>% inherits("sf")) - expect_true(nc %>% separate(CNTY_ID, c("a", "b"), sep = 2) %>% - unite(CNTY_ID_NEW, c("a", "b"), sep = "") %>% inherits("sf")) + expect_s3_class(nc %>% separate(CNTY_ID, c("a", "b"), sep = 2), "sf") + expect_s3_class(nc %>% separate(CNTY_ID, c("a", "b"), sep = 2) %>% + unite(CNTY_ID_NEW, c("a", "b"), sep = ""), "sf") }) test_that("separate_rows work", { @@ -39,9 +39,7 @@ test_that("separate_rows work", { st_point(c(2, 2)), st_point(c(3, 3))), stringsAsFactors = FALSE)) - expect_true(d %>% - separate_rows(y, convert = TRUE) %>% - inherits("sf")) + expect_s3_class(separate_rows(d, y, convert = TRUE), "sf") expect_identical(d %>% separate_rows(y, convert = TRUE) %>% st_geometry(), @@ -57,7 +55,7 @@ test_that("group/ungroup works", { skip_if_not_installed("dplyr") tbl = tibble(a = c(1,1,2,2), g = st_sfc(st_point(0:1), st_point(1:2), st_point(2:3), st_point(3:4))) d = st_sf(tbl) - e <- d %>% group_by(a) %>% ungroup + e <- d %>% group_by(a) %>% ungroup() expect_equal(as.data.frame(d), as.data.frame(e)) }) @@ -67,10 +65,10 @@ test_that("sample_n etc work", { d = st_sf(tbl) expect_sampled <- function(x) { - expect_true(inherits(x, c("sf", "tbl_df"))) + expect_s3_class(x, c("sf", "tbl_df")) expect_named(x, c("a", "g")) expect_equal(nrow(x), 2) - expect_true(inherits(x$g, "sfc_POINT")) + expect_s3_class(x$g, "sfc_POINT") } expect_sampled(sample_n(d, 2)) @@ -86,16 +84,8 @@ test_that("nest() works", { exp_data = list(d[1:2, "g"], d[3:4, "g"]) - # Work around issues of tibble comparison in dplyr 0.8.5 (faulty - # all.equal.tbl_df() method) - if (utils::packageVersion("dplyr") < "0.8.99") { - dfs = lapply(out$data, function(x) st_sf(as.data.frame(x))) - exp_data = lapply(exp_data, function(x) st_sf(as.data.frame(x))) - expect_identical(dfs, exp_data) - } else { - exp = tibble(a = c(1, 2), data = exp_data) %>% group_by(a) - expect_identical(out, exp) - } + exp = tibble(a = c(1, 2), data = exp_data) %>% group_by(a) + expect_identical(out, exp) }) test_that("st_intersection of tbl returns tbl", { @@ -286,17 +276,17 @@ test_that("`select()` and `transmute()` observe back-stickiness of geometry colu test_that("rowwise_df class is retained on row slice", { skip_if_not_installed("dplyr") - expect_true(nc %>% rowwise() %>% slice(1) %>% inherits("rowwise_df")) + expect_s3_class(slice(rowwise(nc), 1), "rowwise_df") }) test_that("grouped_df class is retained on row slice", { skip_if_not_installed("dplyr") - expect_true(nc %>% group_by(PERIMETER > 2) %>% slice(1) %>% inherits("grouped_df")) + expect_s3_class(nc %>% group_by(PERIMETER > 2) %>% slice(1), "grouped_df") }) test_that("rowwise_df class is retained on filtered rows", { skip_if_not_installed("dplyr") - expect_true(nc %>% rowwise() %>% filter(AREA > .1) %>% inherits("rowwise_df")) + expect_s3_class(nc %>% rowwise() %>% filter(AREA > .1), "rowwise_df") }) test_that("`group_split.sf()` ignores `.keep` for rowwise_df class", { diff --git a/tests/testthat/test_zm_range.R b/tests/testthat/test_zm_range.R index 8bcc4991f..1f7cbd1d0 100644 --- a/tests/testthat/test_zm_range.R +++ b/tests/testthat/test_zm_range.R @@ -156,7 +156,6 @@ test_that("XYM-only objects correctly calculate M (and not Z)", { expect_true( all( sf::st_m_range( sf_m ) == sf::st_z_range( sf_z ) ) ) - expect_true( is.null( sf::st_z_range( sf_m ) ) ) - expect_true( is.null( sf::st_m_range( sf_z ) ) ) - + expect_null(sf::st_z_range(sf_m)) + expect_null(sf::st_m_range(sf_z)) }) From f6b87a3686dda6a22a591cc6496368300d2c5e3e Mon Sep 17 00:00:00 2001 From: olivroy Date: Mon, 11 Dec 2023 11:14:20 -0500 Subject: [PATCH 2/7] Use `[[` for `sf_extSoftVersion()` access --- tests/sfc.R | 2 +- tests/testthat/test_crs.R | 6 +++--- tests/testthat/test_gdal.R | 8 ++++---- tests/testthat/test_geos.R | 2 +- tests/testthat/test_sp.R | 2 +- tests/testthat/test_write.R | 2 +- tests/testthat/test_zm_range.R | 2 +- 7 files changed, 12 insertions(+), 12 deletions(-) diff --git a/tests/sfc.R b/tests/sfc.R index 1e89beefa..36f5f2c5a 100644 --- a/tests/sfc.R +++ b/tests/sfc.R @@ -200,7 +200,7 @@ p <- st_sample(x, 10) x = st_sfc(st_polygon(list(rbind(c(-180,-90),c(180,-90),c(180,90),c(-180,90),c(-180,-90)))), crs=st_crs(4326)) #FIXME: -# if (sf_extSoftVersion()["proj.4"] >= "4.9.0") # lwgeom breaks on this +# if (sf_extSoftVersion()[["proj.4"]] >= "4.9.0") # lwgeom breaks on this # (p <- st_sample(x, 10)) pt = st_multipoint(matrix(1:20,,2)) st_sample(p, 3) diff --git a/tests/testthat/test_crs.R b/tests/testthat/test_crs.R index c5eb7ecdc..426a1b31d 100644 --- a/tests/testthat/test_crs.R +++ b/tests/testthat/test_crs.R @@ -41,18 +41,18 @@ test_that("sf_proj_info works", { }) test_that("sf_proj_info works for datum files", { - skip_if_not(sf_extSoftVersion()[["proj.4"]] < "6.0.0") + skip_if(sf_extSoftVersion()[["proj.4"]] >= "6.0.0") expect_silent(x <- sf_proj_info("have_datum_files")) }) test_that("$.crs works", { - skip_if_not(sf_extSoftVersion()[["proj.4"]] < "6.0.0") + skip_if(sf_extSoftVersion()[["proj.4"]] >= "6.0.0") expect_false(is.null(st_crs("+init=epsg:3857")$epsg)) expect_type(st_crs("+init=epsg:3857")$proj4string, "character") }) test_that("$.crs works with +units", { - skip_if_not(sf_extSoftVersion()[["proj.4"]] < "6.0.0") + skip_if(sf_extSoftVersion()[["proj.4"]] >= "6.0.0") expect_type(st_crs("+init=epsg:3857 +units=m")$b, "double") expect_type(st_crs("+init=epsg:3857 +units=m")$units, "character") }) diff --git a/tests/testthat/test_gdal.R b/tests/testthat/test_gdal.R index 9e8aa092b..aee94e80f 100644 --- a/tests/testthat/test_gdal.R +++ b/tests/testthat/test_gdal.R @@ -12,7 +12,7 @@ test_that("st_transform works", { #attr(s2.tr, "crs")$proj4string = "" st_crs(s1.tr) = NA_crs_ # st_crs(s2.tr) = NA_crs_ -# if (sf_extSoftVersion()["proj.4"] < "5.0.0") # FIXME: +# if (sf_extSoftVersion()[["proj.4"]] < "5.0.0") # FIXME: # expect_equal(s1.tr, s2.tr) toCrs = 3857 @@ -20,7 +20,7 @@ test_that("st_transform works", { #attr(s1.tr, "crs")$proj4string = "" st_crs(s1.tr) = NA_crs_ # st_crs(s2.tr) = NA_crs_ -# if (sf_extSoftVersion()["proj.4"] < "5.0.0") # FIXME: +# if (sf_extSoftVersion()[["proj.4"]] < "5.0.0") # FIXME: # expect_equal(s1.tr, s2.tr) expect_silent({ @@ -42,8 +42,8 @@ test_that("st_wrap_dateline works", { }) test_that('gdal_subdatasets works', { - skip_if_not(sf_extSoftVersion()[["GDAL"]] >= "2.1.0") - skip_if_not(sf_extSoftVersion()[["GDAL"]] < "2.5.0") # FIXME: + skip_if(sf_extSoftVersion()[["GDAL"]] < "2.1.0") + skip_if(sf_extSoftVersion()[["GDAL"]] >= "2.5.0") # FIXME: skip_on_os("mac") # FIXME: fname = system.file("nc/cropped.nc", package = "sf") sd2 = gdal_subdatasets(fname)[[2]] diff --git a/tests/testthat/test_geos.R b/tests/testthat/test_geos.R index 489f0b678..6b243f96a 100644 --- a/tests/testthat/test_geos.R +++ b/tests/testthat/test_geos.R @@ -172,7 +172,7 @@ test_that("st_difference works with partially overlapping geometries", { pl3 = st_polygon(list(matrix(c(0, 1.25, 2, 1.25, 1, 2.5, 0, 1.25), byrow = TRUE, ncol = 2))) in1 = st_sfc(list(pl1, pl2, pl3)) in2 = st_sf(order = c("A", "B", "C"), geometry = st_sfc(list(pl1, pl2, pl3), crs = 4326), agr = "constant") - if (package_version(gsub("[a-zA-Z]", "", sf_extSoftVersion()["GEOS"])) < "3.9.0") { + if (package_version(gsub("[a-zA-Z]", "", sf_extSoftVersion()[["GEOS"]])) < "3.9.0") { correct_geom = st_sfc(list( st_polygon(list(matrix(c(0, 2, 1, 0, 0, 0, 1, 0), ncol = 2))), st_polygon(list(matrix(c(0.5, 0, 1, 2, 1.5, 1, 0.5, 0.5, 0.5, 1.5, 0.5, 0.5, 1, 0.5), ncol = 2))), diff --git a/tests/testthat/test_sp.R b/tests/testthat/test_sp.R index deda5f61b..3d85f8ea1 100644 --- a/tests/testthat/test_sp.R +++ b/tests/testthat/test_sp.R @@ -24,7 +24,7 @@ test_that("we can convert points & lines to and from sp objects", { test_that("we can convert SpatialPolygons objects without SF comments to sfc and back", { skip_if_not_installed("sp") - # skip_if_not(package_version(sf_extSoftVersion()["GEOS"]) >= "3.11.0"); #2079 + # skip_if_not(package_version(sf_extSoftVersion()[["GEOS"]]) >= "3.11.0"); #2079 library(sp) # nested holes https://github.com/r-spatial/evolution/issues/9 p1 <- Polygon(cbind(x=c(0, 0, 10, 10, 0), y=c(0, 10, 10, 0, 0)), hole=FALSE) # I diff --git a/tests/testthat/test_write.R b/tests/testthat/test_write.R index f095ef362..b40be146e 100644 --- a/tests/testthat/test_write.R +++ b/tests/testthat/test_write.R @@ -122,7 +122,7 @@ test_that("FID feature ID gets written and read", { tf <- paste0(tempfile(), ".geojson") write_sf(nc, tf, fid_column_name = "f_id") nc2 = read_sf(tf, fid_column_name = "f_id") - if (sf_extSoftVersion()["GDAL"] >= "2.3.2") + if (sf_extSoftVersion()[["GDAL"]] >= "2.3.2") expect_equal(nc$f_id, nc2$f_id) }) diff --git a/tests/testthat/test_zm_range.R b/tests/testthat/test_zm_range.R index 1f7cbd1d0..fc62cc7a2 100644 --- a/tests/testthat/test_zm_range.R +++ b/tests/testthat/test_zm_range.R @@ -120,7 +120,7 @@ test_that("zmrange works on more compliated examples", { test_that("transform includes zm in output", { - skip_if_not(sf_extSoftVersion()["GDAL"] > "2.1.0") + skip_if(sf_extSoftVersion()[["GDAL"]] <= "2.1.0") p1 = st_point(c(7,52,52)) p2 = st_point(c(-30,20,20)) From a6da79e7d703c7590e776271976889e5f4ad339c Mon Sep 17 00:00:00 2001 From: olivroy Date: Mon, 11 Dec 2023 12:20:34 -0500 Subject: [PATCH 3/7] Tidyup test_zm_range.R --- tests/testthat/test_zm_range.R | 217 ++++++++++++++++++--------------- 1 file changed, 117 insertions(+), 100 deletions(-) diff --git a/tests/testthat/test_zm_range.R b/tests/testthat/test_zm_range.R index fc62cc7a2..8282c0b63 100644 --- a/tests/testthat/test_zm_range.R +++ b/tests/testthat/test_zm_range.R @@ -1,83 +1,90 @@ - -test_that("sf::st_z_range and sf::st_z_range returns correct value from sfg objects", { - - pt <- sf::st_point( x = c(0,1,3,3)) - expect_true( all( sf::st_z_range( pt ) == c(3,3) ) ) - expect_true( all( sf::st_z_range( pt ) == sf::st_z_range( pt ) ) ) - - mp <- sf::st_multipoint( x = matrix(c(0,1,1,1,0,2,5,5), ncol = 4, byrow = T)) - expect_true( all( sf::st_z_range( mp ) == c(1,5) ) ) - expect_true( all( sf::st_z_range( mp ) == sf::st_z_range( mp ) ) ) - - ls <- sf::st_linestring(x = matrix(c(0,1,1,1,0,2,5,5,0,3,10,10), ncol = 4, byrow = T)) - expect_true( all( sf::st_z_range( ls ) == c(1,10) ) ) - expect_true( all( sf::st_z_range( ls ) == sf::st_z_range( ls ) ) ) - - mls <- sf::st_multilinestring(x = list(ls, matrix(c(0,1,5,5,0,1,-1,-1), ncol = 4, byrow = T))) - expect_true( all( sf::st_z_range( mls ) == c(-1, 10 ) ) ) - expect_true( all( sf::st_z_range( mls ) == sf::st_z_range( mls ) ) ) - - pl <- sf::st_polygon(x = list(matrix(c(0,0,1,1,0,1,2,2,1,1,3,3,1,0,4,4,0,0,1,1), ncol = 4, byrow = T))) - expect_true( all( sf::st_z_range( pl ) == c(1, 4))) - expect_true( all( sf::st_z_range( pl ) == sf::st_z_range( pl ) ) ) - - mpl <- sf::st_multipolygon(x = list(pl, sf::st_polygon( x = list( matrix(c(0,0,10,10,0,-1,9,9,-1,-1,-10,-10,-1,0,-5,-5,0,0,10,10), ncol = 4, byrow = T) ) ) ) ) - expect_true( all( sf::st_z_range( mpl ) == c(-10, 10) ) ) - expect_true( all( sf::st_z_range( mpl ) == sf::st_z_range( mpl ) ) ) - - gc <- sf::st_geometrycollection(x = list(pt, mp)) - expect_true( all( sf::st_z_range( gc ) == c(1, 5) ) ) - expect_true( all( sf::st_z_range( gc ) == sf::st_z_range( gc ) ) ) - - gc <- sf::st_geometrycollection(x = list(ls, pl)) - expect_true( all( sf::st_z_range( gc ) == c(1, 10) ) ) - expect_true( all( sf::st_z_range( gc ) == sf::st_z_range( gc ) ) ) - - gc <- sf::st_geometrycollection(x = list(pt, mpl)) - expect_true( all( sf::st_z_range( gc ) == c(-10, 10) ) ) - expect_true( all( sf::st_z_range( gc ) == sf::st_z_range( gc ) ) ) - +# Expect the z range, strip attributes to only compare values. +expect_st_z_range <- function(object, expected) { + expect_equal(unclass(st_z_range(object)), expected, check.attributes = FALSE) +} + +test_that("st_z_range and st_z_range returns correct value from sfg objects", { + + pt <- st_point(x = c(0,1,3,3)) + + expect_st_z_range(pt, c(3,3)) + expect_equal(st_z_range(pt), st_z_range(pt)) + + mp <- st_multipoint(x = matrix(c(0,1,1,1,0,2,5,5), ncol = 4, byrow = TRUE)) + expect_st_z_range(mp, c(1, 5)) + expect_equal(st_z_range(mp), st_z_range(mp)) + + ls <- st_linestring(x = matrix(c(0,1,1,1,0,2,5,5,0,3,10,10), ncol = 4, byrow = TRUE)) + expect_st_z_range(ls, c(1, 10)) + expect_equal(st_z_range(ls), st_z_range(ls)) + + mls <- st_multilinestring(x = list(ls, matrix(c(0,1,5,5,0,1,-1,-1), ncol = 4, byrow = TRUE))) + expect_st_z_range(mls, c(-1, 10)) + expect_equal(st_z_range(mls), st_z_range(mls)) + + pl <- st_polygon(x = list(matrix(c(0,0,1,1,0,1,2,2,1,1,3,3,1,0,4,4,0,0,1,1), ncol = 4, byrow = T))) + expect_st_z_range(pl, c(1, 4)) + expect_equal(st_z_range(pl), st_z_range(pl)) + + mpl <- st_multipolygon( + x = list(pl, st_polygon( + x = list(matrix(c(0,0,10,10,0,-1,9,9,-1,-1,-10,-10,-1,0,-5,-5,0,0,10,10), + ncol = 4, byrow = TRUE)))) + ) + expect_st_z_range(mpl, c(-10, 10)) + expect_equal(st_z_range(mpl), st_z_range(mpl)) + + gc <- st_geometrycollection(x = list(pt, mp)) + expect_st_z_range(gc, c(1, 5)) + expect_equal(st_z_range(gc), st_z_range(gc)) + + gc <- st_geometrycollection(x = list(ls, pl)) + expect_st_z_range(gc, c(1, 10)) + expect_equal(st_z_range(gc), st_z_range(gc)) + + gc <- st_geometrycollection(x = list(pt, mpl)) + expect_st_z_range(gc, c(-10, 10)) + expect_equal(st_z_range(gc), st_z_range(gc)) }) test_that("sf::st_z_range and sf::st_z_range returns correct value from sfc objects", { + pt <- st_sfc(st_point( x = c(0,1,3,3))) + # expect_equal(attr( pt, "zbox" ), c(3, 3)) # FIXME: now NULL + expect_st_z_range(pt, c(3, 3)) + expect_equal(st_z_range(pt), st_z_range(pt)) - pt <- sf::st_sfc( sf::st_point( x = c(0,1,3,3))) - expect_true( all( attr( pt, "zbox" ) == c(3,3) ) ) - expect_true( all( sf::st_z_range( pt ) == c(3,3) ) ) - expect_true( all( sf::st_z_range( pt ) == sf::st_z_range( pt ) ) ) + mp <- st_sfc(st_multipoint( x = matrix(c(0,1,1,1,0,2,5,5), ncol = 4, byrow = TRUE))) + expect_st_z_range(mp, c(1, 5)) + expect_equal(st_z_range(mp), st_z_range(mp)) - mp <- sf::st_sfc( sf::st_multipoint( x = matrix(c(0,1,1,1,0,2,5,5), ncol = 4, byrow = T))) - expect_true( all( sf::st_z_range( mp ) == c(1,5) ) ) - expect_true( all( sf::st_z_range( mp ) == sf::st_z_range( mp ) ) ) + ls <- st_sfc(st_linestring(x = matrix(c(0,1,1,1,0,2,5,5,0,3,10,10), ncol = 4, byrow = TRUE))) + expect_st_z_range(ls, c(1, 10)) + expect_equal(st_z_range(ls), st_z_range(ls)) - ls <- sf::st_sfc( sf::st_linestring(x = matrix(c(0,1,1,1,0,2,5,5,0,3,10,10), ncol = 4, byrow = T))) - expect_true( all( sf::st_z_range( ls ) == c(1,10) ) ) - expect_true( all( sf::st_z_range( ls ) == sf::st_z_range( ls ) ) ) + mls <- st_sfc(st_multilinestring(x = list(ls[[1]], matrix(c(0,1,5,5,0,1,-1,-1), ncol = 4, byrow = TRUE)))) + expect_st_z_range(mls, c(-1, 10)) + expect_equal(st_z_range(mls), st_z_range(mls)) - mls <- sf::st_sfc( sf::st_multilinestring(x = list(ls[[1]], matrix(c(0,1,5,5,0,1,-1,-1), ncol = 4, byrow = T)))) - expect_true( all( sf::st_z_range( mls ) == c(-1, 10 ) ) ) - expect_true( all( sf::st_z_range( mls ) == sf::st_z_range( mls ) ) ) + pl <- st_sfc(st_polygon(x = list(matrix(c(0,0,1,1,0,1,2,2,1,1,3,3,1,0,4,4,0,0,1,1), ncol = 4, byrow = TRUE)))) + expect_st_z_range(pl, c(1, 4)) + expect_equal(st_z_range(pl), st_z_range(pl)) - pl <- sf::st_sfc( sf::st_polygon(x = list(matrix(c(0,0,1,1,0,1,2,2,1,1,3,3,1,0,4,4,0,0,1,1), ncol = 4, byrow = T)))) - expect_true( all( sf::st_z_range( pl ) == c(1, 4))) - expect_true( all( sf::st_z_range( pl ) == sf::st_z_range( pl ) ) ) + mpl <- st_sfc(st_multipolygon(x = list(pl[[1]], st_polygon( x = list( matrix(c(0,0,10,10,0,-1,9,9,-1,-1,-10,-10,-1,0,-5,-5,0,0,10,10), ncol = 4, byrow = TRUE)))))) + expect_st_z_range(mpl, c(-10, 10)) + expect_equal(st_z_range(mpl), st_z_range(mpl)) - mpl <- sf::st_sfc( sf::st_multipolygon(x = list(pl[[1]], sf::st_polygon( x = list( matrix(c(0,0,10,10,0,-1,9,9,-1,-1,-10,-10,-1,0,-5,-5,0,0,10,10), ncol = 4, byrow = T) ) ) ) )) - expect_true( all( sf::st_z_range( mpl ) == c(-10, 10) ) ) - expect_true( all( sf::st_z_range( mpl ) == sf::st_z_range( mpl ) ) ) + gc <- st_sfc(st_geometrycollection(x = list(pt[[1]], mp[[1]]))) + expect_st_z_range(gc, c(1, 5)) + expect_equal(st_z_range(gc), st_z_range(gc)) - gc <- sf::st_sfc( sf::st_geometrycollection(x = list(pt[[1]], mp[[1]]))) - expect_true( all( sf::st_z_range( gc ) == c(1, 5) ) ) - expect_true( all( sf::st_z_range( gc ) == sf::st_z_range( gc ) ) ) + gc <- st_sfc(st_geometrycollection(x = list(ls[[1]], pl[[1]]))) + expect_st_z_range(gc, c(1, 10)) + expect_equal(st_z_range(gc), st_z_range(gc)) - gc <- sf::st_sfc( sf::st_geometrycollection(x = list(ls[[1]], pl[[1]]))) - expect_true( all( sf::st_z_range( gc ) == c(1, 10) ) ) - expect_true( all( sf::st_z_range( gc ) == sf::st_z_range( gc ) ) ) - - gc <- sf::st_sfc( sf::st_geometrycollection(x = list(pt[[1]], mpl[[1]]))) - expect_true( all( sf::st_z_range( gc ) == c(-10, 10) ) ) - expect_true( all( sf::st_z_range( gc ) == sf::st_z_range( gc ) ) ) + gc <- st_sfc(st_geometrycollection(x = list(pt[[1]], mpl[[1]]))) + expect_st_z_range(gc, c(-10, 10)) + expect_equal(st_z_range(gc), st_z_range(gc)) }) @@ -87,17 +94,24 @@ test_that("zmrange works on more compliated examples", { m <- matrix(rnorm(300), ncol = 3) expected <- c(min(m[,3]), max(m[,3])) - ls <- sf::st_linestring(x = m ) - expect_true( all( sf::st_z_range(ls) == expected ) ) - - ls <- sf::st_sfc( ls ) - expect_true( all( sf::st_z_range(ls) == expected ) ) - expect_true( all( attr(ls, "z_range") == expected ) ) - - ls <- sf::st_sf( geometry = ls ) - expect_true( all( sf::st_z_range(ls) == expected ) ) - expect_true( all( attr(ls$geometry, "z_range") == expected ) ) - + ls <- st_linestring(x = m) + expect_st_z_range(ls, expected) + + ls <- st_sfc(ls) + expect_st_z_range(ls, expected) + expect_equal( + unclass(attr(ls, "z_range")), + expected, + check.attributes = FALSE + ) + + ls <- st_sf(geometry = ls) + expect_st_z_range(ls, expected) + expect_equal( + unclass(attr(ls$geometry, "z_range")), + expected, + check.attributes = FALSE + ) n <- 100 lst <- list() min_z <- numeric(n) @@ -105,16 +119,15 @@ test_that("zmrange works on more compliated examples", { set.seed(123) - for(i in 1:n) { - m <- matrix(rnorm(sample(seq(3,300,by=3), size = 1)), ncol = 3) + for(i in seq_along(n)) { + m <- matrix(rnorm(sample(seq(3,300, by = 3), size = 1)), ncol = 3) min_z[i] <- min(m[,3]) max_z[i] <- max(m[,3]) - lst[[i]] <- sf::st_linestring( m ) + lst[[i]] <- st_linestring(m) } - sfc <- sf::st_sfc( lst ) - - expect_true( all (sf::st_z_range( sfc ) == c(min(min_z), max(max_z)) ) ) + sfc <- st_sfc(lst) + expect_st_z_range(sfc, c(min(min_z), max(max_z))) }) @@ -127,35 +140,39 @@ test_that("transform includes zm in output", { sfc = st_sfc(p1, p2, crs = 4326) res <- st_transform(sfc, 3857) - expect_true( "z_range" %in% names( attributes(res) ) ) - expect_equal( sf::st_z_range(res[[1]]), sf::st_z_range(sfc[[1]]) ) + expect_contains(names(attributes(res)), "z_range") + expect_equal(st_z_range(res[[1]]), st_z_range(sfc[[1]])) p1 = st_point(c(7,52,52,7)) p2 = st_point(c(-30,20,20,-30)) sfc = st_sfc(p1, p2, crs = 4326) res <- st_transform(sfc, 3857) - expect_true( "z_range" %in% names( attributes(res) ) ) - expect_equal( sf::st_z_range(res[[1]]), sf::st_z_range(sfc[[1]]) ) - expect_true( "m_range" %in% names( attributes(res) ) ) - expect_equal( sf::st_m_range(res[[1]]), sf::st_m_range(sfc[[1]]) ) + expect_contains(names(attributes(res)), c("z_range", "m_range")) + expect_equal(st_z_range(res[[1]]), st_z_range(sfc[[1]])) + expect_equal(st_m_range(res[[1]]), st_m_range(sfc[[1]])) }) test_that("XYM-only objects correctly calculate M (and not Z)", { - skip_if_not(sf_extSoftVersion()["GDAL"] > "2.1.0") + skip_if(sf_extSoftVersion()[["GDAL"]] <= "2.1.0") - sf_m <- sf::st_read(system.file("/shape/storms_xyzm.shp", package = "sf"), quiet = TRUE) - m <- sf::st_coordinates( sf_m ) + sf_m <- st_read(system.file("/shape/storms_xyzm.shp", package = "sf"), quiet = TRUE) + m <- st_coordinates(sf_m) - mmin <- min( m[, 3] ); mmax <- max( m[, 3] ) - expect_true( all( sf::st_m_range( sf_m ) == c(mmin, mmax) ) ) + mmin <- min(m[, 3]) + mmax <- max(m[, 3]) + expect_equal(unclass(st_m_range(sf_m)), c(mmin, mmax), check.attributes = FALSE) - sf_z <- sf::st_read(system.file("/shape/storms_xyz.shp", package = "sf"), quiet = TRUE) + sf_z <- st_read(system.file("/shape/storms_xyz.shp", package = "sf"), quiet = TRUE) - expect_true( all( sf::st_m_range( sf_m ) == sf::st_z_range( sf_z ) ) ) + expect_equal( + unclass(st_m_range(sf_m)), + unclass(st_z_range(sf_z)), + check.attributes = FALSE + ) - expect_null(sf::st_z_range(sf_m)) - expect_null(sf::st_m_range(sf_z)) + expect_null(st_z_range(sf_m)) + expect_null(st_m_range(sf_z)) }) From 83903b18c0e18ccc91faa2bb0277d9cd19784fe9 Mon Sep 17 00:00:00 2001 From: olivroy Date: Mon, 11 Dec 2023 13:36:48 -0500 Subject: [PATCH 4/7] Use testthat checks for classes --- tests/testthat/test_postgis_RPostgres.R | 2 +- tests/testthat/test_sf.R | 24 ++++++++++++------------ tests/testthat/test_sp.R | 13 ++++++++----- 3 files changed, 21 insertions(+), 18 deletions(-) diff --git a/tests/testthat/test_postgis_RPostgres.R b/tests/testthat/test_postgis_RPostgres.R index c6497b70a..b0e1ce4bf 100644 --- a/tests/testthat/test_postgis_RPostgres.R +++ b/tests/testthat/test_postgis_RPostgres.R @@ -357,7 +357,7 @@ test_that("can read using driver", { RPostgres::Postgres(), host = "localhost", dbname = "empty"), - silent=TRUE + silent = TRUE ) skip_if_not( can_con(empty), diff --git a/tests/testthat/test_sf.R b/tests/testthat/test_sf.R index 80ffd0dd5..525e716ac 100644 --- a/tests/testthat/test_sf.R +++ b/tests/testthat/test_sf.R @@ -23,7 +23,7 @@ test_that("we can create points sf from data.frame", { meuse_sf = st_as_sf(meuse, coords = c("x", "y"), crs = 28992) meuse_sf[1:5,] summary(meuse_sf[1:5,]) - expect_identical(class(meuse_sf), c("sf", "data.frame")) + expect_s3_class(meuse_sf, c("sf", "data.frame"), exact = TRUE) }) test_that("st_zm works", { @@ -69,14 +69,14 @@ test_that("st_as_sf bulk points work", { xyz_sf = st_as_sf(x, coords = c("y", "x", "dist")) xym_sf = st_as_sf(x, coords = c("y", "x", "dist"), dim = "XYM") xyzm_sf = st_as_sf(x, coords = c("x", "y", "dist", "zinc"), dim = "XYZM") - expect_identical(class(meuse_sf), c("sf", "data.frame")) - expect_identical(class(xyz_sf), c("sf", "data.frame")) - expect_identical(class(xym_sf), c("sf", "data.frame")) - expect_identical(class(xyzm_sf), c("sf", "data.frame")) - expect_length(unclass(st_geometry(meuse_sf)[[1]]), 2L) - expect_length(unclass(st_geometry(xyz_sf)[[1]]), 3L) - expect_length(unclass(st_geometry(xym_sf)[[1]]), 3L) - expect_length(unclass(st_geometry(xyzm_sf)[[1]]), 4L) + expect_s3_class(meuse_sf, c("sf", "data.frame"), exact = TRUE) + expect_s3_class(xyz_sf, c("sf", "data.frame"), exact = TRUE) + expect_s3_class(xym_sf, c("sf", "data.frame"), exact = TRUE) + expect_s3_class(xyzm_sf, c("sf", "data.frame"), exact = TRUE) + expect_length(st_geometry(meuse_sf)[[1]], 2L) + expect_length(st_geometry(xyz_sf)[[1]], 3L) + expect_length(st_geometry(xym_sf)[[1]], 3L) + expect_length(st_geometry(xyzm_sf)[[1]], 4L) }) @@ -86,7 +86,7 @@ test_that("transform work", { data(meuse, package = "sp") x = st_as_sf(meuse, coords = c("x", "y"), crs = 28992) x2 = transform(x, elev2 = elev^2, lead_zinc = lead/zinc) - expect_s3_class(x, 'sf') + expect_s3_class(x, "sf") expect_identical(class(x2), class(x)) expect_identical(st_bbox(x), st_bbox(x)) expect_identical(st_crs(x), st_crs(x)) @@ -97,10 +97,10 @@ test_that("empty agr attribute is named after subset", { sf = st_sf(data.frame(x = st_sfc(st_point(1:2)))) out = sf[, "geometry"] agr = attr(out, "agr") - expect_identical(names(agr), character()) + expect_named(agr, character()) }) test_that("duplicated work",{ sf = st_sf(data.frame(x = st_sfc(st_point(1:2))[rep(1,4)], a=gl(2,2), b=as.numeric(gl(2,2)))) expect_identical(duplicated(sf), c(FALSE,TRUE,FALSE,TRUE)) - expect_s3_class(unique(sf),'sf') + expect_s3_class(unique(sf), "sf") }) diff --git a/tests/testthat/test_sp.R b/tests/testthat/test_sp.R index 3d85f8ea1..7a76c8559 100644 --- a/tests/testthat/test_sp.R +++ b/tests/testthat/test_sp.R @@ -6,20 +6,23 @@ test_that("we can convert points & lines to and from sp objects", { sp = as(s1, "Spatial") s2 = st_as_sf(sp) # expect_identical(s1, s2) -> name differences - expect_identical(class(st_geometry(s2)), c("sfc_POINT", "sfc")) #-> name differences + expect_s3_class(st_geometry(s2), c("sfc_POINT", "sfc"), exact = TRUE) #-> name differences + l = st_linestring(matrix(1:6,3)) l1 = st_sf(a = 1, geom = st_sfc(l)) sp_l = as(l1, "Spatial") - expect_identical(class(sp_l)[[1]], "SpatialLinesDataFrame") #-> name differences + expect_s4_class(sp_l, "SpatialLinesDataFrame") #-> name differences + l2 = st_as_sf(sp_l) - expect_identical(class(st_geometry(l2)), c("sfc_LINESTRING", "sfc")) #-> name differences + expect_s3_class(st_geometry(l2), c("sfc_LINESTRING", "sfc"), exact = TRUE) #-> name differences # test multilinestring -> sp l = st_multilinestring(list(matrix(1:6,3), matrix(11:16,3), matrix(21:26,3))) l1 = st_sf(a = 1, geom = st_sfc(l)) sp_l = as(l1, "Spatial") - expect_identical(class(sp_l)[[1]], "SpatialLinesDataFrame") #-> name differences + expect_s4_class(sp_l, "SpatialLinesDataFrame") #-> name differences + l2 = st_as_sf(sp_l) - expect_identical(class(st_geometry(l2)), c("sfc_MULTILINESTRING", "sfc")) #-> name differences + expect_s3_class(st_geometry(l2), c("sfc_MULTILINESTRING", "sfc"), exact = TRUE) #-> name differences }) test_that("we can convert SpatialPolygons objects without SF comments to sfc and back", { From 4de0fff43c13edd8e6ef8e0949d07dc153d80222 Mon Sep 17 00:00:00 2001 From: olivroy Date: Mon, 11 Dec 2023 13:38:58 -0500 Subject: [PATCH 5/7] Remove `layer` argument, as it is ignored when `query` is supplied. --- tests/testthat/test_read.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/tests/testthat/test_read.R b/tests/testthat/test_read.R index c13ffb044..b049359a5 100644 --- a/tests/testthat/test_read.R +++ b/tests/testthat/test_read.R @@ -1,13 +1,13 @@ test_that("we can read a shapefile using st_read", { - nc <- st_read(system.file("shape/nc.shp", package="sf"), "nc", crs = 4267, quiet = TRUE) - expect_identical(class(nc), c("sf", "data.frame")) + nc <- st_read(system.file("shape/nc.shp", package = "sf"), "nc", crs = 4267, quiet = TRUE) + expect_s3_class(nc, c("sf", "data.frame"), exact = TRUE) 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) + nc_all <- st_read(system.file("shape/nc.shp", package="sf"), query = "select * from nc", crs = 4267, quiet = TRUE) + nc_some <- st_read(system.file("shape/nc.shp", package="sf"), query = "select * from nc where SID79 > 50", crs = 4267, quiet = TRUE) }) test_that("st_read.default gives error messages", { From 4300baa0b8b3f210a5104a5292df681d92a9819e Mon Sep 17 00:00:00 2001 From: olivroy Date: Mon, 11 Dec 2023 13:39:43 -0500 Subject: [PATCH 6/7] Suppress a redundant warning --- tests/testthat/test_crs.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test_crs.R b/tests/testthat/test_crs.R index 426a1b31d..e8160dfec 100644 --- a/tests/testthat/test_crs.R +++ b/tests/testthat/test_crs.R @@ -17,7 +17,7 @@ test_that("st_crs works", { expect_silent(st_crs(nc1) <- st_crs(nc1)) if (sf_extSoftVersion()[["GDAL"]] > "2.2.3") { - expect_error(st_crs("+proj=ll"), "invalid crs") + suppressWarnings(expect_error(st_crs("+proj=ll"), "invalid crs")) # expect_error(st_crs("+proj=longlat +datum=NAD26")) } expect_silent(st_crs("+proj=longlat")) From e711f597cce349ada1ded14af3bfbc10d79fa0ed Mon Sep 17 00:00:00 2001 From: olivroy Date: Mon, 11 Dec 2023 13:40:15 -0500 Subject: [PATCH 7/7] Suggest dplyr 1.0.0 (as it allows the deletion of a test! --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 53d18b780..e2bb547d0 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -75,7 +75,7 @@ Suggests: blob, nanoarrow, covr, - dplyr (>= 0.8-3), + dplyr (>= 1.0.0), ggplot2, knitr, lwgeom (>= 0.2-1),