Merge pull request #2288 from olivroy/tests

edzer · web-flow · commit a5f9f0fe4913 · 2024-01-26T18:23:56.000+01:00
Various Tests lints
diff --git 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),
diff --git 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-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
@@ -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"))
@@ -36,31 +36,31 @@ 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")[1])
-  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", {
-  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")
-  expect_true(!is.null(st_crs("+init=epsg:3857")$epsg))
-  expect_true(is.character(st_crs("+init=epsg:3857")$proj4string))
+  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")
-  expect_true(is.numeric(st_crs("+init=epsg:3857 +units=m")$b)) 
-  expect_true(is.character(st_crs("+init=epsg:3857 +units=m")$units))
+  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")
 })
 
 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_gdal.R b/tests/testthat/test_gdal.R
@@ -12,15 +12,15 @@ 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
   s1.tr = st_transform(s, toCrs)
   #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
@@ -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))
@@ -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))),
@@ -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_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_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", {
diff --git 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
@@ -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_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))
@@ -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_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
@@ -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
@@ -6,25 +6,28 @@ 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", {
   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
@@ -45,7 +48,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
diff --git a/tests/testthat/test_write.R b/tests/testthat/test_write.R
diff --git a/tests/testthat/test_zm_range.R b/tests/testthat/test_zm_range.R

Original file line number	Diff line number	Diff line change
`@@ -357,7 +357,7 @@ test_that("can read using driver", {`
`357`	`357`	`RPostgres::Postgres(),`
`358`	`358`	`host = "localhost",`
`359`	`359`	`dbname = "empty"),`
`360`		`- silent=TRUE`
	`360`	`+ silent = TRUE`
`361`	`361`	`)`
`362`	`362`	`skip_if_not(`
`363`	`363`	`can_con(empty),`