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 })