tests/testthat/test-compat-wk.R

In geos: Open Source Geometry Engine ('GEOS') R API

test_that("wk_handle() works for points", {
  # ability to export an empty point in WKB changed in GEOS 3.9 so use WKT instead
  geoms <- as_geos_geometry(c("POINT (0 1)", "POINT Z (0 1 2)", "POINT EMPTY", NA))

  expect_identical(
    unclass(wk_handle(geoms, wk::wkt_writer())),
    unclass(geos_write_wkt(geoms))
  )

  geoms_srid <- geos_set_srid(geoms, 1234)
  expect_identical(wk::wk_meta(geoms_srid)$srid, c(1234L, 1234L, 1234L, NA))

  geoms_prec <- geos_set_precision(geoms, 0.1)
  expect_identical(wk::wk_meta(geoms_prec)$precision, c(0.1, 0.1, 0.1, NA))
})

test_that("wk_handle() works for linestrings", {
  # WKB export of LINESTRING EMPTY changed in GEOS 3.9 (before it was setting the Z flag)
  geoms <- as_geos_geometry(
    c("LINESTRING (0 1, 2 3)",
      "LINESTRING Z (0 1 2, 3 4 5)",
      "LINESTRING EMPTY", NA
    )
  )
  expect_identical(
    unclass(wk_handle(geoms, wk::wkt_writer())),
    unclass(geos_write_wkt(geoms))
  )

  geoms_srid <- geos_set_srid(geoms, 1234)
  expect_identical(wk::wk_meta(geoms_srid)$srid, c(1234L, 1234L, 1234L, NA))

  geoms_prec <- geos_set_precision(geoms, 0.1)
  expect_identical(wk::wk_meta(geoms_prec)$precision, c(0.1, 0.1, 0.1, NA))
})

test_that("wk_handle() works for polygons", {
  geoms <- as_geos_geometry(
    c("POLYGON ((0 0, 10 0, 10 10, 0 10, 0 0))",
      "POLYGON ((0 0, 10 0, 10 10, 0 10, 0 0), (1 1, 9 1, 9 9, 1 9, 1 1))",
      "POLYGON Z ((0 0 1, 10 0 1, 10 10 1, 0 10 1, 0 0 1))",
      "POLYGON Z ((0 0 1, 10 0 1, 10 10 1, 0 10 1, 0 0 1), (1 1 1, 9 1 1, 9 9 1, 1 9 1, 1 1 1))",
      "POLYGON EMPTY", NA
    )
  )
  expect_identical(
    unclass(wk_handle(geoms, wk::wkt_writer())),
    unclass(geos_write_wkt(geoms))
  )

  geoms_srid <- geos_set_srid(geoms, 1234)
  expect_identical(wk::wk_meta(geoms_srid)$srid, c(1234L, 1234L, 1234L, 1234L, 1234L, NA))

  geoms_prec <- geos_set_precision(geoms, 0.1)
  expect_identical(wk::wk_meta(geoms_prec)$precision, c(0.1, 0.1, 0.1, 0.1, 0.1, NA))
})

test_that("wk_handle() works for multipoints", {
  geoms <- as_geos_geometry(c("MULTIPOINT (0 1)", "MULTIPOINT Z (0 1 2)", "MULTIPOINT EMPTY", NA))
  expect_identical(
    unclass(wk_handle(geoms, wk::wkb_writer(endian = 1))),
    unclass(geos_write_wkb(geoms, endian = 1))
  )

  geoms_srid <- geos_set_srid(geoms, 1234)
  expect_identical(
    unclass(wk_handle(geoms_srid, wk::wkb_writer(endian = 1))),
    unclass(geos_write_wkb(geoms_srid, endian = 1, include_srid = TRUE))
  )

  geoms_prec <- geos_set_precision(geoms, 0.1)
  expect_identical(wk::wk_meta(geoms_prec)$precision, c(0.1, 0.1, 0.1, NA))
})

test_that("wk_handle() works for geometry collections", {
  geoms <- as_geos_geometry(
    c("GEOMETRYCOLLECTION Z (POINT Z (0 1 2), POINT Z (2 3 4))",
      "GEOMETRYCOLLECTION (MULTIPOINT (0 1))",
      "GEOMETRYCOLLECTION (GEOMETRYCOLLECTION (MULTIPOINT (0 1)))",
      "GEOMETRYCOLLECTION EMPTY", NA
    )
  )
  expect_identical(
    unclass(wk_handle(geoms, wk::wkb_writer(endian = 1))),
    unclass(geos_write_wkb(geoms, endian = 1))
  )

  geoms_srid <- geos_set_srid(geoms, 1234)
  expect_identical(
    unclass(wk_handle(geoms_srid, wk::wkb_writer(endian = 1))),
    unclass(geos_write_wkb(geoms_srid, endian = 1, include_srid = TRUE))
  )

  geoms_prec <- geos_set_precision(geoms, 0.1)
  expect_identical(wk::wk_meta(geoms_prec)$precision, c(0.1, 0.1, 0.1, 0.1, NA))
})

