# Config
skip_everywhere <- function(){
skip_if_offline()
skip_on_cran()
skip_on_ci()
skip_on_covr()
}
# Perform
test_that("Product list exists", {
system.file("mrp_list.csv", package = "mregions2", mustWork = TRUE) %>%
file.exists() %>%
expect_true()
x <- mrp_list
expect_type(x, "list")
expect_s3_class(x, c("tbl_df", "data.frame"))
expect_gt(nrow(x), 1)
})
test_that("mrp_view() leaflet output works", {
map <- mrp_view("eez")
expect_s3_class(map, "leaflet")
expect_s3_class(map, "htmlwidget")
map <- unclass(map)
map_crs <- map[["x"]][["options"]][["crs"]][["crsClass"]]
expect_equal(map_crs, "L.CRS.EPSG4326")
map_calls <- map[["x"]][["calls"]]
# Step 1: Test EMODnet Bathymetry Tiles
map_call_bath <- map_calls[[1]]
method <- map_call_bath[["method"]]
expect_equal(method, "addTiles")
checkmate_url <- "https://tiles.emodnet-bathymetry.eu/2020/baselayer/inspire_quad/{z}/{x}/{y}.png"
test_url <- map_call_bath[["args"]][[1]]
expect_equal(test_url, checkmate_url)
tms <- map_call_bath[["args"]][[4]]$tms
expect_false(tms)
attribution <- map_call_bath[["args"]][[4]]$attribution
expect_match(attribution, "EMODnet", fixed = TRUE)
# Step 2: Test WMS
map_call_wms <- map_calls[[2]]
method <- map_call_wms[["method"]]
expect_equal(method, "addWMS")
checkmate_url <- "https://geo.vliz.be/geoserver/MarineRegions/wms?"
test_url <- map_call_wms[["args"]][[1]]
expect_equal(test_url, checkmate_url)
format <- map_call_wms[["args"]][[4]]$format
expect_equal(format, "image/png")
transparent <- map_call_wms[["args"]][[4]]$transparent
expect_true(transparent)
info_format <- map_call_wms[["args"]][[4]]$info_format
expect_equal(info_format, "text/html")
attribution <- map_call_wms[["args"]][[4]]$attribution
expect_match(attribution, "Marine Regions", fixed = TRUE)
# Step 3: Test EMODnet Bathymetry labels
map_call_labs <- map_calls[[3]]
method <- map_call_labs[["method"]]
expect_equal(method, "addTiles")
checkmate_url <- "https://tiles.emodnet-bathymetry.eu/osm/labels/inspire_quad/{z}/{x}/{y}.png"
test_url <- map_call_labs[["args"]][[1]]
expect_equal(test_url, checkmate_url)
tms <- map_call_labs[["args"]][[4]]$tms
expect_false(tms)
})
test_that("mrp_view() filters can be passed", {
# OGC filter
filter <- "
mrgid
3293
"
map <- mrp_view("eez", filter = filter)
expect_s3_class(map, "leaflet")
expect_s3_class(map, "htmlwidget")
map_url <- map[["x"]][["calls"]][[2]][["args"]][[1]]
parsed_url <- httr2::url_parse(map_url)
parsed_filter <- parsed_url$query$filter
expect_equal(parsed_filter, filter)
# CQL filter
cql_filter <- "mrgid=3293"
map <- mrp_view("eez", cql_filter = cql_filter)
expect_s3_class(map, "leaflet")
expect_s3_class(map, "htmlwidget")
map_url <- map[["x"]][["calls"]][[2]][["args"]][[1]]
parsed_url <- httr2::url_parse(map_url)
parsed_cql_filter <- parsed_url$query$cql_filter
expect_equal(parsed_cql_filter, cql_filter)
})
test_that("mrp_view() assertions work", {
.f <- function() assert_deps(c("thisisa", "fakepackagename"))
expect_error(.f(), "not installed")
.f <- function() mrp_view(1)
expect_error(.f())
.f <- function() mrp_view("foo")
expect_error(.f())
.f <- function() mrp_view(c("eez", "eez_boundaries"))
expect_error(.f())
.f <- function() mrp_view("eez",
filter = "
mrgid
3293
",
cql_filter = "mrgid=3293")
expect_error(.f())
.f <- function() mrp_view("eez", filter = 1)
expect_error(.f())
.f <- function() mrp_view("eez", cql_filter = 1)
expect_error(.f())
mock_500 <- function(req) {
httr2::response(status_code = 500)
}
.f <- function(){
httr2::with_mocked_responses(
mock_500,
mrp_view("eez")
)}
expect_error(.f(), regexp = "500")
withr::local_envvar("TESTPKG.NOINTERNET" = "blop")
expect_error(mrp_view("eez"), "No internet connection")
})
test_that("mrp_get() assertions work", {
.f <- function() mrp_get(1)
expect_error(.f())
.f <- function() mrp_get("foo")
expect_error(.f())
.f <- function() mrp_get(c("eez", "eez_boundaries"))
expect_error(.f())
.f <- function() mrp_get("eez",
filter = "
mrgid
3293
",
cql_filter = "mrgid=3293")
expect_error(.f())
.f <- function() mrp_get("eez", filter = 1)
expect_error(.f())
.f <- function() mrp_get("eez", cql_filter = 1)
expect_error(.f())
.f <- function() mrp_get("eez", count = "1")
expect_error(.f())
.f <- function() mrp_get("eez", path = "this path does not exist")
expect_error(.f())
withr::local_envvar("TESTPKG.NOINTERNET" = "blop")
expect_error(mrp_get("eez"), "No internet connection")
})
httptest2::with_mock_dir("prod/fail/", {
test_that("mrp_get: Bad filters errors surfaced", {
withr::local_options("mregions2.download_path" = "./prod/fail/geo")
withr::local_envvar("TESTPKG.ISTEST" = "true")
withr::local_envvar("TESTPKG.CACHETIME" = 0)
.f <- function() mrp_get("eez", filter="")
expect_error(.f(), "XML getFeature request SAX parsing error")
.f <- function(){
mrp_get("eez", filter="
notvalidparameter
3293
")
}
expect_error(.f(), "InvalidParameterValue")
.f <- function() mrp_get("eez", cql_filter ="notvalidparameter=3293")
expect_error(.f(), "InvalidParameterValue")
.f <- function() mrp_get("eez", cql_filter="mrgid='cannotcast'")
expect_error(.f(), "NoApplicableCode")
})
test_that("mrp_get: Warnings coming from the server are surfaced", {
withr::local_options("mregions2.download_path" = "./prod/fail/geo")
withr::local_envvar("TESTPKG.ISTEST" = "true")
withr::local_envvar("TESTPKG.CACHETIME" = 0)
.f <- function() mrp_get("eez", cql_filter = "mrgid = -1")
expect_warning(.f(), regexp = "empty", fixed = TRUE)
})
})
httptest2::with_mock_dir("prod/ok/", {
test_that("mrp_colnames() works", {
# Returns a data frame
x <- .mrp_colnames("ecs_boundaries")
expect_s3_class(x, c("data.frame"))
expect_gte(nrow(x), 1)
expect_gt(ncol(x), 1)
# Check all columns are of type character
invisible(apply(x, 2, expect_vector, ptype = character()))
})
test_that("mrp_colnames() fails nicely",{
# Expect errors
.f <- function() .mrp_colnames("this is not a data product")
expect_error(.f())
.f <- function() .mrp_colnames(c("ecs", "eez"))
expect_error(.f())
.f <- function() .mrp_colnames(1)
expect_error(.f())
})
test_that("mrp_col_unique() works", {
# two names for the same function
expect_true(all.equal(mrp_col_unique, mrp_col_distinct))
# Expect memoization
expect_true(memoise::is.memoised(mrp_col_unique))
expect_false(memoise::is.memoised(.mrp_col_unique))
# Returns a vector of type character
x <- .mrp_col_unique("ecs_boundaries", "line_type")
expect_vector(x, ptype = character())
expect_gte(length(x), 1)
# Returns a vector of type numeric
x <- .mrp_col_unique("ecs_boundaries", "line_id")
expect_vector(x, ptype = numeric())
expect_gte(length(x), 1)
# Returns a vector of type date
x <- .mrp_col_unique("ecs_boundaries", "doc_date")
expect_vector(x)
expect_s3_class(x, "Date")
expect_gte(length(x), 1)
})
test_that("mrp_col_unique() fails nicely",{
# Expect errors
.f <- function() .mrp_col_unique("this is not a data product", "mrgid")
expect_error(.f())
.f <- function() .mrp_col_unique(1, "mrgid")
expect_error(.f())
.f <- function() .mrp_col_unique("ecs_boundaries", 1)
expect_error(.f())
.f <- function() .mrp_col_unique("ecs_boundaries", "this is not a column")
expect_error(.f())
.f <- function() .mrp_col_unique("ecs_boundaries", "the_geom")
expect_error(.f())
})
test_that("mrp_get() works", {
withr::local_options("mregions2.download_path" = "./prod/ok/geo")
withr::local_envvar("TESTPKG.ISTEST" = "true")
expect_sf <- function(x){
expect_type(x, "list")
expect_s3_class(x, c("sf"))
expect_s3_class(x, c("data.frame", "tbl_df"))
expect_gte(nrow(x), 1)
}
# Mock HTTP request like if there was no cache
withr::local_envvar("TESTPKG.CACHETIME" = 0)
# Mexican ECS Deposit
.f1 <- function() mrp_get("ecs", cql_filter = "mrgid = 64123")
expect_sf(.f1())
expect_s3_class(sf::st_geometry(.f1()), "sfc_POLYGON")
# Mexican ECS Deposit line
.f2 <- function() mrp_get("ecs_boundaries", cql_filter = "line_id = 4232")
expect_sf(.f2())
expect_s3_class(sf::st_geometry(.f2()), "sfc_LINESTRING")
# Actually reading from cache without HTTP request
withr::local_envvar("TESTPKG.CACHETIME" = Inf)
expect_message(.f1(), "Cache", fixed = TRUE)
expect_sf(.f1())
expect_s3_class(sf::st_geometry(.f1()), "sfc_POLYGON")
expect_message(.f2(), "Cache", fixed = TRUE)
expect_sf(.f2())
expect_s3_class(sf::st_geometry(.f2()), "sfc_LINESTRING")
})
}, simplify = TRUE)