library(testthat)
library(mockery)
# Ensure the Argentum package is installed and loaded
library(Argentum)
# Mock data
mock_org_data <- data.frame(
Category = c("Cat1", "Cat2"),
Organization = c("Org1", "Org2"),
WMS_URL = c("http://wms1.com", "http://wms2.com"),
WFS_URL = c("http://wfs1.com", "http://wfs2.com"),
stringsAsFactors = FALSE
)
mock_layer_data <- data.frame(
Name = c("Layer1", "Layer2"),
Title = c("Layer One", "Layer Two"),
stringsAsFactors = FALSE
)
# Test argentum_list_organizations
test_that("argentum_list_organizations returns correct data frame", {
mock_read_delim <- function(file, delim, col_types) {
if (grepl("nH8e7", file) || grepl("JJpjQ", file)) {
mock_org_data
} else {
stop("Simulated error for other URLs")
}
}
stub(argentum_list_organizations, "readr::read_delim", mock_read_delim)
result <- argentum_list_organizations()
expect_s3_class(result, "data.frame")
expect_equal(ncol(result), 3)
expect_equal(names(result), c("Name", "WMS_URL", "WFS_URL"))
expect_equal(nrow(result), 4) # Updated to expect 4 rows
expect_true(all(result$WFS_URL != "" & !is.na(result$WFS_URL)))
expect_equal(result$Name, rep(c("Cat1 - Org1", "Cat2 - Org2"), 2)) # Updated to expect repeated names
})
# Test argentum_select_organization
test_that("argentum_select_organization returns correct organization", {
mock_menu <- mock(1)
stub(argentum_select_organization, "menu", mock_menu)
stub(argentum_select_organization, "argentum_list_organizations", function() {
data.frame(
Name = c("Cat1 - Org1", "Cat2 - Org2"),
WMS_URL = c("http://wms1.com", "http://wms2.com"),
WFS_URL = c("http://wfs1.com", "http://wfs2.com"),
stringsAsFactors = FALSE
)
})
result <- argentum_select_organization()
expect_s3_class(result, "data.frame")
expect_equal(nrow(result), 1)
expect_equal(names(result), c("Name", "WMS_URL", "WFS_URL"))
expect_equal(result$Name, "Cat1 - Org1")
})
# Test argentum_list_layers
test_that("argentum_list_layers handles errors correctly", {
expect_error(argentum_list_layers(), "Please provide a valid organization name.")
stub(argentum_list_layers, "argentum_list_organizations", function() {
data.frame(
Name = c("Cat1 - Org1", "Cat2 - Org2"),
WMS_URL = c("http://wms1.com", "http://wms2.com"),
WFS_URL = c("http://wfs1.com", "http://wfs2.com"),
stringsAsFactors = FALSE
)
})
expect_error(argentum_list_layers("NonExistentOrg"), "Organization not found.")
})
test_that("argentum_list_layers returns correct layer information", {
stub(argentum_list_layers, "argentum_list_organizations", function() {
data.frame(
Name = c("Cat1 - Org1", "Cat2 - Org2"),
WMS_URL = c("http://wms1.com", "http://wms2.com"),
WFS_URL = c("http://wfs1.com", "http://wfs2.com"),
stringsAsFactors = FALSE
)
})
stub(argentum_list_layers, "argentum_get_capabilities", function(url) {
xml2::read_xml('
Layer1
Layer One
Layer2
Layer Two
')
})
result <- argentum_list_layers("Cat1 - Org1")
expect_s3_class(result, "data.frame")
expect_equal(nrow(result), 2)
expect_equal(names(result), c("Name", "Title"))
expect_equal(result$Name, c("Layer1", "Layer2"))
expect_equal(result$Title, c("Layer One", "Layer Two"))
})
# Test argentum_import_wfs_layer
test_that("argentum_import_wfs_layer returns sf object", {
mock_sf_object <- structure(list(geometry = structure(list(structure(c(0, 0), class = c("XY", "POINT", "sfg"))), class = c("sfc_POINT", "sfc"), precision = 0, bbox = structure(c(xmin = 0, ymin = 0, xmax = 0, ymax = 0), class = "bbox"), crs = structure(list(input = "EPSG:4326", wkt = "GEOGCRS[\"WGS 84\"]"), class = "crs"), n_empty = 0L)), class = c("sf", "data.frame"), sf_column = "geometry", agr = structure(integer(0), class = "factor", .Label = c("constant", "aggregate", "identity"), .Names = character(0)))
stub(argentum_import_wfs_layer, "sf::read_sf", function(...) mock_sf_object)
result <- argentum_import_wfs_layer("http://test.com/wfs", "TestLayer")
expect_s3_class(result, "sf")
})
# Test argentum_interactive_import
test_that("argentum_interactive_import returns sf object", {
mock_menu <- mock(1, cycle = TRUE)
mock_readline <- mock("1", cycle = TRUE)
mock_sf_object <- structure(list(geometry = structure(list(structure(c(0, 0), class = c("XY", "POINT", "sfg"))), class = c("sfc_POINT", "sfc"), precision = 0, bbox = structure(c(xmin = 0, ymin = 0, xmax = 0, ymax = 0), class = "bbox"), crs = structure(list(input = "EPSG:4326", wkt = "GEOGCRS[\"WGS 84\"]"), class = "crs"), n_empty = 0L)), class = c("sf", "data.frame"), sf_column = "geometry", agr = structure(integer(0), class = "factor", .Label = c("constant", "aggregate", "identity"), .Names = character(0)))
stub(argentum_interactive_import, "menu", mock_menu)
stub(argentum_interactive_import, "readline", mock_readline)
stub(argentum_interactive_import, "argentum_list_organizations", function() {
data.frame(
Name = c("Cat1 - Org1", "Cat2 - Org2"),
WMS_URL = c("http://wms1.com", "http://wms2.com"),
WFS_URL = c("http://wfs1.com", "http://wfs2.com"),
stringsAsFactors = FALSE
)
})
stub(argentum_interactive_import, "argentum_list_layers", function(...) mock_layer_data)
stub(argentum_interactive_import, "argentum_import_wfs_layer", function(...) mock_sf_object)
result <- argentum_interactive_import()
expect_s3_class(result, "sf")
})
library(testthat)
library(mockery)
# Existing tests remain here...
# Tests for clean_url
test_that("clean_url removes whitespace and parentheses", {
expect_equal(clean_url(" http://example.com "), "http://example.com")
expect_equal(clean_url("http://example.com (some text)"), "http://example.com")
expect_equal(clean_url(" http://example.com (some text) "), "http://example.com")
})
# Updated tests for argentum_get_capabilities
test_that("argentum_get_capabilities handles successful request", {
mock_response <- structure(
list(
status_code = 200,
content = charToRaw('')
),
class = c("response", "list")
)
mock_GET <- mockery::mock(mock_response)
mock_stop_for_status <- mockery::mock()
local_mocked_bindings(
GET = mock_GET,
stop_for_status = mock_stop_for_status,
.package = "httr"
)
result <- argentum_get_capabilities("http://example.com/wms")
expect_s3_class(result, "xml_document")
expect_equal(xml2::xml_name(result), "WMS_Capabilities")
expect_called(mock_GET, 1)
expect_called(mock_stop_for_status, 1)
})
test_that("argentum_get_capabilities handles failed request", {
mock_GET <- mockery::mock(stop("HTTP error"), cycle = TRUE)
local_mocked_bindings(
GET = mock_GET,
.package = "httr"
)
expect_error(argentum_get_capabilities("http://example.com/wms"), "Failed to retrieve capabilities after 3 attempts: HTTP error")
expect_called(mock_GET, 3)
})
test_that("argentum_get_capabilities retries on failure", {
mock_error_response <- structure(
list(status_code = 500),
class = c("response", "list")
)
mock_success_response <- structure(
list(
status_code = 200,
content = charToRaw('')
),
class = c("response", "list")
)
# Mock GET to fail twice and succeed on the third try
mock_GET <- mockery::mock(mock_error_response, mock_error_response, mock_success_response)
# Mock stop_for_status to throw an error for error responses
mock_stop_for_status <- mockery::mock(
stop("HTTP error 500"),
stop("HTTP error 500"),
NULL
)
# Mock content to return the XML string for the success response
mock_content <- mockery::mock('')
# Mock Sys.sleep to do nothing (to speed up the test)
mock_sys_sleep <- mockery::mock()
local_mocked_bindings(
GET = mock_GET,
stop_for_status = mock_stop_for_status,
content = mock_content,
.package = "httr"
)
local_mocked_bindings(
Sys.sleep = mock_sys_sleep,
.package = "base"
)
result <- argentum_get_capabilities("http://example.com/wms")
expect_s3_class(result, "xml_document")
expect_equal(xml2::xml_name(result), "WMS_Capabilities")
expect_called(mock_GET, 3)
expect_called(mock_stop_for_status, 3)
expect_called(mock_content, 1)
expect_called(mock_sys_sleep, 2) # Should be called twice for the two retries
})