Fix col_labels bug for named label attributes

NEWS.md

@@ -1,5 +1,8 @@
 # teal.data 0.5.0.9001
 
+### Bug fixes
+* Fixed bug in `col_labels` causing incorrect label names to be returned when input data contains named label attributes.
+
 # teal.data 0.5.0
 
 ### Bug fixes

R/formatters_var_labels.R

@@ -43,7 +43,8 @@ col_labels <- function(x, fill = FALSE) {
     return(character(0L))
   }
 
-  labels <- lapply(x, attr, "label")
+  labels <- sapply(x, function(i) as.vector(attr(i, "label")), simplify = FALSE, USE.NAMES = TRUE)
+  lapply(labels, checkmate::assert_string, .var.name = "attr(x, \"label\")", null.ok = TRUE)
 
   nulls <- vapply(labels, is.null, logical(1L))
   if (any(nulls)) {

tests/testthat/test-formatters_var_labels.R

@@ -21,6 +21,37 @@ testthat::test_that("col_labels returns a vector of column names when fill = TRU
   )
 })
 
+testthat::test_that("col_labels works with labels having additional attributes (including names)", {
+  x <- iris
+  attr(x$Species, "label") <- structure("Label for Species", names = "blah", foo = "bar")
+  testthat::expect_identical(col_labels(x)[["Species"]], "Label for Species")
+})
+
+testthat::test_that("col_labels returns only 'names' attribute and ignores all the rest", {
+  x <- iris
+  attr(x$Species, "label") <- structure("Label for Species", names = "blah", foo = "bar")
+  testthat::expect_identical(attributes(col_labels(x)["Species"]), list(names = "Species"))
+})
+
+testthat::test_that("col_labels throws if label is not a character", {
+  x <- iris
+  attr(x$Species, "label") <- structure(1, names = "blah", foo = "bar")
+  testthat::expect_error(
+    col_labels(x),
+    "Assertion on 'attr(x, \"label\")' failed",
+    fixed = TRUE
+  )
+})
+
+testthat::test_that("col_labels throws if label is not a character of length 1", {
+  x <- iris
+  attr(x$Species, "label") <- structure(c("a", "b"), names = "blah", foo = "bar")
+  testthat::expect_error(
+    col_labels(x),
+    "Assertion on 'attr(x, \"label\")' failed",
+    fixed = TRUE
+  )
+})
 
 # col_labels ----
 testthat::test_that("col_labels<- value accepts character vector", {