test_that("wk_writer() and wk_translate() work for geos_geometry vectors", {
  expect_s3_class(wk::wk_writer(geos_geometry()), "geos_geometry_writer")
  expect_s3_class(wk::wk_translate(wk::wkb(), geos_geometry()), "geos_geometry")
})

test_that("geos_geometry_writer() works for points", {
  expect_identical(
    geos_write_wkt(
      wk::wk_handle(
        wk::wkt(c("POINT EMPTY", "POINT (1 2)", "POINT Z (1 2 3)", NA)),
        geos_geometry_writer()
      )
    ),
    c("POINT EMPTY", "POINT (1 2)", "POINT Z (1 2 3)", NA)
  )
})

test_that("geos_geometry_writer() works for linestrings", {
  expect_identical(
    geos_write_wkt(
      wk::wk_handle(
        wk::wkt(c("LINESTRING EMPTY", "LINESTRING (1 2, 3 4)", "LINESTRING Z (1 2 3, 4 5 6)", NA)),
        geos_geometry_writer()
      )
    ),
    c("LINESTRING EMPTY", "LINESTRING (1 2, 3 4)", "LINESTRING Z (1 2 3, 4 5 6)", NA)
  )
})

test_that("geos_geometry_writer() works for polygons", {
  expect_identical(
    geos_write_wkt(
      wk::wk_handle(
        wk::wkt(
          c("POLYGON EMPTY",
            "POLYGON ((0 0, 10 0, 0 10, 0 0))",
            "POLYGON ((0 0, 10 0, 0 10, 0 0), (1 1, 2 1, 1 2, 1 1))"
          )
        ),
        geos_geometry_writer()
      )
    ),
    c("POLYGON EMPTY",
      "POLYGON ((0 0, 10 0, 0 10, 0 0))",
      "POLYGON ((0 0, 10 0, 0 10, 0 0), (1 1, 2 1, 1 2, 1 1))"
    )
  )
})

test_that("geos_geometry_writer() works for collections", {
  # note: in GEOS, multipoint, multilinestring, multipolygon, and geometrycollection
  # are handled using the same constructor (hence multipoint here)
  expect_identical(
    geos_write_wkt(
      wk::wk_handle(
        wk::wkt(c("MULTIPOINT EMPTY", "MULTIPOINT (1 2, 3 4)", "MULTIPOINT Z (1 2 3)", NA)),
        geos_geometry_writer()
      )
    ),
    c("MULTIPOINT EMPTY", "MULTIPOINT (1 2, 3 4)", "MULTIPOINT Z (1 2 3)", NA)
  )
})

test_that("geos_geometry_writer() works with re-alloced sub-geometry pointer arrays", {
  # check a collection so long that it needs a re-alloc of the pointer arrays
  # that hold the sub-geometries while the geometries are being constructed
  coords <- paste0(1:33, " ", 1:33, collapse = ", ")
  expect_identical(
    geos_write_wkt(
      wk::wk_handle(
        wk::wkt(paste0("MULTIPOINT (", coords, ")")),
        geos_geometry_writer()
      )
    ),
    paste0("MULTIPOINT (", coords, ")")
  )
})

test_that("geos_geometry_writer() silently drops M coordinates", {
  expect_identical(
    geos_write_wkt(
      wk::wk_handle(wk::wkt("POINT ZM (1 2 3 4)"), geos_geometry_writer()),
    ),
    "POINT Z (1 2 3)"
  )

  expect_identical(
    geos_write_wkt(
      wk::wk_handle(wk::wkt("LINESTRING ZM (1 2 3 4, 5 6 7 8)"), geos_geometry_writer()),
    ),
    "LINESTRING Z (1 2 3, 5 6 7)"
  )

  expect_identical(
    geos_write_wkt(
      wk::wk_handle(wk::wkt("POINT M (1 2 3)"), geos_geometry_writer()),
    ),
    "POINT (1 2)"
  )
})

test_that("geos_geometry_writer() works with  a re-alloced coordinate sequence", {
  # default sequence length is 1024 numbers, so >512 would trigger at least once realloc
  coords <- paste0(1:1000, " ", 1:1000, collapse = ", ")
  expect_identical(
    geos_write_wkt(
      wk::wk_handle(
        wk::wkt(paste0("LINESTRING (", coords, ")")),
        geos_geometry_writer()
      )
    ),
    paste0("LINESTRING (", coords, ")")
  )
})

test_that("geos_geometry_writer() passes along SRID to geometry", {
  expect_identical(
    geos_srid(
      wk::wk_handle(
        wk::wkt(c("SRID=4321;POINT(0 1)", "SRID=0;POINT (0 1)", "POINT (0 1)")),
        geos_geometry_writer()
      )
    ),
    c(4321L, 0L, 0L)
  )
})

test_that("geos_geometry_writer() passes along LinearRing creation errors", {
  expect_error(
    wk::wk_handle(wk::wkt("POLYGON ((0 0, 1 1))"), geos_geometry_writer()),
    "IllegalArgumentException"
  )
})

