From ce5a066adb27377e7b97f93711d243a938035cf9 Mon Sep 17 00:00:00 2001 From: Dylan Beaudette Date: Thu, 7 Nov 2019 06:28:09 -0800 Subject: [PATCH] making tests robust to flaky internet connection --- tests/testthat/test-OSDquery.R | 20 +++++---- tests/testthat/test-SDA_query.R | 57 +++++++++++++++--------- tests/testthat/test-fetchKSSL.R | 7 +-- tests/testthat/test-fetchOSD.R | 1 - tests/testthat/test-fetchSDA_component.R | 17 +++++-- tests/testthat/test-siblings.R | 29 +++++++----- 6 files changed, 83 insertions(+), 48 deletions(-) diff --git a/tests/testthat/test-OSDquery.R b/tests/testthat/test-OSDquery.R index 92508a0c..b6b6305c 100644 --- a/tests/testthat/test-OSDquery.R +++ b/tests/testthat/test-OSDquery.R @@ -1,21 +1,25 @@ context("OSDquery() -- requires internet connection") -## sample data -x <- OSDquery(geog_assoc_soils = 'pardee') +test_that("OSDquery() works", { + + skip_if_offline() + + # a message is printed and NULL returned when no results + + # standard request + expect_match(class(res), 'data.frame') + +}) test_that("OSDquery() returns NULL with bogus query", { + skip_if_offline() + # a message is printed and NULL returned when no results res <- suppressMessages(OSDquery(geog_assoc_soils = 'XXX')) expect_null(res) }) -test_that("OSDquery() returns a data.frame", { - - # standard request - expect_match(class(x), 'data.frame') - -}) diff --git a/tests/testthat/test-SDA_query.R b/tests/testthat/test-SDA_query.R index e46f83a1..45dd138a 100644 --- a/tests/testthat/test-SDA_query.R +++ b/tests/testthat/test-SDA_query.R @@ -1,27 +1,28 @@ context("SDA_query() -- requires internet connection") -## sample data - -# single-table result -x.1 <- suppressMessages(SDA_query(q = "SELECT areasymbol, saverest FROM sacatalog WHERE areasymbol = 'CA630' ; ")) - -# multi-table result -x.2 <- suppressMessages(SDA_query(q = "SELECT areasymbol, saverest FROM sacatalog WHERE areasymbol = 'CA630'; SELECT areasymbol, saverest FROM sacatalog WHERE areasymbol = 'CA664' ;")) - -# table with multiple data types -x.3 <- suppressMessages(SDA_query(q = "SELECT TOP 100 mukey, cokey, compkind, comppct_r, majcompflag, elev_r, slope_r, wei, weg FROM component ;")) - -## TODO: mukeys change through time, figure out a better way to query a known record -# table with multi-line records -x.4 <- suppressMessages(SDA_query(q = "SELECT * from mutext WHERE mukey = '2596937';")) - -# point with known SSURGO data -p <- sp::SpatialPoints(cbind(-121.77100, 37.368402), proj4string = sp::CRS('+proj=longlat +datum=WGS84')) - -## tests - -test_that("SDA_query() returns a data.frame or list", { +test_that("SDA_query() works", { + + skip_if_offline() + + ## sample data + + # single-table result + x.1 <<- suppressMessages(SDA_query(q = "SELECT areasymbol, saverest FROM sacatalog WHERE areasymbol = 'CA630' ; ")) + + # multi-table result + x.2 <<- suppressMessages(SDA_query(q = "SELECT areasymbol, saverest FROM sacatalog WHERE areasymbol = 'CA630'; SELECT areasymbol, saverest FROM sacatalog WHERE areasymbol = 'CA664' ;")) + + # table with multiple data types + x.3 <<- suppressMessages(SDA_query(q = "SELECT TOP 100 mukey, cokey, compkind, comppct_r, majcompflag, elev_r, slope_r, wei, weg FROM component ;")) + + ## TODO: mukeys change through time, figure out a better way to query a known record + # table with multi-line records + x.4 <<- suppressMessages(SDA_query(q = "SELECT * from mutext WHERE mukey = '2596937';")) + + # point with known SSURGO data + p <<- sp::SpatialPoints(cbind(-121.77100, 37.368402), proj4string = sp::CRS('+proj=longlat +datum=WGS84')) + # standard request expect_match(class(x.1), 'data.frame') @@ -31,6 +32,8 @@ test_that("SDA_query() returns a data.frame or list", { test_that("SDA_query() returns expected result", { + skip_if_offline() + # table dimensions expect_equal(nrow(x.1), 1) expect_equal(ncol(x.1), 2) @@ -44,6 +47,8 @@ test_that("SDA_query() returns expected result", { test_that("SDA_query() SQL error / no results -> NULL", { + skip_if_offline() + # bad SQL should result in a local error expect_error(SDA_query("SELECT this from that")) @@ -56,6 +61,8 @@ test_that("SDA_query() SQL error / no results -> NULL", { test_that("SDA_spatialQuery() simple spatial query, tabular results", { + skip_if_offline() + res <- SDA_spatialQuery(p, what = 'mukey') # testing known values @@ -68,6 +75,8 @@ test_that("SDA_spatialQuery() simple spatial query, tabular results", { test_that("SDA_spatialQuery() simple spatial query, spatial results", { + skip_if_offline() + res <- SDA_spatialQuery(p, what = 'geom') # testing known values @@ -78,6 +87,8 @@ test_that("SDA_spatialQuery() simple spatial query, spatial results", { test_that("SDA_query() interprets column names", { + skip_if_offline() + # x.3 is from the component table expect_equal( names(x.3), @@ -90,6 +101,8 @@ test_that("SDA_query() interprets column names", { test_that("SDA_query() interprets data type correctly", { + skip_if_offline() + # x.3 is from the component table expect_equal(class(x.3$mukey), 'integer') expect_equal(class(x.3$cokey), 'integer') @@ -107,6 +120,8 @@ test_that("SDA_query() interprets data type correctly", { test_that("SDA_query() works with multi-line records", { + skip_if_offline() + # https://github.com/ncss-tech/soilDB/issues/28 expect_match(class(x.4), 'data.frame') expect_true(nrow(x.4) == 6) diff --git a/tests/testthat/test-fetchKSSL.R b/tests/testthat/test-fetchKSSL.R index 0339c688..6fd7a8eb 100644 --- a/tests/testthat/test-fetchKSSL.R +++ b/tests/testthat/test-fetchKSSL.R @@ -9,6 +9,10 @@ test_that("fetchKSSL() works", { x.morph <<- fetchKSSL(series='sierra', returnMorphologicData = TRUE) x.morp.simple.colors <<- fetchKSSL(series='sierra', returnMorphologicData = TRUE, simplifyColors = TRUE) + # standard request + expect_match(class(x), 'SoilProfileCollection') + + }) @@ -16,9 +20,6 @@ test_that("fetchKSSL() returns an SPC or list", { skip_if_offline() - # standard request - expect_match(class(x), 'SoilProfileCollection') - # SPC + morphologic data expect_match(class(x.morph), 'list') expect_match(class(x.morph$SPC), 'SoilProfileCollection') diff --git a/tests/testthat/test-fetchOSD.R b/tests/testthat/test-fetchOSD.R index e106efe7..aff704d5 100644 --- a/tests/testthat/test-fetchOSD.R +++ b/tests/testthat/test-fetchOSD.R @@ -12,7 +12,6 @@ test_that("fetchOSD() works", { # standard request expect_match(class(x), 'SoilProfileCollection') - }) diff --git a/tests/testthat/test-fetchSDA_component.R b/tests/testthat/test-fetchSDA_component.R index afdef317..c0a5b32d 100644 --- a/tests/testthat/test-fetchSDA_component.R +++ b/tests/testthat/test-fetchSDA_component.R @@ -2,16 +2,25 @@ context("fetchSDA_component() -- requires internet connection") ## sample data: these should run in < 3 seconds -# single component -x <- suppressMessages(fetchSDA_component(WHERE="nationalmusym = 'kzc4'")) +test_that("fetchSDA_component() works", { + + skip_if_offline() + + # single component + x <<- suppressMessages(fetchSDA_component(WHERE="nationalmusym = 'kzc4'")) + + # basic test + expect_match(class(x), 'SoilProfileCollection') +}) ## tests test_that("fetchSDA_component() returns an SPC", { + skip_if_offline() + # SPC integrity and expected IDs / hz depths - expect_match(class(x), 'SoilProfileCollection') expect_equal(idname(x), 'cokey') expect_equal(horizonDepths(x), c('hzdept_r', 'hzdepb_r')) @@ -19,6 +28,8 @@ test_that("fetchSDA_component() returns an SPC", { test_that("fetchSDA_component() returns expected results", { + skip_if_offline() + # there should be 2 components nad 10 horizons expect_equal(length(x), 2) expect_equal(nrow(x), 10) diff --git a/tests/testthat/test-siblings.R b/tests/testthat/test-siblings.R index c9a18cc0..8579fbcc 100644 --- a/tests/testthat/test-siblings.R +++ b/tests/testthat/test-siblings.R @@ -1,20 +1,11 @@ context("siblings() -- requires internet connection") -## sample data -x <- siblings('amador', component.data = TRUE) -test_that("siblings() returns skeleton with bogus query", { - - # a skeleton list should be returned - res <- siblings('XXX') - expect_equal(class(res), 'list') +test_that("siblings() returns reasonable data", { - # TODO: elements should be NULL vs. FALSE + skip_if_offline() -}) - - -test_that("siblings() returns reasonable data", { + x <- siblings('amador', component.data = TRUE) # standard request expect_equal(class(x), 'list') @@ -26,4 +17,18 @@ test_that("siblings() returns reasonable data", { expect_equal(names(x$sib), c('series', 'sibling', 'majcompflag', 'n')) }) + + +test_that("siblings() returns skeleton with bogus query", { + + skip_if_offline() + + # a skeleton list should be returned + res <- siblings('XXX') + expect_equal(class(res), 'list') + + # TODO: elements should be NULL vs. FALSE + +}) + # TODO: test cousins