Closes #2636 enhance code coverage assert_db_requirements (split from #…

…2579) (#2638) * 2636 add tests #24 #25 to enhance code coverage * 2636 fix test to for is NULL * #2636 Test #24 test error when `fun` is NULL * # 2636 Correct lintr error (lines <101 characters) * # 2636 fix styler error * # 2636 lint * Update tests/testthat/test-create_query_data.R Co-authored-by: Stefan Bundfuss <[email protected]> * #2636 enhance_tests_assert_db_requirements: move test and update snaps * #2636 enhance_tests_assert_db_requirements: fix lintr --------- Co-authored-by: Stefan Bundfuss <[email protected]> Co-authored-by: Stefan Bundfuss <[email protected]>
pharmaverse · Jan 22, 2025 · d208f18 · d208f18
1 parent 5456838
commit d208f18
Show file tree

Hide file tree

Showing 2 changed files with 84 additions and 45 deletions.
diff --git a/tests/testthat/_snaps/create_query_data.md b/tests/testthat/_snaps/create_query_data.md
@@ -36,7 +36,28 @@
         scope: "NA"
         type: "sdg"
 
-# query Test 8: error if name = auto for non SMQs/SDGs
+# create_query_data Test 8: error if no `get_terms_fun` provided
+
+    Code
+      create_query_data(queries = list(query(prefix = "SMQ02", id = auto, definition = basket_select(
+        name = "Pregnancy and neonatal topics (SMQ)", scope = "NARROW", type = "smq"))))
+    Condition
+      Error in `assert_db_requirements()`:
+      ! `get_terms_fun` is not specified. This is expected for baskets.
+      i A basket is requested by query 1:
+      <query> object
+      prefix: "SMQ02"
+      name: auto
+      id: auto
+      add_scope_num: FALSE
+      definition:
+        <basket_select> object
+        name: "Pregnancy and neonatal topics (SMQ)"
+        id: NULL
+        scope: "NARROW"
+        type: "smq"
+
+# query Test 9: error if name = auto for non SMQs/SDGs
 
     Code
       sdg <- query(prefix = "CQ01", definition = cqterms)
@@ -45,7 +66,7 @@
       ! The auto keyword can be used for baskets only.
       i It was provided for the `name` element.
 
-# query Test 9: error if id = auto for non SMQs/SDGs
+# query Test 10: error if id = auto for non SMQs/SDGs
 
     Code
       sdg <- query(name = "My CQ", id = auto, prefix = "CQ01", definition = cqterms)
@@ -54,7 +75,7 @@
       ! The auto keyword can be used for baskets only.
       i It was provided for the `id` element.
 
-# query Test 10: error if invalid definition
+# query Test 11: error if invalid definition
 
     Code
       sdg <- query(name = "My CQ", prefix = "CQ01", definition = 1)
@@ -63,15 +84,15 @@
       ! `definition` expects a <basket_select> object, a data frame, or a list of data frames and <basket_select> objects.
       i An object of the following class was provided: <numeric>
 
-# assert_terms Test 11: error if SRCVAR missing
+# assert_terms Test 12: error if SRCVAR missing
 
     Code
       assert_terms(terms = select(cqterms, -SRCVAR), source_text = "my test data")
     Condition
       Error in `assert_terms()`:
       ! Required variable `SRCVAR` is missing in my test data.
 
-# assert_terms Test 12: error if SRCVAR and GRPNAME missing
+# assert_terms Test 13: error if SRCVAR and GRPNAME missing
 
     Code
       assert_terms(terms = select(cqterms, -SRCVAR), source_text = "my test data",
@@ -80,7 +101,7 @@
       Error in `assert_terms()`:
       ! Required variables `SRCVAR` and `GRPNAME` are missing in my test data.
 
-# assert_terms Test 13: error if TERMCHAR and TERMNUM missing
+# assert_terms Test 14: error if TERMCHAR and TERMNUM missing
 
     Code
       assert_terms(terms = select(cqterms, SRCVAR), source_text = "my test data")
@@ -90,55 +111,55 @@
       None of them is in my test data.
       i Provided variables: `SRCVAR`
 
-# assert_terms Test 14: error if no data frame
+# assert_terms Test 15: error if no data frame
 
     Code
       assert_terms(terms = 42, source_text = "object returned by calling get_mysmq()")
     Condition
       Error in `assert_terms()`:
       ! object returned by calling get_mysmq() is not a data frame but a function.
 
-# assert_terms Test 15: error if no observations
+# assert_terms Test 16: error if no observations
 
     Code
       assert_terms(terms = filter(cqterms, TERMNUM == 42), source_text = "object returned by calling get_my_smq")
     Condition
       Error in `assert_terms()`:
       ! object returned by calling get_my_smq does not contain any observations.
 
-# assert_terms Test 16: error if GRPNAME is missing
+# assert_terms Test 17: error if GRPNAME is missing
 
     Code
       assert_terms(terms = cqterms, expect_grpname = TRUE, source_text = "object returned by calling get_my_smq")
     Condition
       Error in `assert_terms()`:
       ! Required variable `GRPNAME` is missing in object returned by calling get_my_smq.
 
-# assert_terms Test 17: error if GRPID is missing
+# assert_terms Test 18: error if GRPID is missing
 
     Code
       assert_terms(terms = cqterms, expect_grpid = TRUE, source_text = "object returned by calling get_my_smq")
     Condition
       Error in `assert_terms()`:
       ! Required variable `GRPID` is missing in object returned by calling get_my_smq.
 
-# basket_select Test 18: error if name and id specified
+# basket_select Test 19: error if name and id specified
 
     Code
       basket_select(name = "My SMQ", id = 42, scope = "NARROW", type = "smq")
     Condition
       Error in `validate_basket_select()`:
       ! Either `id` or `name` has to be null.
 
-# basket_select Test 19: error if neither name nor id specified
+# basket_select Test 20: error if neither name nor id specified
 
     Code
       basket_select(scope = "NARROW", type = "smq")
     Condition
       Error in `validate_basket_select()`:
       ! Either `id` or `name` has to be non null.
 
-# basket_select Test 20: error if type is not specified
+# basket_select Test 21: error if type is not specified
 
     Code
       basket_select(id = 42, scope = "NARROW")

diff --git a/tests/testthat/test-create_query_data.R b/tests/testthat/test-create_query_data.R
@@ -330,9 +330,27 @@ test_that("create_query_data Test 7: issues error if SDGs without meddra_version
   )
 })
 
