From 11a0dd17244d993683b427c886b365dc74fe2764 Mon Sep 17 00:00:00 2001 From: Andy Teucher Date: Fri, 5 Jul 2024 11:16:36 -0700 Subject: [PATCH 1/9] Add bang-bang for local unregistered functions --- tests/testthat/test-geom-operators.R | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/tests/testthat/test-geom-operators.R b/tests/testthat/test-geom-operators.R index b7c34b49..85ffceb2 100644 --- a/tests/testthat/test-geom-operators.R +++ b/tests/testthat/test-geom-operators.R @@ -16,7 +16,7 @@ if (has_internet() && identical(Sys.getenv("NOT_CRAN"), "true")) { collect() } -test_that("bcdc_check_geom_size outputs message with low threshold",{ +test_that("bcdc_check_geom_size outputs message with low threshold", { skip_on_cran() skip_if_net_down() @@ -25,7 +25,7 @@ test_that("bcdc_check_geom_size outputs message with low threshold",{ expect_false(bcdc_check_geom_size(local)) }) -test_that("bcdc_check_geom_size is silent with high threshold",{ +test_that("bcdc_check_geom_size is silent with high threshold", { skip_on_cran() skip_if_net_down() @@ -34,7 +34,7 @@ test_that("bcdc_check_geom_size is silent with high threshold",{ }) -test_that("WITHIN works",{ +test_that("WITHIN works", { skip_on_cran() skip_if_net_down() @@ -49,7 +49,7 @@ test_that("WITHIN works",{ }) -test_that("INTERSECTS works",{ +test_that("INTERSECTS works", { skip_on_cran() skip_if_net_down() @@ -61,7 +61,6 @@ test_that("INTERSECTS works",{ expect_s3_class(remote, "sf") expect_equal(attr(remote, "sf_column"), "geometry") - }) test_that("RELATE works", { @@ -115,7 +114,7 @@ test_that("BBOX works with an sf bbox", { remote <- suppressWarnings( bcdc_query_geodata("bc-parks-ecological-reserves-and-protected-areas") %>% - filter(FEATURE_LENGTH_M <= 1000, BBOX(sf::st_bbox(local))) %>% + filter(FEATURE_LENGTH_M <= 1000, BBOX(!!sf::st_bbox(local))) %>% collect() ) @@ -144,7 +143,7 @@ test_that("Other predicates work with an sf bbox", { remote <- suppressWarnings( bcdc_query_geodata("bc-parks-ecological-reserves-and-protected-areas") %>% - filter(FEATURE_LENGTH_M <= 1000, INTERSECTS(sf::st_bbox(local))) %>% + filter(FEATURE_LENGTH_M <= 1000, INTERSECTS(!!sf::st_bbox(local))) %>% collect() ) From d64213162d1f55d343305db4e397037c13a02622 Mon Sep 17 00:00:00 2001 From: Andy Teucher Date: Fri, 5 Jul 2024 11:29:06 -0700 Subject: [PATCH 2/9] wont always be silent --- tests/testthat/test-query-geodata-filter.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-query-geodata-filter.R b/tests/testthat/test-query-geodata-filter.R index c9b1a8d0..8cb70f86 100644 --- a/tests/testthat/test-query-geodata-filter.R +++ b/tests/testthat/test-query-geodata-filter.R @@ -231,9 +231,9 @@ test_that("a BCGW name works with filter", { xmax = 1696644.998, ymax = 1589145.873), crs = 3005)) - expect_silent(ret <- bcdc_query_geodata("WHSE_IMAGERY_AND_BASE_MAPS.GSR_AIRPORTS_SVW") %>% + ret <- bcdc_query_geodata("WHSE_IMAGERY_AND_BASE_MAPS.GSR_AIRPORTS_SVW") %>% filter(WITHIN(little_box)) %>% - collect()) + collect() expect_equal(nrow(ret), 367) }) From d3836166e33d2871f4a059e66cbe647bc73e44a3 Mon Sep 17 00:00:00 2001 From: Andy Teucher Date: Fri, 5 Jul 2024 11:30:21 -0700 Subject: [PATCH 3/9] Change message to that from dbplyr --- tests/testthat/test-query-geodata-filter.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-query-geodata-filter.R b/tests/testthat/test-query-geodata-filter.R index 8cb70f86..7be77d5c 100644 --- a/tests/testthat/test-query-geodata-filter.R +++ b/tests/testthat/test-query-geodata-filter.R @@ -274,7 +274,7 @@ test_that("Nesting functions inside a CQL geometry predicate works (#146)", { bcdc_query_geodata("local-and-regional-greenspaces") %>% filter(DWITHIN(st_buffer(the_geom, 10000, nQuadSegs = 2), 100, "meters")) ), - "Unable to process query") + "Cannot translate") }) test_that("works with dates", { From adda2c0a79a5d25346242113e00942ddba48a16f Mon Sep 17 00:00:00 2001 From: Andy Teucher Date: Fri, 5 Jul 2024 12:08:21 -0700 Subject: [PATCH 4/9] make tests more robust to failing GetCapabilities --- tests/testthat/helper-bcdata.R | 7 +++++++ tests/testthat/test-describe-feature.R | 3 +++ tests/testthat/test-options.R | 2 +- tests/testthat/test-query-geodata-select.R | 4 ++-- tests/testthat/test-utils.R | 1 + 5 files changed, 14 insertions(+), 3 deletions(-) diff --git a/tests/testthat/helper-bcdata.R b/tests/testthat/helper-bcdata.R index d4619ebf..a2daf956 100644 --- a/tests/testthat/helper-bcdata.R +++ b/tests/testthat/helper-bcdata.R @@ -16,3 +16,10 @@ skip_if_net_down <- function() { } testthat::skip("no internet") } + +skip_if_no_capabilities <- function() { + if (!is.null(bcdc_get_capabilities())) { + return() + } + testthat::skip("GetCapabilities request is broken") +} \ No newline at end of file diff --git a/tests/testthat/test-describe-feature.R b/tests/testthat/test-describe-feature.R index 03bc2442..fc22d28b 100644 --- a/tests/testthat/test-describe-feature.R +++ b/tests/testthat/test-describe-feature.R @@ -43,6 +43,7 @@ test_that("bcdc_describe_feature accepts a bcdc_record object", { test_that("bcdc_describe_feature accepts BCGW name",{ skip_on_cran() skip_if_net_down() + skip_if_no_capabilities() airport_feature <- bcdc_describe_feature("WHSE_IMAGERY_AND_BASE_MAPS.GSR_AIRPORTS_SVW") expect_identical(names(airport_feature), c("col_name", "sticky", "remote_col_type","local_col_type", "column_comments")) }) @@ -57,6 +58,7 @@ test_that("bcdc_describe_feature fails on unsupported classes", { test_that("bcdc_describe_feature fails with non-wfs record", { skip_if_net_down() skip_on_cran() + skip_if_no_capabilities() expect_error(bcdc_describe_feature("dba6c78a-1bc1-4d4f-b75c-96b5b0e7fd30"), "No WFS resource available for this data set") }) @@ -64,6 +66,7 @@ test_that("bcdc_describe_feature fails with non-wfs record", { test_that("bcdc_get_wfs_records works", { skip_if_net_down() skip_on_cran() + skip_if_no_capabilities() wfs_records <- bcdc_get_wfs_records() diff --git a/tests/testthat/test-options.R b/tests/testthat/test-options.R index 1894bc09..09ad1101 100644 --- a/tests/testthat/test-options.R +++ b/tests/testthat/test-options.R @@ -25,7 +25,7 @@ test_that("bcdata.chunk_limit",{ expect_error(check_chunk_limit()) }) withr::with_options(list(bcdata.chunk_limit = 10), { - expect_silent(check_chunk_limit()) + expect_true(is.numeric(check_chunk_limit())) expect_equal(check_chunk_limit(), 10) }) }) diff --git a/tests/testthat/test-query-geodata-select.R b/tests/testthat/test-query-geodata-select.R index d0ab9349..5b3b395d 100644 --- a/tests/testthat/test-query-geodata-select.R +++ b/tests/testthat/test-query-geodata-select.R @@ -51,9 +51,9 @@ test_that("select reduces the number of columns when a sticky ",{ test_that("select works with BCGW name", { skip_on_cran() skip_if_net_down() - expect_silent(ret <- bcdc_query_geodata(bcgw_point_record) %>% + expect_s3_class(bcdc_query_geodata(bcgw_point_record) %>% select(AIRPORT_NAME, DESCRIPTION) %>% - collect()) + collect(), "sf") }) diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index 34191374..244df875 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -58,6 +58,7 @@ test_that("is_whse_object_name works", { test_that("bcdc_get_capabilities works", { skip_on_cran() skip_if_net_down() + skip_if_no_capabilities() old_get_caps <- ._bcdataenv_$get_capabilities_xml From 5c22cf9662b6013857192f1e4ff8e14a403cefbd Mon Sep 17 00:00:00 2001 From: Andy Teucher Date: Fri, 5 Jul 2024 12:10:37 -0700 Subject: [PATCH 5/9] Update NEWS --- NEWS.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/NEWS.md b/NEWS.md index 61616d12..2c07e0ff 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,9 @@ # bcdata (development version) +* Make functions more robust to non-functioning WMS/WFS GetCapabilities requests (#339, #341) +* dbplyr 2.5.0 has made the requirement for using `!!` or + `local()` for local functions more restrictive; updated tests + and examples (#341). * Deprecate the `bcdata.single_download_limit` option, as it was mostly redundant with `bcdata.chunk_limit`, and should always be set by the server. Please set the page size limit for paginated requests via the `bcdata.chunk_limit` option (#332) # bcdata 0.4.1 From 88008c35df16bc40bcf8f6c4219703aed90c168a Mon Sep 17 00:00:00 2001 From: Andy Teucher Date: Fri, 5 Jul 2024 12:14:32 -0700 Subject: [PATCH 6/9] trigger ci From 154d021fffaa2ca112a7065f13a99b6a3e2eb790 Mon Sep 17 00:00:00 2001 From: Andy Teucher Date: Sun, 7 Jul 2024 13:11:59 -0700 Subject: [PATCH 7/9] Better messages when GetCapabilities not accessible --- R/bcdc_options.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/bcdc_options.R b/R/bcdc_options.R index 0af5ca4a..22b5a7f6 100644 --- a/R/bcdc_options.R +++ b/R/bcdc_options.R @@ -140,7 +140,7 @@ bcdc_get_capabilities <- function() { bcdc_get_wfs_records <- function() { doc <- bcdc_get_capabilities() - if (is.null(doc)) stop("Unable to access wfs record listing", call. = FALSE) + if (is.null(doc)) stop("Unable to access wfs listing from server", call. = FALSE) # d1 is the default xml namespace (see xml2::xml_ns(doc)) features <- xml2::xml_find_all(doc, "./d1:FeatureTypeList/d1:FeatureType") @@ -156,7 +156,7 @@ bcdc_single_download_limit <- function() { doc <- bcdc_get_capabilities() if (is.null(doc)) { - message("Unable to access wfs record listing, using default download limit of 10000") + message("Unable to access server to determine single download limit; using default download limit of 10000") return(10000L) } From e90b821bbd9e0c69ce18087e899aaec01a79a751 Mon Sep 17 00:00:00 2001 From: Andy Teucher Date: Sun, 7 Jul 2024 14:30:19 -0700 Subject: [PATCH 8/9] change fragile snapshot test to class test --- tests/testthat/_snaps/options.md | 36 -------------------------------- tests/testthat/test-options.R | 5 +++-- 2 files changed, 3 insertions(+), 38 deletions(-) delete mode 100644 tests/testthat/_snaps/options.md diff --git a/tests/testthat/_snaps/options.md b/tests/testthat/_snaps/options.md deleted file mode 100644 index 594bc1a1..00000000 --- a/tests/testthat/_snaps/options.md +++ /dev/null @@ -1,36 +0,0 @@ -# bcdata.single_download_limit is deprecated but works - - Code - bcdc_query_geodata(record = "76b1b7a3-2112-4444-857a-afccf7b20da8") - Condition - Warning: - The bcdata.single_download_limit option is deprecated. Please use bcdata.chunk_limit instead. - Output - Querying 'bc-airports' record - * Using collect() on this object will return 455 features and 41 fields - * Accessing this record requires pagination and will make 455 separate - * requests to the WFS. See ?bcdc_options - * At most six rows of the record are printed here - -------------------------------------------------------------------------------- - Simple feature collection with 6 features and 41 fields - Geometry type: POINT - Dimension: XY - Bounding box: xmin: 833323.9 ymin: 381604.1 xmax: 1198292 ymax: 1054950 - Projected CRS: NAD83 / BC Albers - # A tibble: 6 x 42 - id CUSTODIAN_ORG_DESCRI~1 BUSINESS_CATEGORY_CL~2 BUSINESS_CATEGORY_DE~3 - - 1 WHSE_IMA~ "Ministry of Forest, ~ airTransportation Air Transportation - 2 WHSE_IMA~ "Ministry of Forest, ~ airTransportation Air Transportation - 3 WHSE_IMA~ "Ministry of Forest, ~ airTransportation Air Transportation - 4 WHSE_IMA~ "Ministry of Forest, ~ airTransportation Air Transportation - 5 WHSE_IMA~ "Ministry of Forest, ~ airTransportation Air Transportation - 6 WHSE_IMA~ "Ministry of Forest, ~ airTransportation Air Transportation - # i abbreviated names: 1: CUSTODIAN_ORG_DESCRIPTION, - # 2: BUSINESS_CATEGORY_CLASS, 3: BUSINESS_CATEGORY_DESCRIPTION - # i 38 more variables: OCCUPANT_TYPE_DESCRIPTION , SOURCE_DATA_ID , - # SUPPLIED_SOURCE_ID_IND , AIRPORT_NAME , DESCRIPTION , - # PHYSICAL_ADDRESS , ALIAS_ADDRESS , STREET_ADDRESS , - # POSTAL_CODE , LOCALITY , CONTACT_PHONE , - # CONTACT_EMAIL , CONTACT_FAX , WEBSITE_URL , ... - diff --git a/tests/testthat/test-options.R b/tests/testthat/test-options.R index 09ad1101..a4982bfd 100644 --- a/tests/testthat/test-options.R +++ b/tests/testthat/test-options.R @@ -36,8 +36,9 @@ test_that("bcdata.single_download_limit is deprecated but works", { skip_on_cran() withr::local_options(list(bcdata.single_download_limit = 1)) withr::local_envvar(list(BCDC_KEY = NULL)) # so snapshot not affected by message - expect_snapshot( - bcdc_query_geodata(record = '76b1b7a3-2112-4444-857a-afccf7b20da8') + expect_s3_class( + bcdc_query_geodata(record = '76b1b7a3-2112-4444-857a-afccf7b20da8'), + "bcdc_promise" ) }) From bc0b5d077f6c88c7e7ec1eac5ffb9a9227acdf7f Mon Sep 17 00:00:00 2001 From: Andy Teucher Date: Mon, 8 Jul 2024 09:02:20 -0700 Subject: [PATCH 9/9] Update R/bcdc_options.R Co-authored-by: Sam Albers --- R/bcdc_options.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/bcdc_options.R b/R/bcdc_options.R index 22b5a7f6..ebaa7b6e 100644 --- a/R/bcdc_options.R +++ b/R/bcdc_options.R @@ -140,7 +140,7 @@ bcdc_get_capabilities <- function() { bcdc_get_wfs_records <- function() { doc <- bcdc_get_capabilities() - if (is.null(doc)) stop("Unable to access wfs listing from server", call. = FALSE) + if (is.null(doc)) stop("Unable to access wfs listing from server. Please open an issue. ", call. = FALSE) # d1 is the default xml namespace (see xml2::xml_ns(doc)) features <- xml2::xml_find_all(doc, "./d1:FeatureTypeList/d1:FeatureType")