test: label with a function

Author: DanChaltiel

R/labels.R

@@ -281,9 +281,7 @@ apply_labels = function(.data, ..., fn, warn_missing=FALSE) {
   if(!missing(fn)){
     check_dots_empty()
     fn = as_function(fn)
-    rtn = .data %>%
-      mutate(across(everything(),
-                    ~set_label(.x, fn(get_label(.x)))))
+    rtn = set_label(.data, value=fn)
   } else {
     args = lst(...)
     unknowns = setdiff(names(args), names(.data))

tests/testthat/test-labels.R

@@ -83,14 +83,35 @@ test_that("Labelling nested lists (set)", {
   expect_setequal(get_label(xx, recursive=TRUE), "not foobar at all")
 })
 
+test_that("With a function", {
+  #with labels
+  l = mtcars2 %>% apply_labels(fn=toupper) %>% get_label()
+  l2 = mtcars2 %>% set_label(value=toupper) %>% get_label()
+  expect_identical(l, toupper(l))
+  expect_identical(l, l2)
+
+  #with names
+  l = mtcars %>% apply_labels(fn=toupper) %>% get_label()
+  l2 = mtcars %>% set_label(value=toupper) %>% get_label()
+  expect_identical(l, toupper(l))
+  expect_identical(l, l2)
+})
+
 test_that("Copying labels", {
   x = mtcars2 %>%
     mutate(mpg2=as.numeric(mpg)+1,
-           mpg3=copy_label_from(mpg2, mpg))
+           mpg3=copy_label_from(mpg2, mpg)) %>%
+    apply_labels(am="foobar")
   expect_null(get_label(x$mpg2))
   expect_equal(get_label(x$mpg3), "Miles/(US) gallon")
+
+  y = mtcars2 %>%
+    copy_label_from(x)
+  expect_equal(get_label(y$am), "foobar")
 })
 
+
+
 test_that("Removing labels", {
   x = mtcars2$mpg
   x2 = remove_label(mtcars2$mpg)