library(testthat) suppressWarnings(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 <- suppressWarnings(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 ) }) # Test interactive mode result <- argentum_select_organization(interactive_select = TRUE) 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 non-interactive mode result_non_interactive <- argentum_select_organization(interactive_select = FALSE) expect_s3_class(result_non_interactive, "data.frame") expect_equal(nrow(result_non_interactive), 1) expect_equal(names(result_non_interactive), c("Name", "WMS_URL", "WFS_URL")) expect_equal(result_non_interactive$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") }) # 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") }) # Test argentum_get_capabilities test_that("argentum_get_capabilities handles failed request", { mock_error_response <- structure( list(status_code = 500), class = c("response", "list") ) mock_GET <- mockery::mock(mock_error_response, cycle = TRUE) mock_stop_for_status <- mockery::mock(stop("HTTP error 500"), cycle = TRUE) stub(argentum_get_capabilities, "Sys.sleep", function(x) NULL) local_mocked_bindings( GET = mock_GET, stop_for_status = mock_stop_for_status, .package = "httr" ) expect_error( argentum_get_capabilities("http://example.com/wms"), "Failed to retrieve capabilities after 3 attempts: HTTP error 500" ) # Check that GET was called at least 3 times expect_gte(length(mockery::mock_args(mock_GET)), 3) # Check that stop_for_status was called at least 3 times expect_gte(length(mockery::mock_args(mock_stop_for_status)), 3) })