Increase fetchAnnotation test coverage according to codecov
Change-Id: I0c8c0f0e7196082ddb42a37001f62a2958ea13e1
diff --git a/R/KorAPQuery.R b/R/KorAPQuery.R
index 7e4d9cd..92a5348 100644
--- a/R/KorAPQuery.R
+++ b/R/KorAPQuery.R
@@ -336,11 +336,16 @@
if (!is.null(res$meta$cached)) {
log_info(verbose, " [cached]\n")
} else if (!is.null(res$meta$benchmark)) {
- # Round the benchmark time to 2 decimal places for better readability
- # If it's a string ending with 's', extract the number, round it, and re-add 's'
+ # Round the benchmark time to 2 decimal places for better readability.
+ # Be robust to locales using comma as decimal separator (e.g., "0,12s").
if (is.character(res$meta$benchmark) && grepl("s$", res$meta$benchmark)) {
- time_value <- as.numeric(sub("s$", "", res$meta$benchmark))
- formatted_time <- paste0(round(time_value, 2), "s")
+ bench_str <- sub("s$", "", res$meta$benchmark)
+ bench_num <- suppressWarnings(as.numeric(gsub(",", ".", bench_str)))
+ if (!is.na(bench_num)) {
+ formatted_time <- paste0(round(bench_num, 2), "s")
+ } else {
+ formatted_time <- res$meta$benchmark
+ }
log_info(verbose, ", took ", formatted_time, "\n", sep = "")
} else {
# Fallback if the format is different than expected
diff --git a/man/fetchAnnotations-KorAPQuery-method.Rd b/man/fetchAnnotations-KorAPQuery-method.Rd
index bf75599..36f28f0 100644
--- a/man/fetchAnnotations-KorAPQuery-method.Rd
+++ b/man/fetchAnnotations-KorAPQuery-method.Rd
@@ -5,12 +5,7 @@
\alias{fetchAnnotations}
\title{Fetch annotations for all collected matches}
\usage{
-\S4method{fetchAnnotations}{KorAPQuery}(
- kqo,
- foundry = "tt",
- overwrite = FALSE,
- verbose = kqo@korapConnection@verbose
-)
+\S4method{fetchAnnotations}{KorAPQuery}(kqo, foundry = "tt", overwrite = FALSE, verbose = kqo@korapConnection@verbose)
}
\arguments{
\item{kqo}{object obtained from \code{\link[=corpusQuery]{corpusQuery()}} with collected matches. Note: the original corpus query should have \code{metadataOnly = FALSE} for annotation parsing to work.}
diff --git a/tests/testthat/test-fetchAnnotations.R b/tests/testthat/test-fetchAnnotations.R
index c034295..117f93a 100644
--- a/tests/testthat/test-fetchAnnotations.R
+++ b/tests/testthat/test-fetchAnnotations.R
@@ -385,3 +385,95 @@
q3 <- fetchAnnotations(q2, foundry = 'tt', overwrite = TRUE, verbose = FALSE)
expect_equal(q3@collectedMatches$pos$match[[1]][1], 'VVFIN')
})
+
+## Additional offline edge-case tests were reverted per request
+
+test_that("annotation_snippet is preserved unless overwrite is TRUE", {
+ # Reuse DummyKCO2 logic (TT vs marmot snippets)
+ if (!isClass("DummyKCO3")) setClass('DummyKCO3', slots = c(apiUrl='character', verbose='logical'))
+ setMethod('apiCall', 'DummyKCO3', function(kco, url, json = TRUE, getHeaders = FALSE, cache = FALSE, timeout = 10) {
+ tt_xml <- '<span class="context-left"></span><span class="match"><mark><span title="tt/l:Test tt/p:NN">Test</span></mark></span><span class="context-right"></span>'
+ marmot_xml <- '<span class="context-left"></span><span class="match"><mark><span title="tt/l:Test tt/p:NN marmot/m:pos:n">Test</span></mark></span><span class="context-right"></span>'
+ if (grepl('foundry=marmot', url)) list(snippet = marmot_xml) else list(snippet = tt_xml)
+ })
+ kco <- new('DummyKCO3', apiUrl = 'http://dummy/', verbose = FALSE)
+ df <- data.frame(textSigle = 'A/B/C', matchStart = 1, matchEnd = 2, matchID = 'match-A/B/C-p1-2', stringsAsFactors = FALSE)
+ q <- KorAPQuery(korapConnection = kco, collectedMatches = df)
+
+ q1 <- fetchAnnotations(q, foundry = 'tt', verbose = FALSE)
+ sn1 <- q1@collectedMatches$annotation_snippet[[1]]
+ q2 <- fetchAnnotations(q1, foundry = 'marmot', verbose = FALSE)
+ # snippet should be unchanged because overwrite = FALSE
+ expect_identical(q2@collectedMatches$annotation_snippet[[1]], sn1)
+ # overwrite = TRUE should replace it
+ q3 <- fetchAnnotations(q2, foundry = 'marmot', overwrite = TRUE, verbose = FALSE)
+ expect_false(identical(q3@collectedMatches$annotation_snippet[[1]], sn1))
+})
+
+test_that("initializes empty vectors when no snippet is returned", {
+ # Dummy connection returning a list without 'snippet'
+ if (!isClass("DummyKCO_NoSnip")) setClass('DummyKCO_NoSnip', slots = c(apiUrl='character', verbose='logical'))
+ setMethod('apiCall', 'DummyKCO_NoSnip', function(kco, url, json = TRUE, getHeaders = FALSE, cache = FALSE, timeout = 10) {
+ list(status = "ok")
+ })
+
+ kco <- new('DummyKCO_NoSnip', apiUrl = 'http://dummy/', verbose = FALSE)
+ df <- data.frame(textSigle = 'A/B/C', matchStart = 1, matchEnd = 2, matchID = 'match-A/B/C-p1-2', stringsAsFactors = FALSE)
+ q <- KorAPQuery(korapConnection = kco, collectedMatches = df)
+
+ q2 <- fetchAnnotations(q, foundry = 'tt', verbose = FALSE)
+
+ # Expect atokens initialized with empty character vectors
+ expect_true(is.data.frame(q2@collectedMatches$atokens))
+ expect_length(q2@collectedMatches$atokens$left[[1]], 0)
+ expect_length(q2@collectedMatches$atokens$match[[1]], 0)
+ expect_length(q2@collectedMatches$atokens$right[[1]], 0)
+
+ # POS/lemma/morph should also be empty vectors for this row
+ expect_length(q2@collectedMatches$pos$left[[1]], 0)
+ expect_length(q2@collectedMatches$lemma$left[[1]], 0)
+ expect_length(q2@collectedMatches$morph$left[[1]], 0)
+})
+
+test_that("initializes NA vectors when API returns NULL", {
+ # Dummy connection returning NULL (e.g., failed request)
+ if (!isClass("DummyKCO_NullRes")) setClass('DummyKCO_NullRes', slots = c(apiUrl='character', verbose='logical'))
+ setMethod('apiCall', 'DummyKCO_NullRes', function(kco, url, json = TRUE, getHeaders = FALSE, cache = FALSE, timeout = 10) {
+ NULL
+ })
+
+ kco <- new('DummyKCO_NullRes', apiUrl = 'http://dummy/', verbose = FALSE)
+ df <- data.frame(textSigle = 'A/B/C', matchStart = 1, matchEnd = 2, matchID = 'match-A/B/C-p1-2', stringsAsFactors = FALSE)
+ q <- KorAPQuery(korapConnection = kco, collectedMatches = df)
+
+ q2 <- fetchAnnotations(q, foundry = 'tt', verbose = FALSE)
+
+ # Expect atokens initialized with NA vectors
+ expect_true(is.data.frame(q2@collectedMatches$atokens))
+ expect_true(length(q2@collectedMatches$atokens$left[[1]]) == 1 && all(is.na(q2@collectedMatches$atokens$left[[1]])))
+ expect_true(length(q2@collectedMatches$atokens$match[[1]]) == 1 && all(is.na(q2@collectedMatches$atokens$match[[1]])))
+ expect_true(length(q2@collectedMatches$atokens$right[[1]]) == 1 && all(is.na(q2@collectedMatches$atokens$right[[1]])))
+
+ # annotation_snippet should also be NA
+ expect_true(is.na(q2@collectedMatches$annotation_snippet[[1]]))
+})
+
+test_that("initializes NA vectors when apiCall errors", {
+ # Dummy connection throwing an error
+ if (!isClass("DummyKCO_Error")) setClass('DummyKCO_Error', slots = c(apiUrl='character', verbose='logical'))
+ setMethod('apiCall', 'DummyKCO_Error', function(kco, url, json = TRUE, getHeaders = FALSE, cache = FALSE, timeout = 10) {
+ stop("boom")
+ })
+
+ kco <- new('DummyKCO_Error', apiUrl = 'http://dummy/', verbose = FALSE)
+ df <- data.frame(textSigle = 'A/B/C', matchStart = 1, matchEnd = 2, matchID = 'match-A/B/C-p1-2', stringsAsFactors = FALSE)
+ q <- KorAPQuery(korapConnection = kco, collectedMatches = df)
+
+ q2 <- fetchAnnotations(q, foundry = 'tt', verbose = FALSE)
+
+ # Expect NA vectors or empty vectors in atokens (implementation may choose either)
+ is_na_or_empty <- function(x) length(x) == 0 || (length(x) == 1 && all(is.na(x)))
+ expect_true(is_na_or_empty(q2@collectedMatches$atokens$left[[1]]))
+ expect_true(is_na_or_empty(q2@collectedMatches$atokens$match[[1]]))
+ expect_true(is_na_or_empty(q2@collectedMatches$atokens$right[[1]]))
+})