From 92eee09099f99d289cf7be3f92a9f5c6957712a6 Mon Sep 17 00:00:00 2001 From: Dewey Dunnington Date: Sun, 31 Dec 2023 22:10:21 -0400 Subject: [PATCH] fix: Complete test coverage and fix errors (#29) --- .covrignore | 1 + R/array.R | 22 +-- R/kernel.R | 8 +- R/{arrow-compat.R => pkg-arrow.R} | 0 R/{nanoarrow-compat.R => pkg-nanoarrow.R} | 11 +- R/{sf-compat.R => pkg-sf.R} | 0 R/{wk-compat.R => pkg-wk.R} | 0 R/type.R | 6 - src/r-vctr.c | 2 +- src/r-wk-handle-stream.cc | 174 +++++++++++++----- src/r-wk-writer.c | 4 + tests/testthat/test-array.R | 164 ++++++++++++++++- tests/testthat/test-handle.R | 44 +++++ tests/testthat/test-infer-default.R | 2 +- .../{test-arrow-compat.R => test-pkg-arrow.R} | 0 ...anoarrow-compat.R => test-pkg-nanoarrow.R} | 0 .../{test-sf-compat.R => test-pkg-sf.R} | 0 .../{test-wk-compat.R => test-pkg-wk.R} | 30 ++- tests/testthat/test-type.R | 23 +++ tools/valgrind.supp | 20 ++ 20 files changed, 435 insertions(+), 76 deletions(-) rename R/{arrow-compat.R => pkg-arrow.R} (100%) rename R/{nanoarrow-compat.R => pkg-nanoarrow.R} (80%) rename R/{sf-compat.R => pkg-sf.R} (100%) rename R/{wk-compat.R => pkg-wk.R} (100%) rename tests/testthat/{test-arrow-compat.R => test-pkg-arrow.R} (100%) rename tests/testthat/{test-nanoarrow-compat.R => test-pkg-nanoarrow.R} (100%) rename tests/testthat/{test-sf-compat.R => test-pkg-sf.R} (100%) rename tests/testthat/{test-wk-compat.R => test-pkg-wk.R} (82%) create mode 100644 tools/valgrind.supp diff --git a/.covrignore b/.covrignore index dd70341..76d814e 100644 --- a/.covrignore +++ b/.covrignore @@ -3,3 +3,4 @@ src/geoarrow.h src/fast_float.h src/d2s.c src/ryu +src/double_parse_fast_float.cc diff --git a/R/array.R b/R/array.R index a7b75fb..48e09ef 100644 --- a/R/array.R +++ b/R/array.R @@ -93,9 +93,7 @@ as_geoarrow_array_stream.nanoarrow_array_stream <- function(x, ..., schema = NUL geoarrow_array_from_buffers <- function(schema, buffers) { schema <- nanoarrow::as_nanoarrow_schema(schema) extension_name <- schema$metadata[["ARROW:extension:name"]] - if (is.null(extension_name)) { - stop("Expected extension name") - } + stopifnot(!is.null(extension_name)) switch( extension_name, @@ -222,14 +220,8 @@ nested_array_from_buffers <- function(schema, buffers, level, validity = NULL) { validity <- as_validity_buffer(validity) array <- nanoarrow::nanoarrow_array_init(schema) - - if (identical(schema$format, "+l")) { - offsets <- as_offset_buffer(buffers[[1]]) - offset_element_size <- 4L - } else { - offsets <- as_large_offset_buffer(buffers[[1]]) - offset_element_size <- 8L - } + offsets <- as_offset_buffer(buffers[[1]]) + offset_element_size <- 4L if (offsets$size_bytes == 0) { return(array) @@ -295,17 +287,17 @@ as_large_offset_buffer <- function(x) { as_validity_buffer <- function(x) { if (is.null(x)) { - return(list(null_count = 0, buffer = NULL)) + return(list(null_count = 0L, buffer = NULL)) } if (inherits(x, "nanoarrow_buffer")) { - return(list(null_count = -1, buffer = x)) + return(list(null_count = -1L, buffer = x)) } if (is.logical(x)) { null_count <- sum(!x) } else { - null_count <- sum(x == 0) + null_count <- sum(x == 0L) } array <- nanoarrow::as_nanoarrow_array(x, schema = nanoarrow::na_bool()) @@ -313,7 +305,7 @@ as_validity_buffer <- function(x) { stop("NA values are not allowed in validity buffer") } - list(null_count == null_count, buffer = x$buffers[[2]]) + list(null_count = null_count, buffer = array$buffers[[2]]) } # This really needs a helper in nanoarrow, but for now, we need a way to drop diff --git a/R/kernel.R b/R/kernel.R index b775490..12a4a21 100644 --- a/R/kernel.R +++ b/R/kernel.R @@ -74,9 +74,7 @@ geoarrow_kernel <- function(kernel_name, input_types, options = NULL) { } geoarrow_kernel_push <- function(kernel, args) { - if (!inherits(kernel, "geoarrow_kernel")) { - stop("kernel must inherit from 'geoarrow_kernel'") - } + stopifnot(inherits(kernel, "geoarrow_kernel")) if (isTRUE(attr(kernel, "is_agg"))) { array_out <- NULL @@ -91,9 +89,7 @@ geoarrow_kernel_push <- function(kernel, args) { args <- lapply(args, nanoarrow::as_nanoarrow_array) expected_arg_count <- length(attr(kernel, "input_types")) - if (length(args) != expected_arg_count) { - stop(sprintf("Expected %d arguments but got %d", expected_arg_count, length(args))) - } + stopifnot(length(args) == expected_arg_count) .Call(geoarrow_c_kernel_push, kernel, args, array_out) array_out diff --git a/R/arrow-compat.R b/R/pkg-arrow.R similarity index 100% rename from R/arrow-compat.R rename to R/pkg-arrow.R diff --git a/R/nanoarrow-compat.R b/R/pkg-nanoarrow.R similarity index 80% rename from R/nanoarrow-compat.R rename to R/pkg-nanoarrow.R index d12fd6c..9b004e5 100644 --- a/R/nanoarrow-compat.R +++ b/R/pkg-nanoarrow.R @@ -1,12 +1,21 @@ +# Runs before coverage starts on load +# nocov start register_geoarrow_extension <- function() { - for (ext_name in geoarrow_extension_name_all()) { + all_ext_name <- c( + "geoarrow.wkt", "geoarrow.wkb", "geoarrow.point", "geoarrow.linestring", + "geoarrow.polygon", "geoarrow.multipoint", "geoarrow.mutlilinestring", + "geoarrow.multipolygon" + ) + + for (ext_name in all_ext_name) { nanoarrow::register_nanoarrow_extension( ext_name, nanoarrow::nanoarrow_extension_spec(subclass = "geoarrow_extension_spec") ) } } +# nocov end #' @importFrom nanoarrow infer_nanoarrow_ptype_extension #' @export diff --git a/R/sf-compat.R b/R/pkg-sf.R similarity index 100% rename from R/sf-compat.R rename to R/pkg-sf.R diff --git a/R/wk-compat.R b/R/pkg-wk.R similarity index 100% rename from R/wk-compat.R rename to R/pkg-wk.R diff --git a/R/type.R b/R/type.R index ee3b6c7..8e3879e 100644 --- a/R/type.R +++ b/R/type.R @@ -67,12 +67,6 @@ na_extension_geoarrow <- function(geometry_type, dimensions = "XY", na_extension_geoarrow_internal(type_id, crs = crs, edges = edges) } -geoarrow_extension_name_all <- function() { - c("geoarrow.wkt", "geoarrow.wkb", "geoarrow.point", "geoarrow.linestring", - "geoarrow.polygon", "geoarrow.multipoint", "geoarrow.mutlilinestring", - "geoarrow.multipolygon") -} - #' Inspect a GeoArrow schema #' #' @param schema A [nanoarrow_schema][nanoarrow::as_nanoarrow_schema] diff --git a/src/r-vctr.c b/src/r-vctr.c index 34486bc..26c38f4 100644 --- a/src/r-vctr.c +++ b/src/r-vctr.c @@ -17,7 +17,7 @@ SEXP geoarrow_c_vctr_chunk_offsets(SEXP array_list) { array = (struct ArrowArray*)R_ExternalPtrAddr(VECTOR_ELT(array_list, i)); cumulative_offset += array->length; if (cumulative_offset > INT_MAX) { - Rf_error("Can't build geoarrow_vctr with length > INT_MAX"); + Rf_error("Can't build geoarrow_vctr with length > INT_MAX"); // # nocov } offsets[i + 1] = cumulative_offset; diff --git a/src/r-wk-handle-stream.cc b/src/r-wk-handle-stream.cc index 40eee41..0ee1b58 100644 --- a/src/r-wk-handle-stream.cc +++ b/src/r-wk-handle-stream.cc @@ -13,16 +13,16 @@ class WKGeoArrowHandler { public: WKGeoArrowHandler(wk_handler_t* handler, R_xlen_t size) - : handler_(handler), feat_id_(-1), ring_id_(-1), coord_id_(-1) { + : handler_(handler), + abort_feature_called_(false), + feat_id_(-1), + ring_id_(-1), + coord_id_(-1) { WK_VECTOR_META_RESET(vector_meta_, WK_GEOMETRY); WK_META_RESET(meta_, WK_GEOMETRY); vector_meta_.size = size; - // This is to keep vectors from being reallocated, since some - // wk handlers assume that the meta pointers will stay valid between - // the start and end geometry methods (this will get fixed in a - // wk release soon) part_id_stack_.reserve(32); meta_stack_.reserve(32); } @@ -40,6 +40,23 @@ class WKGeoArrowHandler { v->private_data = this; } + // GeoArrow visitors don't support early return, so we just ignore subsequent calls to + // handler methods until the feature ends. In any case, we return an errno code since + // that is what the visitor interface expects. + GeoArrowErrorCode wrap_result(int result, GeoArrowError* error) { + if (result == WK_ABORT_FEATURE) { + abort_feature_called_ = true; + return GEOARROW_OK; + } + + if (result != WK_CONTINUE) { + GeoArrowErrorSet(error, "result !+ WK_CONTINUE (%d)", result); + return EINVAL; + } else { + return GEOARROW_OK; + } + } + void set_vector_geometry_type(GeoArrowGeometryType geometry_type) { vector_meta_.geometry_type = geometry_type; } @@ -96,17 +113,49 @@ class WKGeoArrowHandler { } } + bool handler_geom_start_not_yet_called() { + return !meta_stack_.empty() && meta()->size == 0; + } + + int call_geom_start_non_empty() { + meta()->size = WK_SIZE_UNKNOWN; + int result = handler_->geometry_start(meta(), part_id(), handler_->handler_data); + part_id_stack_.push_back(-1); + return result; + } + + int call_geom_start_empty() { + return handler_->geometry_start(meta(), part_id(), handler_->handler_data); + } + int feat_start() { + abort_feature_called_ = false; feat_id_++; part_id_stack_.clear(); meta_stack_.clear(); return handler_->feature_start(&vector_meta_, feat_id_, handler_->handler_data); } - int null_feat() { return handler_->null_feature(handler_->handler_data); } + int null_feat() { + if (abort_feature_called_) { + return WK_CONTINUE; + } + + return handler_->null_feature(handler_->handler_data); + } + + int geom_start(GeoArrowGeometryType geometry_type, GeoArrowDimensions dimensions) { + if (abort_feature_called_) { + return WK_CONTINUE; + } + + if (handler_geom_start_not_yet_called()) { + int result = call_geom_start_non_empty(); + if (result != WK_CONTINUE) { + return result; + } + } - int geom_start(GeoArrowGeometryType geometry_type, GeoArrowDimensions dimensions, - uint32_t size) { ring_id_ = -1; coord_id_ = -1; @@ -115,26 +164,63 @@ class WKGeoArrowHandler { } meta_.geometry_type = geometry_type; - meta_.size = size; + meta_.size = 0; set_meta_dimensions(dimensions); meta_stack_.push_back(meta_); - int result = handler_->geometry_start(meta(), part_id(), handler_->handler_data); - part_id_stack_.push_back(-1); - return result; + // wk writers (mostly) require that EMPTY has an explicit size 0, but we don't + // have that information yet. Instead, we defer the call to geometry_start until + // we see the next thing (coord or geom or ring) + return WK_CONTINUE; } - int ring_start(uint32_t size) { + int ring_start() { + if (abort_feature_called_) { + return WK_CONTINUE; + } + + if (handler_geom_start_not_yet_called()) { + int result = call_geom_start_non_empty(); + if (result != WK_CONTINUE) { + return result; + } + } + ring_id_++; coord_id_ = -1; - ring_size_ = size; + ring_size_ = WK_SIZE_UNKNOWN; return handler_->ring_start(meta(), ring_size_, ring_id_, handler_->handler_data); } + static bool coord_all_na(const struct GeoArrowCoordView* coords, int64_t i) { + for (int j = 0; j < coords->n_values; j++) { + if (!ISNAN(GEOARROW_COORD_VIEW_VALUE(coords, i, j))) { + return false; + } + } + + return true; + } + int coords(const struct GeoArrowCoordView* coords) { + if (abort_feature_called_) { + return WK_CONTINUE; + } + int result; double coord[4]; for (int64_t i = 0; i < coords->n_coords; i++) { + if (coord_all_na(coords, i)) { + continue; + } + + if (handler_geom_start_not_yet_called()) { + int result = call_geom_start_non_empty(); + if (result != WK_CONTINUE) { + return result; + } + } + coord_id_++; for (int j = 0; j < coords->n_values; j++) { coord[j] = GEOARROW_COORD_VIEW_VALUE(coords, i, j); @@ -150,10 +236,25 @@ class WKGeoArrowHandler { } int ring_end() { + if (abort_feature_called_) { + return WK_CONTINUE; + } + return handler_->ring_end(meta(), ring_size_, ring_id_, handler_->handler_data); } int geom_end() { + if (abort_feature_called_) { + return WK_CONTINUE; + } + + if (handler_geom_start_not_yet_called()) { + int result = call_geom_start_empty(); + if (result != WK_CONTINUE) { + return result; + } + } + if (part_id_stack_.size() > 0) part_id_stack_.pop_back(); int result = handler_->geometry_end(meta(), part_id(), handler_->handler_data); if (meta_stack_.size() > 0) meta_stack_.pop_back(); @@ -161,6 +262,10 @@ class WKGeoArrowHandler { } int feat_end() { + if (abort_feature_called_) { + return WK_CONTINUE; + } + return handler_->feature_end(&vector_meta_, feat_id_, handler_->handler_data); } @@ -168,6 +273,7 @@ class WKGeoArrowHandler { private: wk_handler_t* handler_; + bool abort_feature_called_; std::vector meta_stack_; std::vector part_id_stack_; @@ -187,76 +293,62 @@ class WKGeoArrowHandler { } } - const wk_meta_t* meta() { + wk_meta_t* meta() { if (meta_stack_.size() == 0) { throw std::runtime_error("geom_start()/geom_end() stack imbalance "); } return meta_stack_.data() + meta_stack_.size() - 1; } - static int wrap_result(int result, GeoArrowError* error) { - if (result == WK_ABORT_FEATURE) { - GeoArrowErrorSet(error, "WK_ABORT_FEATURE not supported"); - return EINVAL; - } - - if (result != WK_CONTINUE) { - GeoArrowErrorSet(error, "result !+ WK_CONTINUE (%d)", result); - return EINVAL; - } else { - return GEOARROW_OK; - } - } - static int feat_start_visitor(struct GeoArrowVisitor* v) { auto private_data = reinterpret_cast(v->private_data); int result = private_data->feat_start(); - return wrap_result(result, v->error); + return private_data->wrap_result(result, v->error); } static int null_feat_visitor(struct GeoArrowVisitor* v) { auto private_data = reinterpret_cast(v->private_data); int result = private_data->null_feat(); - return wrap_result(result, v->error); + return private_data->wrap_result(result, v->error); } static int geom_start_visitor(struct GeoArrowVisitor* v, enum GeoArrowGeometryType geometry_type, enum GeoArrowDimensions dimensions) { auto private_data = reinterpret_cast(v->private_data); - int result = private_data->geom_start(geometry_type, dimensions, WK_SIZE_UNKNOWN); - return wrap_result(result, v->error); + int result = private_data->geom_start(geometry_type, dimensions); + return private_data->wrap_result(result, v->error); } static int ring_start_visitor(struct GeoArrowVisitor* v) { auto private_data = reinterpret_cast(v->private_data); - int result = private_data->ring_start(WK_SIZE_UNKNOWN); - return wrap_result(result, v->error); + int result = private_data->ring_start(); + return private_data->wrap_result(result, v->error); } static int coords_visitor(struct GeoArrowVisitor* v, const struct GeoArrowCoordView* coords) { auto private_data = reinterpret_cast(v->private_data); int result = private_data->coords(coords); - return wrap_result(result, v->error); + return private_data->wrap_result(result, v->error); } static int ring_end_visitor(struct GeoArrowVisitor* v) { auto private_data = reinterpret_cast(v->private_data); int result = private_data->ring_end(); - return wrap_result(result, v->error); + return private_data->wrap_result(result, v->error); } static int geom_end_visitor(struct GeoArrowVisitor* v) { auto private_data = reinterpret_cast(v->private_data); int result = private_data->geom_end(); - return wrap_result(result, v->error); + return private_data->wrap_result(result, v->error); } static int feat_end_visitor(struct GeoArrowVisitor* v) { auto private_data = reinterpret_cast(v->private_data); int result = private_data->feat_end(); - return wrap_result(result, v->error); + return private_data->wrap_result(result, v->error); } }; @@ -311,8 +403,8 @@ SEXP geoarrow_handle_stream(SEXP data, wk_handler_t* handler) { } // Initialize the reader + make sure it is always cleaned up - struct GeoArrowArrayReader* reader = reinterpret_cast( - malloc(sizeof(GeoArrowArrayReader))); + struct GeoArrowArrayReader* reader = + reinterpret_cast(malloc(sizeof(GeoArrowArrayReader))); if (reader == NULL) { Rf_error("Failed to malloc sizeof(GeoArrowArrayReader)"); } diff --git a/src/r-wk-writer.c b/src/r-wk-writer.c index 3773cdc..bb13bc4 100644 --- a/src/r-wk-writer.c +++ b/src/r-wk-writer.c @@ -119,6 +119,10 @@ int builder_error(const char* message, void* handler_data) { void builder_finalize(void* handler_data) { builder_handler_t* data = (builder_handler_t*)handler_data; if (data != NULL) { + if (data->writer.private_data != NULL) { + GeoArrowArrayWriterReset(&data->writer); + } + free(data); } } diff --git a/tests/testthat/test-array.R b/tests/testthat/test-array.R index da58fdc..dd1ad38 100644 --- a/tests/testthat/test-array.R +++ b/tests/testthat/test-array.R @@ -11,11 +11,41 @@ test_that("as_geoarrow_array_stream() default method calls as_geoarrow_array()", expect_identical(schema$metadata[["ARROW:extension:name"]], "geoarrow.wkt") }) +test_that("as_geoarrow_array_stream() method for nanoarrow_array_stream works", { + already_geoarrow_stream <- as_geoarrow_array_stream("POINT (0 1)") + + # No schema specified + expect_identical( + as_geoarrow_array_stream(already_geoarrow_stream), + already_geoarrow_stream + ) + + # Same schema specified + expect_identical( + as_geoarrow_array_stream(already_geoarrow_stream, schema = na_extension_wkt()), + already_geoarrow_stream + ) + + # Different schema specified + stream <- as_geoarrow_array_stream(already_geoarrow_stream, schema = na_extension_wkb()) + schema <- stream$get_schema() + expect_identical( + schema$metadata[["ARROW:extension:name"]], + "geoarrow.wkb" + ) + + expect_identical( + wk::as_wkt(as_geoarrow_vctr(stream)), + wk::wkt("POINT (0 1)") + ) +}) + test_that("as_geoarrow_array() works for non-native geoarrow array", { array_wkt <- as_geoarrow_array(wk::wkt(c("POINT Z (0 1 2)", "POINT M (2 3 4)"))) array <- as_geoarrow_array(array_wkt) - - skip("Test not implemented") + schema <- nanoarrow::infer_nanoarrow_schema(array) + expect_identical(schema$metadata[["ARROW:extension:name"]], "geoarrow.point") + expect_identical(names(schema$children), c("x", "y", "z", "m")) }) test_that("geoarrow_array_from_buffers() works for wkb", { @@ -34,6 +64,20 @@ test_that("geoarrow_array_from_buffers() works for wkb", { expect_identical(wkb, vctr) }) +test_that("geoarrow_array_from_buffers() works for empty wkb", { + array <- geoarrow_array_from_buffers( + na_extension_wkb(), + list( + NULL, + NULL, + raw() + ) + ) + vctr <- nanoarrow::convert_array(force_array_storage(array)) + attributes(vctr) <- NULL + expect_identical(list(), vctr) +}) + test_that("geoarrow_array_from_buffers() works for large wkb", { skip_if_not_installed("arrow") @@ -101,6 +145,34 @@ test_that("geoarrow_array_from_buffers() works for point", { ) }) +test_that("geoarrow_array_from_buffers() works for interleaved point", { + array <- geoarrow_array_from_buffers( + na_extension_geoarrow("POINT", coord_type = "INTERLEAVED"), + list( + NULL, + rbind(1:5, 6:10) + ) + ) + + expect_identical( + as.raw(array$children[[1]]$buffers[[2]]), + as.raw(nanoarrow::as_nanoarrow_buffer(c(1, 6, 2, 7, 3, 8, 4, 9, 5, 10))) + ) +}) + +test_that("geoarrow_array_from_buffers() works for empty point", { + array <- geoarrow_array_from_buffers( + na_extension_geoarrow("POINT"), + list( + NULL, + double(), + double() + ) + ) + + expect_identical(array$length, 0L) +}) + test_that("geoarrow_array_from_buffers() works for linestring", { array <- geoarrow_array_from_buffers( na_extension_geoarrow("LINESTRING"), @@ -128,6 +200,20 @@ test_that("geoarrow_array_from_buffers() works for linestring", { ) }) +test_that("geoarrow_array_from_buffers() works for empty linestring", { + array <- geoarrow_array_from_buffers( + na_extension_geoarrow("LINESTRING"), + list( + NULL, + NULL, + double(), + double() + ) + ) + + expect_identical(array$length, 0L) +}) + test_that("geoarrow_array_from_buffers() works for multilinestring", { array <- geoarrow_array_from_buffers( na_extension_geoarrow("MULTILINESTRING"), @@ -199,3 +285,77 @@ test_that("geoarrow_array_from_buffers() works for multipolygon", { as.raw(nanoarrow::as_nanoarrow_buffer(as.double(6:10))) ) }) + +test_that("binary buffers can be created", { + # raw + buffer <- as_binary_buffer(as.raw(1:5)) + expect_identical(as.raw(buffer), as.raw(1:5)) + + # buffer + expect_identical(as_binary_buffer(buffer), buffer) + + # string + expect_identical( + as.raw(as_binary_buffer(c("abc", "def"))), + charToRaw("abcdef") + ) + + # list + expect_identical( + as.raw(as_binary_buffer(list(as.raw(1:5)))), + as.raw(1:5) + ) + + expect_error( + as_binary_buffer(new.env()), + "Don't know how to create binary data buffer" + ) +}) + +test_that("coord buffers can be created", { + buffer <- as_coord_buffer(c(1, 2, 3)) + expect_identical( + nanoarrow::convert_buffer(buffer), + c(1, 2, 3) + ) + + expect_identical(as_coord_buffer(buffer), buffer) +}) + +test_that("offset buffers can be created", { + buffer <- as_offset_buffer(c(1, 2, 3)) + expect_identical( + nanoarrow::convert_buffer(buffer), + c(1L, 2L, 3L) + ) + + expect_identical(as_offset_buffer(buffer), buffer) +}) + +test_that("validity buffers can be created", { + validity <- as_validity_buffer(NULL) + expect_identical(validity$null_count, 0L) + expect_identical(as.raw(validity$buffer), raw()) + + validity <- as_validity_buffer(c(TRUE, FALSE, TRUE)) + expect_identical(validity$null_count, 1L) + expect_identical( + nanoarrow::convert_buffer(validity$buffer)[1:3], + c(TRUE, FALSE, TRUE) + ) + + validity <- as_validity_buffer(validity$buffer) + expect_identical( + validity$null_count, + -1L + ) + expect_identical( + nanoarrow::convert_buffer(validity$buffer)[1:3], + c(TRUE, FALSE, TRUE) + ) + + expect_error( + as_validity_buffer(c(TRUE, FALSE, NA)), + "NA values are not allowed in validity buffer" + ) +}) diff --git a/tests/testthat/test-handle.R b/tests/testthat/test-handle.R index 5e032d9..121d0a9 100644 --- a/tests/testthat/test-handle.R +++ b/tests/testthat/test-handle.R @@ -89,3 +89,47 @@ test_that("geoarrow_writer() works for XYZM", { c("POINT ZM (0 1 2 3)", "POINT ZM (1 2 3 4)", "POINT ZM (2 3 4 5)") ) }) + +test_that("handle_geoarrow() can roundtrip wk examples as WKT", { + for (ex_name in setdiff(names(wk::wk_example_wkt), "nc")) { + example <- wk::wk_example_wkt[[ex_name]] + chars <- nchar(as.character(example)) + chars[is.na(example)] <- 0L + array <- geoarrow_array_from_buffers( + na_extension_wkt(), + list( + !is.na(example), + c(0L, cumsum(chars)), + as.character(example) + ) + ) + + # Check the array was constructed properly + expect_identical( + nanoarrow::convert_array(force_array_storage(array)), + unclass(example) + ) + + # Check that the handler can recreate it with the wkt writer + expect_identical( + geoarrow_handle(array, wk::wkt_writer()), + example + ) + } +}) + +test_that("geoarrow_writer() can roundtrip wk examples as WKT", { + for (ex_name in setdiff(names(wk::wk_example_wkt), "nc")) { + example <- wk::wk_example_wkt[[ex_name]] + + # GeoArrow uses flat multipoint + if (grepl("multipoint", ex_name)) { + example <- wk::wkt(gsub("\\(([0-9 ]+)\\)", "\\1", as.character(example))) + } + + array <- wk::wk_handle(example, geoarrow_writer(na_extension_wkt())) + storage_convert <- nanoarrow::convert_array(force_array_storage(array)) + expect_identical(wk::wkt(storage_convert), example) + } +}) + diff --git a/tests/testthat/test-infer-default.R b/tests/testthat/test-infer-default.R index cce904d..f796d78 100644 --- a/tests/testthat/test-infer-default.R +++ b/tests/testthat/test-infer-default.R @@ -113,7 +113,7 @@ test_that("infer_geoarrow_schema() works for non-native arrays", { test_that("infer_geoarrow_schema() works for native streams", { array <- as_geoarrow_array(wk::xy(1:5, 6:10)) stream <- nanoarrow::basic_array_stream(list(array)) - schema <- infer_geoarrow_schema(array) + schema <- infer_geoarrow_schema(stream) parsed <- geoarrow_schema_parse(schema) expect_identical(parsed$geometry_type, enum$GeometryType$POINT) expect_identical(parsed$dimensions, enum$Dimensions$XY) diff --git a/tests/testthat/test-arrow-compat.R b/tests/testthat/test-pkg-arrow.R similarity index 100% rename from tests/testthat/test-arrow-compat.R rename to tests/testthat/test-pkg-arrow.R diff --git a/tests/testthat/test-nanoarrow-compat.R b/tests/testthat/test-pkg-nanoarrow.R similarity index 100% rename from tests/testthat/test-nanoarrow-compat.R rename to tests/testthat/test-pkg-nanoarrow.R diff --git a/tests/testthat/test-sf-compat.R b/tests/testthat/test-pkg-sf.R similarity index 100% rename from tests/testthat/test-sf-compat.R rename to tests/testthat/test-pkg-sf.R diff --git a/tests/testthat/test-wk-compat.R b/tests/testthat/test-pkg-wk.R similarity index 82% rename from tests/testthat/test-wk-compat.R rename to tests/testthat/test-pkg-wk.R index 000bb2c..3ff0a4e 100644 --- a/tests/testthat/test-wk-compat.R +++ b/tests/testthat/test-pkg-wk.R @@ -1,5 +1,5 @@ -test_that("as_geoarrow_array() for wkt() generates the correct buffers", { +test_that("as_geoarrow_array.wkt() generates the correct buffers", { array <- as_geoarrow_array(wk::wkt(c("POINT (0 1)", NA))) schema <- infer_nanoarrow_schema(array) @@ -22,6 +22,14 @@ test_that("as_geoarrow_array() for wkt() generates the correct buffers", { ) }) +test_that("as_geoarrow_array.wkt() falls back to default method for non-geoarrow.wkt", { + array <- as_geoarrow_array(wk::wkt(c("POINT (0 1)", NA)), schema = na_extension_wkb()) + schema <- infer_nanoarrow_schema(array) + + expect_identical(schema$format, "z") + expect_identical(schema$metadata[["ARROW:extension:name"]], "geoarrow.wkb") +}) + test_that("as_geoarrow_array() for wkt() respects schema", { skip_if_not_installed("arrow") @@ -33,7 +41,7 @@ test_that("as_geoarrow_array() for wkt() respects schema", { expect_identical(schema$format, "U") }) -test_that("as_geoarrow_array() for wkb() generates the correct buffers", { +test_that("as_geoarrow_array.wkb() generates the correct buffers for geoarrow.wkb", { array <- as_geoarrow_array(wk::as_wkb(c("POINT (0 1)", NA))) schema <- infer_nanoarrow_schema(array) @@ -51,6 +59,14 @@ test_that("as_geoarrow_array() for wkb() generates the correct buffers", { ) }) +test_that("as_geoarrow_array.wkb() falls back to default method for non-geoarrow.wkb", { + array <- as_geoarrow_array(wk::as_wkb(c("POINT (0 1)", NA)), schema = na_extension_wkt()) + schema <- infer_nanoarrow_schema(array) + + expect_identical(schema$format, "u") + expect_identical(schema$metadata[["ARROW:extension:name"]], "geoarrow.wkt") +}) + test_that("as_geoarrow_array() for wkb() respects schema", { skip_if_not_installed("arrow") @@ -62,7 +78,7 @@ test_that("as_geoarrow_array() for wkb() respects schema", { expect_identical(schema$format, "Z") }) -test_that("as_geoarrow_array() for xy() generates the correct buffers", { +test_that("as_geoarrow_array.wk_xy() generates the correct buffers", { array <- as_geoarrow_array(wk::xy(1:5, 6:10)) schema <- infer_nanoarrow_schema(array) @@ -80,6 +96,14 @@ test_that("as_geoarrow_array() for xy() generates the correct buffers", { ) }) +test_that("as_geoarrow_arrayx.xy() falls back to default method for non-geoarrow.point", { + array <- as_geoarrow_array(wk::xy(1:5, 6:10), schema = na_extension_wkt()) + schema <- infer_nanoarrow_schema(array) + + expect_identical(schema$format, "u") + expect_identical(schema$metadata[["ARROW:extension:name"]], "geoarrow.wkt") +}) + test_that("as_geoarrow_array() for wk generates the correct metadata", { array <- as_geoarrow_array(wk::wkt(c("POINT (0 1)", NA))) schema <- infer_nanoarrow_schema(array) diff --git a/tests/testthat/test-type.R b/tests/testthat/test-type.R index ef522e2..1e92c3c 100644 --- a/tests/testthat/test-type.R +++ b/tests/testthat/test-type.R @@ -28,6 +28,13 @@ test_that("nanoarrow_schema can be created for native types", { expect_identical(schema_point$metadata[["ARROW:extension:metadata"]], "{}") }) +test_that("nanoarrow_schema create errors for invalid combinations of parameters", { + expect_error( + na_extension_geoarrow("GEOMETRY"), + "type_id not valid" + ) +}) + test_that("nanoarrow_schema can be created with metadata", { schema <- na_extension_wkb(crs = "{}", edges = "SPHERICAL") expect_identical( @@ -72,6 +79,22 @@ test_that("geoarrow_schema_parse() can parse a schema", { expect_identical(parsed$edge_type, enum$EdgeType$PLANAR) }) +test_that("geoarrow_schema_parse() errors for invalid type input", { + expect_error( + geoarrow_schema_parse(nanoarrow::na_bool()), + "Expected extension type" + ) +}) + +test_that("geoarrow_schema_parse() errors for invalid metadata input", { + schema <- na_extension_wkt() + schema$metadata[["ARROW:extension:metadata"]] <- "this is invalid JSON" + expect_error( + geoarrow_schema_parse(schema), + "Expected valid GeoArrow JSON metadata" + ) +}) + test_that("geoarrow_schema_parse() can parse a storage schema", { parsed <- geoarrow_schema_parse(nanoarrow::na_string(), "geoarrow.wkt") expect_identical(parsed$extension_name, "geoarrow.wkt") diff --git a/tools/valgrind.supp b/tools/valgrind.supp new file mode 100644 index 0000000..230563d --- /dev/null +++ b/tools/valgrind.supp @@ -0,0 +1,20 @@ +{ + :XMLParseBuffer possible leak from the sf package + Memcheck:Leak + ... + fun:XML_ParseBuffer +} + +{ + :udunits possible leak from the sf package + Memcheck:Leak + ... + fun:ut_map_name_to_unit +} + +{ + :udunits possible leak from the sf package + Memcheck:Leak + ... + fun:ut_map_symbol_to_unit +}