Closes #223 Test code clean up

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,5 @@
-test_that("xportr_format: error when metadata is not set", {
+## Test 1: xportr_format: error when metadata is not set ----
+test_that("format Test 1: xportr_format: error when metadata is not set", {
   adsl <- data.frame(
     USUBJID = c(1001, 1002, 1003),
     BRTHDT = c(1, 1, 2)
@@ -10,7 +11,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: xportr_format: 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 +22,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: xportr_format: Works as expected with only one domain in metadata", {
   adsl <- data.frame(
     USUBJID = c(1001, 1002, 1003),
     BRTHDT = c(1, 1, 2)
@@ -35,7 +38,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: xportr_format: 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 +58,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: xportr_format: 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 +78,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: xportr_format: 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 +120,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: xportr_format: If a variable is character then a warning should be produced if format is > 32 in length", {
   adsl <- data.frame(
     USUBJID = c("1001", "1002", "1003"),
     BRTHDT = c(1, 1, 2)
@@ -141,7 +148,8 @@ 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 `$`", {
+## 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: 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)
@@ -160,7 +168,8 @@ test_that("xportr_format: If a variable is numeric then an error should be produ
   )
 })
 
-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 ----
+test_that("format Test 9: xportr_format: If a variable is numeric then a warning should be produced if format is > 32 in length", {
   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)