Add more corner case unit tests

- closes #112

R/adat2eSet.R

@@ -32,10 +32,12 @@
 adat2eSet <- function(adat) {
 
   if ( !requireNamespace("Biobase", quietly = TRUE) ) {
+    # nocov start
     stop(
       "The `Biobase` package is required to use this function.\n",
       "See ?adat2eSet for installation instructions.", call. = FALSE
     )
+    # nocov end
   }
 
   stopifnot("`adat` must have intact attributes." = is_intact_attr(adat))

R/groupGenerics.R

@@ -197,11 +197,11 @@ Summary.soma_adat <- function(..., na.rm = FALSE) {
 #' @export
 Math.soma.adat <- function(x, ...) {
   .msg <- paste(
-    "The", .value("soma.adat"), "class is now", .value("soma_adat"),
-    "\nPlease either:\n",
+    "The", .value("soma.adat"), "class is now", .value("soma_adat"), ".\n",
+    "Please either:\n",
     "  1) Re-class with x <- addClass(x, 'soma_adat')\n",
     "  2) Re-call 'x <- read_adat(file)' to pick up the new 'soma_adat' class.\n"
   )
   cat(.msg)
-  deprecate_stop("2019-01-31", "SomaDataIO::Math.soma.adat()")
+  deprecate_stop("(2019-01-31)", "SomaDataIO::Math.soma.adat()")
 }

R/pivotExpressionSet.R

@@ -25,10 +25,12 @@
 pivotExpressionSet <- function(eSet) {
 
   if ( !requireNamespace("Biobase", quietly = TRUE) ) {
+    # nocov start
     stop(
       "The `Biobase` package is required to use this function.\n",
       "See ?adat2eSet for installation instructions.", call. = FALSE
     )
+    # nocov end
   }
 
   # samples (rows) x features (cols); move rn -> 1st column

R/read-annotations.R

@@ -48,7 +48,7 @@ read_annotations <- function(file) {
   # file modified
   if ( !identical(md5_file, md5_true) ) {
     warning(
-      "Checksum mismatch.", .value(basename(file)), " may have been modified.",
+      "Checksum mismatch. ", .value(basename(file)), " may have been modified.",
       call. = FALSE
     )
   }

R/utils-read-adat.R

@@ -217,7 +217,7 @@ catchDims <- function(x, y) {
     cli_rule(cr_bold("Trailing 2 RFU features"), line_col = "magenta")
   )
   nc <- ncol(rfu)
-  print(rfu[1:6, (nc - 1):nc])
+  print(head(as_tibble(rfu[, (nc - 1L):nc])))
   writeLines(cli_rule(line_col = "green", line = 2))
   invisible(NULL)
 }

R/zzz.R

@@ -4,6 +4,7 @@
 .onLoad <- function(libname, pkgname) {
   # this is to make the active binding switch between
   # UTF-8 and ASCII symbol encodings
+  # nocov start
   `%enc%` <- function(utf, ascii) {
     if ( getOption("cli.unicode", TRUE) && l10n_info()$`UTF-8` ) {
       utf
@@ -17,6 +18,7 @@
   makeActiveBinding("symb_warn", function() "\u26A0" %enc% "!", pkgenv)
   makeActiveBinding("symb_point", function() "\u276F" %enc% ">", pkgenv)
   makeActiveBinding("symb_info", function() "\u2139" %enc% "i", pkgenv)
+  # nocov end
 }
 
 .onAttach <- function(libname, pkgname) {

tests/testthat/_snaps/S3-print.md

@@ -1,4 +1,4 @@
-# `soma_adat` S3 print method returns known output
+# `soma_adat` S3 print method returns expected default output
 
     == SomaScan Data ===============================================================
          SomaScan version     V4 (5k)
@@ -35,7 +35,7 @@
     #   SampleDescription <chr>, ...
     ================================================================================
 
----
+# `soma_adat` S3 print method returns expected head output
 
     == SomaScan Data ===============================================================
          SomaScan version     V4 (5k)
@@ -67,7 +67,7 @@
     #   SampleDescription <chr>, ...
     ================================================================================
 
----
+# `soma_adat` S3 print method returns expected `show_header = TRUE` output
 
     == SomaScan Data ===============================================================
          SomaScan version     V4 (5k)
@@ -105,7 +105,7 @@
     # i 20 more rows
     ================================================================================
 
----
+# `soma_adat` S3 print method returns expected `grouped_df` output
 
     == SomaScan Data ===============================================================
          SomaScan version     V4 (5k)
@@ -143,7 +143,7 @@
     #   AssayNotes <lgl>, ...
     ================================================================================
 
----
+# `soma_adat` S3 print method returns expected broken attributes output
 
     == SomaScan Data ===============================================================
          SomaScan version     unknown (NA)

tests/testthat/_snaps/groupGenerics.md

@@ -19,3 +19,13 @@
     Output
       ================================================================================
 
+# error conditions generate the expected output for deprecated `soma.adat`
+
+    Code
+      readLines(catfile)
+    Output
+      [1] "The 'soma.adat' class is now 'soma_adat' ."                                
+      [2] " Please either:"                                                           
+      [3] "   1) Re-class with x <- addClass(x, 'soma_adat')"                         
+      [4] "   2) Re-call 'x <- read_adat(file)' to pick up the new 'soma_adat' class."
+

tests/testthat/_snaps/utils-read-adat.md

@@ -1,3 +1,10 @@
+# `checkHeader()` prints expected output
+
+    Code
+      checkHeader(header, verbose = TRUE)
+    Message
+      v Header passed checks and traps
+
 # .verbosity()` prints expected output
 
     Code
@@ -32,30 +39,9 @@
       #   CalQcRatio_Example_Adat_Set001_170255 <chr>, QcReference_170255 <chr>,
       #   Cal_Example_Adat_Set002 <chr>, CalQcRatio_Example_Adat_Set002_170255 <chr>
       -- Trailing 2 RFU features -----------------------------------------------------
-      == SomaScan Data ===============================================================
-           SomaScan version     V4 (5k)
-           Signal Space         5k
-           Attributes intact    v
-           Rows                 6
-           Columns              2
-           Clinical Data        0
-           Features             2
-      -- Column Meta -----------------------------------------------------------------
-      i SeqId, SeqIdVersion, SomaId, TargetFullName, Target, UniProt, EntrezGeneID,
-      i EntrezGeneSymbol, Organism, Units, Type, Dilution, PlateScale_Reference,
-      i CalReference, Cal_Example_Adat_Set001, ColCheck,
-      i CalQcRatio_Example_Adat_Set001_170255, QcReference_170255,
-      i Cal_Example_Adat_Set002, CalQcRatio_Example_Adat_Set002_170255, Dilution2
-      -- Tibble ----------------------------------------------------------------------
-      # A tibble: 6 x 3
-        row_names      seq.9997.12 seq.9999.1
-        <chr>                <dbl>      <dbl>
-      1 258495800010_8      11983.      1741.
-      2 NA                     NA         NA 
-      3 NA.1                   NA         NA 
-      4 NA.2                   NA         NA 
-      5 NA.3                   NA         NA 
-      6 NA.4                   NA         NA 
-      ================================================================================
+      # A tibble: 1 x 2
+        seq.9997.12 seq.9999.1
+              <dbl>      <dbl>
+      1      11983.      1741.
       ================================================================================
 

tests/testthat/helper.R

@@ -76,3 +76,12 @@ with_interactive <- function(lgl, code) {
   })
   force(code)   # execute code in new state
 }
+
+# temporarily modify internal pkg object
+# for testing edge cases
+with_pkg_object <- function(new, code, obj = "ver_dict") {
+  old <- getFromNamespace(obj, ns = "SomaDataIO") # save the old obj
+  assignInNamespace(obj, new, ns = "SomaDataIO")
+  on.exit(assignInNamespace(obj, old, ns = "SomaDataIO"))
+  force(code)
+}

tests/testthat/test-S3-print.R

@@ -4,26 +4,32 @@
 # set to FALSE to enable ASCII fallbacks; see `testthat::local_test_context()`
 # unit tests for print output also don't colors/bold styles {from `pillar`}
 # Turn all these off for the unit testing context
+testthat::local_reproducible_output()
+adat <- example_data
 
 # Testing ----
-test_that("`soma_adat` S3 print method returns known output", {
-  testthat::local_reproducible_output()
-
-  adat <- example_data
-
+test_that("`soma_adat` S3 print method returns expected default output", {
   # default
   expect_snapshot_output(adat)
+})
 
+test_that("`soma_adat` S3 print method returns expected head output", {
   # head
   expect_snapshot_output(head(adat))
+})
 
+test_that("`soma_adat` S3 print method returns expected `show_header = TRUE` output", {
   # show_header is TRUE
   expect_snapshot_output(print(adat, show_header = TRUE))
+})
 
+test_that("`soma_adat` S3 print method returns expected `grouped_df` output", {
   # grouped_df
   grouped_adat <- dplyr::group_by(adat, SampleType)
   expect_snapshot_output(grouped_adat)
+})
 
+test_that("`soma_adat` S3 print method returns expected broken attributes output", {
   # break atts
   attr(adat, "Header.Meta") <- NULL
   expect_false(is_intact_attr(adat, verbose = FALSE))

tests/testthat/test-S3-transform.R

@@ -19,13 +19,21 @@ df <- data.frame(
   sample      = paste0("sample_", 1:3),
   seq.1234.56 = c(1, 2, 3),
   seq.9999.88 = c(4, 5, 6) * 10
-  ) %>%  # `soma_adat` to invoke S3 method dispatch
+  ) |>  # `soma_adat` to invoke S3 method dispatch
   addClass("soma_adat")
 
-test_that("transform() dispatches the soma_adat method and correctly scales", {
+test_that("`transform()` dispatches the `soma_adat` method and correctly scales (cols)", {
   trans <- transform(df, v)
   expect_s3_class(trans, "soma_adat")
   expect_equal(trans$seq.1234.56, df$seq.1234.56 * 2)
   expect_equal(trans$seq.9999.88, df$seq.9999.88 * 0.5)
   expect_named(trans, names(df))
 })
+
+test_that("`transform()` dispatches the `soma_adat` method and correctly scales (rows)", {
+  vec <- c(1, 2, 3)
+  trans <- transform(df, vec, 1L)
+  expect_s3_class(trans, "soma_adat")
+  expect_equal(trans$seq.1234.56, df$seq.1234.56 * vec)
+  expect_equal(trans$seq.9999.88, df$seq.9999.88 * vec)
+})

tests/testthat/test-groupGenerics.R

@@ -178,3 +178,38 @@ test_that("the `Summary()` group generic generates the expected output", {
   expect_equal(max(adat, 4906), 4906)
   expect_equal(max(adat, Inf), Inf)
 })
+
+test_that("error conditions generate the expected output for deprecated `soma.adat`", {
+  # old `soma.adat` class
+  adat2 <- structure(adat, class = c("soma.adat", "data.frame"))
+  catfile <- "msg.txt"
+  file.create(catfile)
+  expect_error(
+    capture.output(log10(adat2), file = catfile),
+    paste("`Math.soma.adat()` was deprecated in SomaDataIO (2019-01-31) and",
+          "is now defunct"),
+    fixed = TRUE
+  )
+  # test the `cat()` message
+  expect_snapshot(readLines(catfile))
+  unlink(catfile, force = TRUE)
+})
+
+test_that("error conditions are triggered for non-numerics in RFU block", {
+  tmp <- mock_adat()
+  tmp$seq.1234.56 <- "foo"
+
+  # Math
+  expect_error(
+    log10(tmp),
+    paste(
+      "Non-numeric variable(s) in `soma_adat` object where RFU values should be:",
+      "'seq.1234.56'"),
+    fixed = TRUE
+  )
+
+  # Summary
+  #expect_error(
+  #  range(tmp)
+  #)
+})

tests/testthat/test-read-annotations.R

@@ -25,3 +25,24 @@ test_that("`read_annotations()` parses the annotations file correctly", {
   expect_true(ver_dict[[ver]]$col_serum == names(tbl)[ver_dict[[ver]]$which_serum])
   expect_true(ver_dict[[ver]]$col_plasma == names(tbl)[ver_dict[[ver]]$which_plasma])
 })
+
+test_that("error conditions trigger stops when appropriate", {
+
+  expect_error(
+    read_annotations("foo.txt"),
+    "Annotations file must be either"
+  )
+
+  expect_error(
+    with_pkg_object(SomaDataIO:::ver_dict[-2L], read_annotations(file)),
+    "Unknown version of the annotations file:"
+  )
+
+  # temp modify md5sha
+  tmp <- SomaDataIO:::ver_dict
+  tmp$`SL-12345678-rev0-2021-01`$sha <- "x0x0x0x0x"
+  expect_warning(
+    with_pkg_object(tmp, read_annotations(file)),
+    "Checksum mismatch. 'test-anno.xlsx' may have been modified"
+  )
+})