Skip to content

Commit

Permalink
Closes #223 Test code clean up (#248)
Browse files Browse the repository at this point in the history
* Closes #223 Test code clean up

* removing magrittr where it's not necessary

* Order test files

* updating documentations

* Fixing the code style

* fixing styler

* Fixing lintr indentations issues

* fixing Styler

* Move package `readxl` to suggest
  • Loading branch information
sadchla-codes authored Mar 14, 2024
1 parent 394d74c commit 473dbe9
Show file tree
Hide file tree
Showing 18 changed files with 577 additions and 388 deletions.
1 change: 1 addition & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -54,6 +54,7 @@ importFrom(dplyr,ungroup)
importFrom(glue,glue)
importFrom(glue,glue_collapse)
importFrom(graphics,stem)
importFrom(haven,read_xpt)
importFrom(haven,write_xpt)
importFrom(lifecycle,deprecated)
importFrom(magrittr,"%>%")
Expand Down
2 changes: 1 addition & 1 deletion R/xportr-package.R
Original file line number Diff line number Diff line change
Expand Up @@ -102,7 +102,7 @@
#' @aliases xportr-package
#'
#' @importFrom lifecycle deprecated
#' @importFrom haven write_xpt
#' @importFrom haven write_xpt read_xpt
#' @importFrom rlang abort warn inform with_options local_options .data := sym
#' %||%
#' @importFrom dplyr left_join bind_cols filter select rename rename_with n
Expand Down
100 changes: 100 additions & 0 deletions tests/testthat/test-deprecation.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,100 @@
## Test 1: xportr_df_label: deprecated metacore gives an error ----
test_that("deprecation Test 1: xportr_df_label: deprecated metacore gives an error", {
local_options(lifecycle_verbosity = "quiet")
df <- data.frame(x = "a", y = "b")
df_meta <- data.frame(dataset = "df", label = "Label")

expect_error(xportr_df_label(df, metacore = df_meta))
})

## Test 2: xportr_format: deprecated metacore gives an error ----
test_that("deprecation Test 2: xportr_format: deprecated metacore gives an error", {
local_options(lifecycle_verbosity = "quiet")
df <- data.frame(x = 1, y = 2)
df_meta <- data.frame(
dataset = "df",
variable = "x",
format = "date9."
)

expect_error(xportr_format(df, metacore = df_meta))
})

## Test 3: xportr_label: using the deprecated metacore argument gives an error ----
test_that(
"deprecation Test 3: xportr_label: using the deprecated metacore argument gives an error",
{
local_options(lifecycle_verbosity = "quiet")

df <- data.frame(x = "a", y = "b")
df_meta <-
data.frame(
dataset = "df",
variable = "x",
label = "foo"
)

expect_error(xportr_label(df, metacore = df_meta))
}
)

## Test 4: xportr_length: using the deprecated metacore argument gives an error ----
test_that(
"deprecation Test 4: xportr_length: using the deprecated metacore argument gives an error",
{
local_options(lifecycle_verbosity = "quiet")
df <- data.frame(x = "a", y = "b")
df_meta <- data.frame(
dataset = "df",
variable = c("x", "y"),
type = c("text", "text"),
length = c(1, 2)
)

expect_error(xportr_length(df, metacore = df_meta))
}
)

## Test 5: xportr_order: using the deprecated metacore argument gives an error ----
test_that(
"deprecation Test 5: xportr_order: using the deprecated metacore argument gives an error",
{
local_options(lifecycle_verbosity = "quiet")

df <- data.frame(
c = 1:5,
a = "a",
d = 5:1,
b = LETTERS[1:5]
)
df_meta <- data.frame(
dataset = "DOMAIN",
variable = letters[1:4],
order = 1:4
)

expect_error(xportr_order(df, metacore = df_meta, domain = "DOMAIN"))
}
)

