Closes #223 Test code clean up (#248)

* 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

NAMESPACE

@@ -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,"%>%")

R/xportr-package.R

@@ -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

tests/testthat/test-deprecation.R

@@ -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))
+ }
+)

tests/testthat/test-df_label.R

@@ -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(

tests/testthat/test-format.R

@@ -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)
@@ -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
  #
@@ -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)
@@ -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)
@@ -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)
@@ -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)
@@ -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)
@@ -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)

tests/testthat/test-label.R

@@ -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)