test_that("geos_geometry_writer() passes along geometry creation errors", {
  expect_error(
    wk::wk_handle(wk::wkt("LINESTRING (0 0)"), geos_geometry_writer()),
    "IllegalArgumentException"
  )
})

test_that("geos_geometry_writer() destroys dangling geometries when it aborts via error", {
  # this test is for coverage and is important to include because it forces
  # the cleanup of a GEOSGeometry* that has been created but not yet made the responsibility
  # of the MULTILINESTRING
  expect_error(
    wk::wk_handle(wk::wkt("MULTILINESTRING ((0 0, 1 1), (0 0))"), geos_geometry_writer()),
    "IllegalArgumentException"
  )
})

test_that("geos_geometry_writer() can handle input of undefined size", {
  many_points <- paste0("POINT (", 1:1025, " ", 1:1025, ")")
  expect_identical(
    geos_write_wkt(
      wk::handle_wkt_without_vector_size(
        wk::wkt(many_points),
        geos_geometry_writer()
      )
    ),
    many_points
  )
})

test_that("geos_geometry can be created from wk package classes", {
  expect_s3_class(as_geos_geometry(wk::as_wkb("POINT (30 10)")), "geos_geometry")
  expect_s3_class(as_geos_geometry(wk::as_wkt("POINT (30 10)")), "geos_geometry")
  expect_s3_class(as_geos_geometry(wk::xy(30, 10)), "geos_geometry")
  expect_s3_class(as_geos_geometry(wk::xyz(30, 10, 11)), "geos_geometry")
  expect_s3_class(as_geos_geometry(wk::rct(1, 2, 3, 4)), "geos_geometry")
  expect_s3_class(as_geos_geometry(wk::crc()), "geos_geometry")
  # wk::crc() export must be fixed upstream ()
  # expect_s3_class(as_geos_geometry(wk::crc(30, 10, 10)), "geos_geometry")
})

test_that("coercion to wk::wkt, wk::wkb, wk::xy, and wk::xyz", {
  expect_identical(wk::as_wkt(as_geos_geometry("POINT (0 1)")), wk::wkt("POINT (0 1)"))
  expect_identical(wk::as_wkb(as_geos_geometry("POINT (0 1)")), wk::as_wkb("POINT (0 1)"))
  expect_identical(wk::as_xy(as_geos_geometry("POINT (0 1)")), wk::xy(0, 1))
  expect_equal(
    wk::as_xy(as_geos_geometry("POINT (0 1)"), dims = c("x", "y", "z")),
    wk::xyz(0, 1, NaN)
  )
  expect_equal(
    wk::as_xy(as_geos_geometry("POINT Z (0 1 2)"), dims = c("x", "y", "z")),
    wk::xyz(0, 1, 2)
  )
  expect_equal(
    wk::as_xy(as_geos_geometry("POINT Z (0 1 2)")),
    wk::xyz(0, 1, 2)
  )

  # check empty point conversion
  expect_identical(wk::as_wkt(as_geos_geometry("POINT EMPTY")), wk::as_wkt("POINT EMPTY"))
  expect_identical(wk::as_wkb(as_geos_geometry("POINT EMPTY")), wk::as_wkb("POINT EMPTY"))
  expect_equal(wk::as_xy(as_geos_geometry("POINT EMPTY")), wk::xy(NA_real_, NA_real_))
  expect_equal(
    wk::as_xy(as_geos_geometry("POINT EMPTY"), dims = c("x", "y", "z")),
    wk::xyz(NA_real_, NA_real_, NA_real_)
  )
})

test_that("crs can be fetched and set", {
  geom <- new_geos_geometry(list(NULL), crs = NULL)
  expect_null(wk_crs(geom))
  geom <- wk_set_crs(geom, 1234)
  expect_identical(wk_crs(geom), 1234)
})

test_that("crs propagates through conversion to wk::wkt(), wk::wkb(), and wk::xy()", {
  geom <- new_geos_geometry(list(NULL), crs = 1234)
  expect_identical(wk_crs(as_wkt(geom)), 1234)
  expect_identical(wk_crs(as_wkb(geom)), 1234)
  expect_identical(wk_crs(as_xy(geom)), 1234)
  expect_identical(wk_crs(as_xy(geom, dims = c("x", "y", "z"))), 1234)
})

test_that("crs propagates through conversion from wk::wkt(), wk::wkb(), wk::xy(), wk::rct(), and wk::crc()", {
  geom <- new_geos_geometry(list(NULL), crs = 1234)
  expect_identical(as_geos_geometry(wk::wkt(NA_character_, crs = 1234)), geom)
  expect_identical(as_geos_geometry(wk::wkb(list(NULL), crs = 1234)), geom)
  expect_identical(as_geos_geometry(wk::xy(crs = 1234)), geom[integer(0)])
  expect_identical(as_geos_geometry(wk::rct(crs = 1234)), geom[integer(0)])
  expect_identical(as_geos_geometry(wk::crc(crs = 1234)), geom[integer(0)])
})