From 99dd0fca3f4fc56ae0884db4c0096289cf1577ba Mon Sep 17 00:00:00 2001
From: Pawel Rucki <12943682+pawelru@users.noreply.github.com>
Date: Mon, 18 Mar 2024 09:53:53 +0100
Subject: [PATCH] options for strict tests; few enhancements (#279)
- part of
https://github.com/insightsengineering/coredev-tasks/issues/478
- please read this for more info about the implementation:
https://github.com/insightsengineering/coredev-tasks/issues/478#issuecomment-1909912778
- removed `teal.data::` from code as it's redundant inside `teal.data`
- removed unnecessary empty first line in examples as this is actually
being rendered
Please review the changes carefully and let me know if there is
something you don't like.
---
DESCRIPTION | 8 ++++----
R/join_keys-extract.R | 3 ---
R/join_keys-parents.R | 4 ----
R/join_keys.R | 2 --
R/verify.R | 4 +++-
man/join_keys.Rd | 4 ----
man/parents.Rd | 4 ----
man/verify.Rd | 4 +++-
tests/testthat/setup-options.R | 20 ++++++++++++++++++++
tests/testthat/test-get_code.R | 2 +-
vignettes/join-keys.Rmd | 26 +++++++++++++-------------
11 files changed, 44 insertions(+), 37 deletions(-)
create mode 100644 tests/testthat/setup-options.R
diff --git a/DESCRIPTION b/DESCRIPTION
index 9516eb88a..dc364e041 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -40,14 +40,14 @@ Imports:
Suggests:
knitr (>= 1.42),
rmarkdown (>= 2.19),
- testthat (>= 3.1.5)
+ testthat (>= 3.1.5),
+ withr (>= 2.0.0)
VignetteBuilder:
knitr
RdMacros:
lifecycle
-Config/Needs/verdepcheck: mllg/checkmate, r-lib/lifecycle, r-lib/rlang,
- yihui/knitr, rstudio/rmarkdown, insightsengineering/teal.code,
- r-lib/testthat
+Config/Needs/verdepcheck: insightsengineering/teal.code, mllg/checkmate, r-lib/lifecycle, r-lib/rlang,
+ yihui/knitr, rstudio/rmarkdown, r-lib/testthat, r-lib/withr
Config/Needs/website: insightsengineering/nesttemplate
Encoding: UTF-8
Language: en-US
diff --git a/R/join_keys-extract.R b/R/join_keys-extract.R
index e9cbd5549..46e2c73b1 100644
--- a/R/join_keys-extract.R
+++ b/R/join_keys-extract.R
@@ -14,7 +14,6 @@
#' @export
#'
#' @examples
-#'
#' # Getter for join_keys ---
#'
#' jk["ds1", "ds2"]
@@ -131,7 +130,6 @@
#'
#' @export
#' @examples
-#'
#' # Setting a new primary key ---
#'
#' jk["ds4", "ds4"] <- "pk4"
@@ -189,7 +187,6 @@
#'
#' @export
#' @examples
-#'
#' # Setting via x[[i]] <- value ---
#'
#' jk <- join_keys()
diff --git a/R/join_keys-parents.R b/R/join_keys-parents.R
index 61254aaa6..be14c941e 100644
--- a/R/join_keys-parents.R
+++ b/R/join_keys-parents.R
@@ -30,7 +30,6 @@ parents.join_keys <- function(x) {
#' @describeIn parents Retrieves parents of `join_keys` inside `teal_data` object.
#' @export
#' @examples
-#'
#' # Get parents of join_keys inside teal_data object ---
#'
#' td <- teal_data(
@@ -56,7 +55,6 @@ parents.teal_data <- function(x) {
#' @describeIn parents Assignment of parents of `join_keys` object.
#' @export
#' @examples
-#'
#' # Assignment of parents ---
#'
#' jk <- join_keys(
@@ -109,7 +107,6 @@ parents.teal_data <- function(x) {
#' @describeIn parents Assignment of parents of `join_keys` inside `teal_data` object.
#' @export
#' @examples
-#'
#' # Assignment of parents of join_keys inside teal_data object ---
#'
#' parents(td) <- list("ADTTE" = "ADSL") # replace existing
@@ -128,7 +125,6 @@ parents.teal_data <- function(x) {
#' @export
#'
#' @examples
-#'
#' # Get individual parent ---
#'
#' parent(jk, "ds2")
diff --git a/R/join_keys.R b/R/join_keys.R
index 433332457..47fb97836 100644
--- a/R/join_keys.R
+++ b/R/join_keys.R
@@ -111,7 +111,6 @@ join_keys.teal_data <- function(...) {
#' @order 5
#' @export
#' @examples
-#'
#' # Assigning keys via join_keys(x)[i, j] <- value ----
#'
#' obj <- join_keys()
@@ -133,7 +132,6 @@ join_keys.teal_data <- function(...) {
#' @order 5
#' @export
#' @examples
-#'
#' # Setter for join_keys within teal_data ----
#'
#' td <- teal_data()
diff --git a/R/verify.R b/R/verify.R
index 21c1656c2..7caa648f2 100644
--- a/R/verify.R
+++ b/R/verify.R
@@ -43,7 +43,9 @@
#' e <- 1"
#' )
#' tdata4
-#' try(verify(tdata4)) # fails
+#' \dontrun{
+#' verify(tdata4) # fails
+#' }
#'
#' @name verify
#' @rdname verify
diff --git a/man/join_keys.Rd b/man/join_keys.Rd
index 26582c211..bc1e9a15f 100644
--- a/man/join_keys.Rd
+++ b/man/join_keys.Rd
@@ -137,7 +137,6 @@ jk <- join_keys(
jk
-
# Getter for join_keys ---
jk["ds1", "ds2"]
@@ -148,7 +147,6 @@ jk["ds1"]
jk[1:2]
jk[c("ds1", "ds2")]
-
# Setting a new primary key ---
jk["ds4", "ds4"] <- "pk4"
@@ -177,7 +175,6 @@ jk_merged <- c(
join_key("ds5", keys = "pk5"),
join_key("ds1", "ds5", c(pk1 = "pk5"))
)
-
# Assigning keys via join_keys(x)[i, j] <- value ----
obj <- join_keys()
@@ -191,7 +188,6 @@ join_keys(obj)["ds1", "ds2"] <- c(pk1 = "pk2")
join_keys(obj)["ds1", "ds3"] <- c(pk1 = "pk3")
identical(jk, join_keys(obj))
-
# Setter for join_keys within teal_data ----
td <- teal_data()
diff --git a/man/parents.Rd b/man/parents.Rd
index 3d1ce046e..ed8325a6f 100644
--- a/man/parents.Rd
+++ b/man/parents.Rd
@@ -67,7 +67,6 @@ Each element is defined by a \code{list} element, where \code{list("child" = "pa
jk <- default_cdisc_join_keys["ADEX"]
parents(jk)
-
# Get parents of join_keys inside teal_data object ---
td <- teal_data(
@@ -77,7 +76,6 @@ td <- teal_data(
join_keys = default_cdisc_join_keys[c("ADSL", "ADTTE", "ADRS")]
)
parents(td)
-
# Assignment of parents ---
jk <- join_keys(
@@ -92,12 +90,10 @@ parents(jk) <- list(ds2 = "ds1")
parents(jk)["ds6"] <- "ds5"
parents(jk)["ds7"] <- "ds6"
-
# Assignment of parents of join_keys inside teal_data object ---
parents(td) <- list("ADTTE" = "ADSL") # replace existing
parents(td)["ADRS"] <- "ADSL" # add new parent
-
# Get individual parent ---
parent(jk, "ds2")
diff --git a/man/verify.Rd b/man/verify.Rd
index 34e5e7eb5..630a08788 100644
--- a/man/verify.Rd
+++ b/man/verify.Rd
@@ -56,6 +56,8 @@ tdata4 <- teal_data(
e <- 1"
)
tdata4
-try(verify(tdata4)) # fails
+\dontrun{
+verify(tdata4) # fails
+}
}
diff --git a/tests/testthat/setup-options.R b/tests/testthat/setup-options.R
new file mode 100644
index 000000000..78be1f9b5
--- /dev/null
+++ b/tests/testthat/setup-options.R
@@ -0,0 +1,20 @@
+# `opts_partial_match_old` is left for exclusions due to partial matching in dependent packages (i.e. not fixable here)
+# it might happen that it is not used right now, but it is left for possible future use
+# use with: `withr::with_options(opts_partial_match_old, { ... })` inside the test
+opts_partial_match_old <- list(
+ warnPartialMatchDollar = getOption("warnPartialMatchDollar"),
+ warnPartialMatchArgs = getOption("warnPartialMatchArgs"),
+ warnPartialMatchAttr = getOption("warnPartialMatchAttr")
+)
+opts_partial_match_new <- list(
+ warnPartialMatchDollar = TRUE,
+ warnPartialMatchArgs = TRUE,
+ warnPartialMatchAttr = TRUE
+)
+
+if (isFALSE(getFromNamespace("on_cran", "testthat")()) && requireNamespace("withr", quietly = TRUE)) {
+ withr::local_options(
+ opts_partial_match_new,
+ .local_envir = testthat::teardown_env()
+ )
+}
diff --git a/tests/testthat/test-get_code.R b/tests/testthat/test-get_code.R
index 182328248..959a54d12 100644
--- a/tests/testthat/test-get_code.R
+++ b/tests/testthat/test-get_code.R
@@ -411,7 +411,7 @@ testthat::test_that("ignores occurrence in a function definition in lapply", {
"b <- lapply(a, FUN = function(x) { x <- x + 1 })",
"b <- Filter(function(x) x > 2, b)",
"x <- 1",
- "print(x)"
+ "identity(x)"
)
tdata <- eval_code(teal_data(), code)
testthat::expect_identical(
diff --git a/vignettes/join-keys.Rmd b/vignettes/join-keys.Rmd
index a386bc81f..9d06fed22 100644
--- a/vignettes/join-keys.Rmd
+++ b/vignettes/join-keys.Rmd
@@ -1,7 +1,7 @@
---
title: "Join Keys"
author: "NEST CoreDev"
-output:
+output:
rmarkdown::html_vignette:
toc: true
vignette: >
@@ -88,19 +88,19 @@ jk
| Output of `print(jk)` | Output annotation |
| ---------------------------------- |:----------------------------------------:|
| `## A join_keys object containing foreign keys between 3 datasets:` | **Title** |
-| `## ds1: [col_1]` | **Primary keys**
_\_: [_\_] |
-| `## <-- ds2: [col_1]` | **Foreign keys**
_(arrow `<--` denotes `ds1` is the parent of `ds2`)_ |
-| `## <-- ds3: [col_1]` | |
-| `## ds2: [col_1, col_2]` | |
-| `## --> ds1: [col_1]` | arrow `-->` denotes `ds2` is a child of `ds1` |
+| `## ds1: [col_1]` | **Primary keys**
_\_: [_\_] |
+| `## <-- ds2: [col_1]` | **Foreign keys**
_(arrow `<--` denotes `ds1` is the parent of `ds2`)_ |
+| `## <-- ds3: [col_1]` | |
+| `## ds2: [col_1, col_2]` | |
+| `## --> ds1: [col_1]` | arrow `-->` denotes `ds2` is a child of `ds1` |
| `## --* (implicit via parent with): ds3` | **Implicit relationship between `ds2` & `ds3`**
_(given that they share common keys with same parent)_ |
-| `## ds3: [col_1, col_3]` | |
-| `## --> ds1: [col_1]` | |
-| `## --* (implicit via parent with): ds2` | |
-| `## ds4: [no primary keys]` | |
-| `## <-> ds5: [col_5]` | **Foreign keys**
_(arrow `<->` denotes no parent definition between datasets)_ |
-| `## ds5: [no primary keys]` | |
-| `## <-> ds4: [col_4] ` | |
+| `## ds3: [col_1, col_3]` | |
+| `## --> ds1: [col_1]` | |
+| `## --* (implicit via parent with): ds2` | |
+| `## ds4: [no primary keys]` | |
+| `## <-> ds5: [col_5]` | **Foreign keys**
_(arrow `<->` denotes no parent definition between datasets)_ |
+| `## ds5: [no primary keys]` | |
+| `## <-> ds4: [col_4] ` | |
## Accessing and Modifying keys