Lints to tests

Author: olivroy

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)
 
 })

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)
 })

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)
 })

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)
 })

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))

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", {

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", {

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")

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", {

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))
 })