Closes #223 Test code clean up

DESCRIPTION

@@ -36,13 +36,13 @@ Imports:
     readr,
     rlang (>= 0.4.10),
     stringr (>= 1.4.0),
-    tidyselect
+    tidyselect,
+    readxl
 Suggests: 
     DT,
     knitr,
     labelled,
     metacore,
-    readxl,
     rmarkdown,
     testthat (>= 3.0.0),
     withr

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,"%>%")
@@ -66,6 +67,7 @@ importFrom(purrr,map_dbl)
 importFrom(purrr,pluck)
 importFrom(purrr,walk)
 importFrom(readr,parse_number)
+importFrom(readxl,read_xlsx)
 importFrom(rlang,"%||%")
 importFrom(rlang,":=")
 importFrom(rlang,.data)

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
@@ -121,6 +121,7 @@
 #' @importFrom checkmate assert assert_character assert_choice assert_data_frame
 #' assert_integer assert_logical assert_string makeAssertion check_data_frame
 #' check_r6 test_data_frame test_string vname
+#' @importFrom readxl read_xlsx
 "_PACKAGE"
 
 globalVariables(c(

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)