Codecov is 100%

Author: richelbilderbeek

NEWS.md

@@ -13,11 +13,11 @@ Newest versions at top.
 
 ## MINOR IMPROVEMENTS
 
-- None
+- Code coverage is 100.00%
 
 ## BUG FIXES
 
-- None
+- `s_parameter_to_xml` can handle an upper value of infinity
 
 ## DEPRECATED AND DEFUNCT
 

R/check_empty_beautier_folder.R

@@ -51,8 +51,7 @@ check_empty_beautier_folder <- function(
       paste(utils::head(filenames), collapse = ",")
     )
   }
-  if (dir.exists(beautier_folder)) {
-    stop("'beautier' folder found at ", beautier_folder)
-  }
-  invisible(beautier_folder)
+  # Last possible cause for an error
+  testthat::expect_true(dir.exists(beautier_folder))
+  stop("'beautier' folder found at ", beautier_folder)
 }

R/get_n_taxa.R

@@ -27,5 +27,5 @@ get_n_taxa <- function(filename) {
       )
     }
   )
-  invisible(filename)
+  # Will never get here
 }

R/s_parameter_to_xml.R

@@ -52,11 +52,12 @@ s_parameter_to_xml <- function(
   if (!beautier::is_one_na(upper)) {
     if (!is.infinite(upper)) {
       upper_txt <- upper
-      if (is.infinite(upper)) {
-        upper_txt <- "Infinity"
-      }
-      text <- paste0(text, " upper=\"", upper_txt, "\"")
     }
+    else {
+      testthat::expect_true(is.infinite(upper))
+      upper_txt <- "Infinity"
+    }
+    text <- paste0(text, " upper=\"", upper_txt, "\"")
   }
   text <- paste0(text, ">", value, "</parameter>")
   text

tests/testthat/test-check_clock_model.R

@@ -30,13 +30,22 @@ test_that("abuse, general clock model", {
     "'id' must be an element of 'clock_model'"
   )
 
-  # Break clock name
+  # Invalid clock name
   clock_model <- create_strict_clock_model()
   clock_model$name <- "nonsense"
   expect_error(
     check_clock_model(clock_model),
     "'clock_model\\$name' must be one of the clock model names"
   )
+
+  # Invalid rate_scaler_factor
+  clock_model <- create_strict_clock_model()
+  clock_model$rate_scaler_factor <- "nonsense"
+  expect_error(
+    check_clock_model(clock_model),
+    "'rate_scaler_factor' must be a number or a string that can be converted to a number or an empty string"
+  )
+
 })
 
 test_that("abuse, rln clock model", {

tests/testthat/test-check_clock_models.R

@@ -1,5 +1,3 @@
-context("test-check_clock_models")
-
 test_that("use", {
   expect_silent(
     check_clock_models(

tests/testthat/test-create_site_model.R

@@ -35,6 +35,16 @@ test_that("abuse", {
 
 })
 
+test_that("create_gtr_site_model: devious", {
+
+  expect_error(
+    create_gtr_site_model(
+      freq_param = "nonsense"
+    )
+  )
+
+})
+
 test_that("create_gtr_site_model: new interface", {
 
   # Old interface

tests/testthat/test-is_param.R

@@ -56,6 +56,15 @@ test_that("is_alpha_param", {
 
 })
 
+
+test_that("is_b_pop_sizes_param", {
+
+  expect_true(is_b_pop_sizes_param(create_b_pop_sizes_param()))
+  expect_false(is_b_pop_sizes_param("nonsense"))
+
+})
+
+
 test_that("is_beta_param", {
 
   expect_true(is_beta_param(create_beta_param()))
@@ -74,6 +83,7 @@ test_that("is_freq_param", {
 
   expect_true(is_freq_param(create_freq_param()))
   expect_false(is_freq_param("nonsense"))
+  expect_false(is_freq_param(create_b_pop_sizes_param()))
 })
 
 test_that("is_freq_param, devious", {
@@ -85,6 +95,14 @@ test_that("is_freq_param, devious", {
   h <- g[names(g) != "lower"]
   expect_false(is_freq_param(h))
 
+  # No 'upper'
+  h <- g[names(g) != "upper"]
+  expect_false(is_freq_param(h))
+
+  # No 'value'
+  h <- g[names(g) != "value"]
+  expect_false(is_freq_param(h))
+
   # No 'estimate'
   h <- g[names(g) != "estimate"]
   expect_false(is_freq_param(h))
@@ -94,6 +112,25 @@ test_that("is_freq_param, devious", {
   expect_false(is_freq_param(h))
 })
 
+test_that("is_kappa_param", {
+
+  expect_true(is_kappa_param(create_kappa_param()))
+  expect_false(is_kappa_param("nonsense"))
+})
+
+test_that("is_kappa_param, devious", {
+
+  g <- create_kappa_param()
+  expect_true(is_kappa_param(g))
+
+  # No 'lower'
+  h <- g[names(g) != "lower"]
+  expect_false(is_kappa_param(h))
+
+  # No 'estimate'
+  h <- g[names(g) != "estimate"]
+  expect_false(is_kappa_param(h))
+})
 
 test_that("is_kappa_1_param", {
 

tests/testthat/test-is_site_model.R

@@ -206,6 +206,12 @@ test_that("is_hky_site_model: devious", {
   h <- g
   h$freq_equilibrium <- "nonsense"
   expect_false(is_hky_site_model(h))
+
+  # Invalid 'kappa_param'
+  h <- g
+  h$kappa_param <- "nonsense"
+  expect_false(is_hky_site_model(h))
+
 })
 
 test_that("is_tn93_site_model: devious", {

tests/testthat/test-is_tree_prior.R

@@ -81,6 +81,15 @@ test_that("is_cbs_tree_prior, devious", {
   # No 'group_sizes_dimension'
   h <- g[names(g) != "group_sizes_dimension"]
   expect_false(is_cbs_tree_prior(h))
+
+  # No 'b_pop_sizes_param'
+  h <- g[names(g) != "b_pop_sizes_param"]
+  expect_false(is_cbs_tree_prior(h))
+
+  # No 'pop_sizes_scaler_scale_factor'
+  h <- g[names(g) != "pop_sizes_scaler_scale_factor"]
+  expect_false(is_cbs_tree_prior(h))
+
 })
 
 test_that("is_ccp_tree_prior, devious", {