+## Test 8: error if no `get_terms_fun` provided ----
+test_that("create_query_data Test 8: error if no `get_terms_fun` provided", {
+  expect_snapshot(
+    create_query_data(queries = list(
+      query(
+        prefix = "SMQ02",
+        id = auto,
+        definition = basket_select(
+          name = "Pregnancy and neonatal topics (SMQ)",
+          scope = "NARROW",
+          type = "smq"
+        )
+      )
+    )),
+    error = TRUE
+  )
+})
+
 # query ----
-## Test 8: error if name = auto for non SMQs/SDGs ----
-test_that("query Test 8: error if name = auto for non SMQs/SDGs", {
+## Test 9: error if name = auto for non SMQs/SDGs ----
+test_that("query Test 9: error if name = auto for non SMQs/SDGs", {
   expect_snapshot(
     sdg <- query(
       prefix = "CQ01",
@@ -342,8 +360,8 @@ test_that("query Test 8: error if name = auto for non SMQs/SDGs", {
   )
 })
 
-## Test 9: error if id = auto for non SMQs/SDGs ----
-test_that("query Test 9: error if id = auto for non SMQs/SDGs", {
+## Test 10: error if id = auto for non SMQs/SDGs ----
+test_that("query Test 10: error if id = auto for non SMQs/SDGs", {
   expect_snapshot(
     sdg <- query(
       name = "My CQ",
@@ -355,8 +373,8 @@ test_that("query Test 9: error if id = auto for non SMQs/SDGs", {
   )
 })
 
-## Test 10: error if invalid definition ----
-test_that("query Test 10: error if invalid definition", {
+## Test 11: error if invalid definition ----
+test_that("query Test 11: error if invalid definition", {
   expect_snapshot(
     sdg <- query(
       name = "My CQ",
@@ -368,8 +386,8 @@ test_that("query Test 10: error if invalid definition", {
 })
 
 # assert_terms ----
-## Test 11: error if SRCVAR missing ----
-test_that("assert_terms Test 11: error if SRCVAR missing", {
+## Test 12: error if SRCVAR missing ----
+test_that("assert_terms Test 12: error if SRCVAR missing", {
   expect_snapshot(
     assert_terms(
       terms = select(cqterms, -SRCVAR),
@@ -379,8 +397,8 @@ test_that("assert_terms Test 11: error if SRCVAR missing", {
   )
 })
 
-## Test 12: error if SRCVAR and GRPNAME missing ----
-test_that("assert_terms Test 12: error if SRCVAR and GRPNAME missing", {
+## Test 13: error if SRCVAR and GRPNAME missing ----
+test_that("assert_terms Test 13: error if SRCVAR and GRPNAME missing", {
   expect_snapshot(
     assert_terms(
       terms = select(cqterms, -SRCVAR),
@@ -391,8 +409,8 @@ test_that("assert_terms Test 12: error if SRCVAR and GRPNAME missing", {
   )
 })
 
-## Test 13: error if TERMCHAR and TERMNUM missing ----
-test_that("assert_terms Test 13: error if TERMCHAR and TERMNUM missing", {
+## Test 14: error if TERMCHAR and TERMNUM missing ----
+test_that("assert_terms Test 14: error if TERMCHAR and TERMNUM missing", {
   expect_snapshot(
     assert_terms(
       terms = select(cqterms, SRCVAR),
@@ -402,8 +420,8 @@ test_that("assert_terms Test 13: error if TERMCHAR and TERMNUM missing", {
   )
 })
 
-## Test 14: error if no data frame ----
-test_that("assert_terms Test 14: error if no data frame", {
+## Test 15: error if no data frame ----
+test_that("assert_terms Test 15: error if no data frame", {
   expect_snapshot(
     assert_terms(
       terms = 42,
@@ -413,8 +431,8 @@ test_that("assert_terms Test 14: error if no data frame", {
   )
 })
 
-## Test 15: error if no observations ----
-test_that("assert_terms Test 15: error if no observations", {
+## Test 16: error if no observations ----
+test_that("assert_terms Test 16: error if no observations", {
   expect_snapshot(
     assert_terms(
       terms = filter(cqterms, TERMNUM == 42),
@@ -424,8 +442,8 @@ test_that("assert_terms Test 15: error if no observations", {
   )
 })
 
-## Test 16: error if GRPNAME is missing ----
-test_that("assert_terms Test 16: error if GRPNAME is missing", {
+## Test 17: error if GRPNAME is missing ----
+test_that("assert_terms Test 17: error if GRPNAME is missing", {
   expect_snapshot(
     assert_terms(
       terms = cqterms,
@@ -436,8 +454,8 @@ test_that("assert_terms Test 16: error if GRPNAME is missing", {
   )
 })
 
-## Test 17: error if GRPID is missing ----
-test_that("assert_terms Test 17: error if GRPID is missing", {
+## Test 18: error if GRPID is missing ----
+test_that("assert_terms Test 18: error if GRPID is missing", {
   expect_snapshot(
     assert_terms(
       terms = cqterms,
@@ -449,8 +467,8 @@ test_that("assert_terms Test 17: error if GRPID is missing", {
 })
 
 # basket_select ----
-## Test 18: error if name and id specified ----
-test_that("basket_select Test 18: error if name and id specified", {
+## Test 19: error if name and id specified ----
+test_that("basket_select Test 19: error if name and id specified", {
   expect_snapshot(
     basket_select(
       name = "My SMQ",
@@ -462,16 +480,16 @@ test_that("basket_select Test 18: error if name and id specified", {
   )
 })
 
-## Test 19: error if neither name nor id specified ----
-test_that("basket_select Test 19: error if neither name nor id specified", {
+## Test 20: error if neither name nor id specified ----
+test_that("basket_select Test 20: error if neither name nor id specified", {
   expect_snapshot(
     basket_select(scope = "NARROW", type = "smq"),
     error = TRUE
   )
 })
 
-## Test 20: error if type is not specified ----
-test_that("basket_select Test 20: error if type is not specified", {
+## Test 21: error if type is not specified ----
+test_that("basket_select Test 21: error if type is not specified", {
   expect_snapshot(
     basket_select(id = 42, scope = "NARROW"),
     error = TRUE
@@ -507,8 +525,8 @@ get_smq_oth <- function(basket_select,
 }
 
 
-## Test 21: basket_select customized query defined by SMQs extra arguments ----
-test_that("basket_select Test 21: basket_select customized query defined by SMQs extra arguments", {
+## Test 22: basket_select customized query defined by SMQs extra arguments ----
+test_that("basket_select Test 22: basket_select customized query defined by SMQs extra arguments", {
   cq <- query(
     prefix = "CQ02",
     name = "Immune-Mediated Meningoencephalitis",
@@ -558,8 +576,8 @@ test_that("basket_select Test 21: basket_select customized query defined by SMQs
 })
 
 # format.basket_select ----
-## Test 22: formatting is correct (id specified) ----
-test_that("format.basket_select Test 22: formatting is correct (id specified)", {
+## Test 23: formatting is correct (id specified) ----
+test_that("format.basket_select Test 23: formatting is correct (id specified)", {
   expect_equal(
     format(basket_select(
       id = 42,
@@ -571,8 +589,8 @@ test_that("format.basket_select Test 22: formatting is correct (id specified)",
   )
 })
 
-## Test 23: formatting is correct (name specified) ----
-test_that("format.basket_select Test 23: formatting is correct (name specified)", {
+## Test 24: formatting is correct (name specified) ----
+test_that("format.basket_select Test 24: formatting is correct (name specified)", {
   expect_equal(
     format(basket_select(name = "My SDG", type = "sdg", scope = NA_character_)),
     "basket_select(name = \"My SDG\", id = NULL, scope = \"NA\", type = \"sdg\")"