## Test 6: xportr_type: using the deprecated metacore argument gives an error ----
test_that(
"deprecation Test 6: xportr_type: using the deprecated metacore argument gives an error",
{
local_options(lifecycle_verbosity = "quiet")
df <- data.frame(
Subj = as.character(c(123, 456, 789, "", NA, NA_integer_)),
Different = c("a", "b", "c", "", NA, NA_character_),
Val = c("1", "2", "3", "", NA, NA_character_),
Param = c("param1", "param2", "param3", "", NA, NA_character_)
)
df_meta <- data.frame(
dataset = "df",
variable = c("Subj", "Param", "Val", "NotUsed"),
type = c("numeric", "character", "numeric", "character"),
format = NA
)

expect_error(xportr_type(df, metacore = df_meta))
}
)
72 changes: 0 additions & 72 deletions tests/testthat/test-depreciation.R

This file was deleted.

3 changes: 2 additions & 1 deletion tests/testthat/test-df_label.R
Original file line number Diff line number Diff line change
@@ -1,4 +1,5 @@
test_that("xportr_df_label: error when metadata is not set", {
## Test 1: xportr_df_label: error when metadata is not set ----
test_that("df_label Test 1: xportr_df_label: error when metadata is not set", {
adsl <- minimal_table()

expect_error(
Expand Down
61 changes: 37 additions & 24 deletions tests/testthat/test-format.R
Original file line number Diff line number Diff line change
@@ -1,4 +1,6 @@
test_that("xportr_format: error when metadata is not set", {
# xportr_format ----
## Test 1: xportr_format: error when metadata is not set ----
test_that("format Test 1: error when metadata is not set", {
adsl <- data.frame(
USUBJID = c(1001, 1002, 1003),
BRTHDT = c(1, 1, 2)
Expand All @@ -10,7 +12,8 @@ test_that("xportr_format: error when metadata is not set", {
)
})

test_that("xportr_format: Gets warning when metadata has multiple rows with same variable", {
## Test 2: xportr_format: Gets warning when metadata has multiple rows with same variable ----
test_that("format Test 2: Gets warning when metadata has multiple rows with same variable", {
# This test uses the (2) functions below to reduce code duplication
# All `expect_*` are being called inside the functions
#
Expand All @@ -20,7 +23,8 @@ test_that("xportr_format: Gets warning when metadata has multiple rows with same
multiple_vars_in_spec_helper2(xportr_format)
})

test_that("xportr_format: Works as expected with only one domain in metadata", {
## Test 3: xportr_format: Works as expected with only one domain in metadata ----
test_that("format Test 3: Works as expected with only one domain in metadata", {
adsl <- data.frame(
USUBJID = c(1001, 1002, 1003),
BRTHDT = c(1, 1, 2)
Expand All @@ -35,7 +39,8 @@ test_that("xportr_format: Works as expected with only one domain in metadata", {
expect_silent(xportr_format(adsl, metadata))
})

test_that("xportr_format: Variable ending in DT should produce a warning if no format", {
## Test 4: xportr_format: Variable ending in DT should produce a warning if no format ----
test_that("format Test 4: Variable ending in DT should produce a warning if no format", {
adsl <- data.frame(
USUBJID = c(1001, 1002, 1003),
BRTHDT = c(1, 1, 2)
Expand All @@ -54,7 +59,8 @@ test_that("xportr_format: Variable ending in DT should produce a warning if no f
)
})

test_that("xportr_format: Variable ending in TM should produce an error if no format", {
## Test 5: xportr_format: Variable ending in TM should produce an error if no format ----
test_that("format Test 5: Variable ending in TM should produce an error if no format", {
adsl <- data.frame(
USUBJID = c(1001, 1002, 1003),
BRTHTM = c(1, 1, 2)
Expand All @@ -73,7 +79,8 @@ test_that("xportr_format: Variable ending in TM should produce an error if no fo
)
})

test_that("xportr_format: Variable ending in DTM should produce a warning if no format", {
## Test 6: xportr_format: Variable ending in DTM should produce a warning if no format ----
test_that("format Test 6: Variable ending in DTM should produce a warning if no format", {
adsl <- data.frame(
USUBJID = c(1001, 1002, 1003),
BRTHDTM = c(1, 1, 2)
Expand Down Expand Up @@ -114,7 +121,8 @@ test_that(
}
)

test_that("xportr_format: If a variable is character then a warning should be produced if format is > 32 in length", {
## Test 7: xportr_format: If a variable is character then a warning should be produced if format is > 32 in length ----
test_that("format Test 7: If a variable is character then a warning should be produced if format is > 32 in length", { # nolint
adsl <- data.frame(
USUBJID = c("1001", "1002", "1003"),
BRTHDT = c(1, 1, 2)
Expand All @@ -141,26 +149,31 @@ test_that("xportr_format: If a variable is character then a warning should be pr
)
})

test_that("xportr_format: If a variable is numeric then an error should be produced if a format starts with `$`", {
adsl <- data.frame(
USUBJID = c(1001, 1002, 1003),
BRTHDT = c(1, 1, 2)
)
## Test 8: xportr_format: If a variable is numeric then an error should be produced if a format starts with `$` ----
test_that(
"format Test 8: If a variable is numeric then an error should be produced if a format starts with `$`",
{ # nolint
adsl <- data.frame( # nolint
USUBJID = c(1001, 1002, 1003),
BRTHDT = c(1, 1, 2)
)

metadata <- data.frame(
dataset = c("adsl", "adsl"),
variable = c("USUBJID", "BRTHDT"),
format = c("$4.", "DATE9.")
)
metadata <- data.frame( # nolint
dataset = c("adsl", "adsl"),
variable = c("USUBJID", "BRTHDT"),
format = c("$4.", "DATE9.")
)

expect_error(
xportr_format(adsl, metadata, verbose = "stop"),
regexp = "(xportr::xportr_format) `USUBJID` is a numeric variable and should not have a `$` prefix.",
fixed = TRUE
)
})
expect_error( # nolint
xportr_format(adsl, metadata, verbose = "stop"),
regexp = "(xportr::xportr_format) `USUBJID` is a numeric variable and should not have a `$` prefix.",
fixed = TRUE
)
}
)

test_that("xportr_format: If a variable is numeric then a warning should be produced if format is > 32 in length", {
## Test 9: xportr_format: If a variable is numeric then a warning should be produced if format is > 32 in length ---- #nolint
test_that("format Test 9: If a variable is numeric then a warning should be produced if format is > 32 in length", { # nolint
adsl <- data.frame(
USUBJID = c(1001, 1002, 1003),
BRTHDT = c(1, 1, 2)
Expand Down
31 changes: 18 additions & 13 deletions tests/testthat/test-label.R
Original file line number Diff line number Diff line change
@@ -1,29 +1,34 @@
test_that("xportr_label: error when metadata is not set", {
## Test 1: xportr_label: error when metadata is not set ----
test_that("label Test 1: xportr_label: error when metadata is not set", {
df <- data.frame(
Subj = as.character(123, 456, 789),
Different = c("a", "b", "c"),
Val = c("1", "2", "3"),
Param = c("param1", "param2", "param3")
)

expect_error(
xportr_label(df),
expect_error(xportr_label(df),
regexp = "Must be of type 'data.frame', 'Metacore' or set via 'xportr_metadata\\(\\)'"
)
})

test_that("xportr_label: Gets warning when metadata has multiple rows with same variable", {
# This test uses the (2) functions below to reduce code duplication
# All `expect_*` are being called inside the functions
#
# Checks that message appears when xportr.domain_name is invalid
multiple_vars_in_spec_helper(xportr_label)
# Checks that message doesn't appear when xportr.domain_name is valid
multiple_vars_in_spec_helper2(xportr_label)
})
## Test 2: xportr_label: Gets warning when metadata has multiple rows with same variable ----
test_that(
"label Test 2: xportr_label: Gets warning when metadata has multiple rows with same variable",
{
# This test uses the (2) functions below to reduce code duplication
# All `expect_*` are being called inside the functions
#
# Checks that message appears when xportr.domain_name is invalid
multiple_vars_in_spec_helper(xportr_label)
# Checks that message doesn't appear when xportr.domain_name is valid
multiple_vars_in_spec_helper2(xportr_label)
}
)


test_that("xportr_label: Works as expected with only one domain in metadata", {
## Test 3: xportr_label: Works as expected with only one domain in metadata ----
test_that("label Test 3: xportr_label: Works as expected with only one domain in metadata", {
adsl <- data.frame(
USUBJID = c(1001, 1002, 1003),
BRTHDT = c(1, 1, 2)
Expand Down
Loading

0 comments on commit 473dbe9

Please sign in to comment.