Proper display of control characters (#589)

tidyverse · Feb 21, 2023 · 53dd647 · 53dd647
1 parent 6b0aa04
commit 53dd647
Show file tree

Hide file tree

Showing 4 changed files with 70 additions and 4 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -34,7 +34,8 @@ Suggests:
     knitr,
     pillar (>= 1.4.0),
     rmarkdown,
-    testthat (>= 3.0.0)
+    testthat (>= 3.0.0),
+    utf8
 LinkingTo: 
     cpp11
 VignetteBuilder: 

diff --git a/R/labelled-pillar.R b/R/labelled-pillar.R
@@ -101,7 +101,8 @@ lbl_pillar_info <- function(x) {
   MIN_LBL_DISPLAY <- 6
   labels <- attr(x, "labels")
   if (length(labels) > 0) {
-    names(labels) <- pillar::style_subtle(paste0(" [", names(labels), "]"))
+    encoded <- utf8::utf8_encode(names(labels))
+    names(labels) <- pillar::style_subtle(paste0(" [", encoded, "]"))
     attr(x, "labels") <- labels
     label_display <- as.character(as_factor(x, "labels"))
     label_display[is.na(label_display)] <- ""
@@ -203,6 +204,7 @@ paste_with_align <- function(x, y, lhs_ws, rhs_ws) {
 }
 
 pillar_print_pkgs_available <- function() {
-  requireNamespace("crayon", quietly = TRUE) &
-    requireNamespace("cli", quietly = TRUE)
+  requireNamespace("crayon", quietly = TRUE) &&
+    requireNamespace("cli", quietly = TRUE) &&
+    requireNamespace("utf8", quietly = TRUE)
 }
diff --git a/tests/testthat/_snaps/labelled-pillar.md b/tests/testthat/_snaps/labelled-pillar.md
@@ -123,3 +123,35 @@
       10 10 (NA) [Refused]
       11 NA               
 
+---
+
+    Code
+      x <- labelled(c("spaces", "tabs", "newlines", "c0", "quote", "backslash"), c(
+        `a b` = "spaces", `a\tb` = "tabs", `a\nb` = "newlines", `a\001b` = "c0",
+        `a"b` = "quote", `a\\b` = "backslash"))
+      tibble::tibble(x)
+    Output
+      # A tibble: 6 x 1
+        x               
+        <chr+lbl>       
+      1 spaces [a b]    
+      2 tabs [a\tb]     
+      3 newlines [a\nb] 
+      4 c0 [a\u0001b]   
+      5 quote [a"b]     
+      6 backslash [a\\b]
+
+---
+
+    Code
+      x <- "c1"
+      label <- x
+      names(label) <- "a\u0080b"
+      x <- labelled(x, label)
+      tibble::tibble(x)
+    Output
+      # A tibble: 1 x 1
+        x            
+        <chr+lbl>    
+      1 c1 [a\u0080b]
+
diff --git a/tests/testthat/test-labelled-pillar.R b/tests/testthat/test-labelled-pillar.R
@@ -46,4 +46,35 @@ test_that("pillar", {
     )
     tibble::tibble(x)
   })
+
+  expect_snapshot({
+    x <- labelled(
+      c(
+        "spaces",
+        "tabs",
+        "newlines",
+        "c0",
+        "quote",
+        "backslash"
+      ),
+      c(
+        "a b" = "spaces",
+        "a\tb" = "tabs",
+        "a\nb" = "newlines",
+        "a\u0001b" = "c0",
+        'a"b' = "quote",
+        "a\\b" = "backslash"
+      )
+    )
+    tibble::tibble(x)
+  })
+
+  skip_on_os("windows")
+  expect_snapshot({
+    x <- "c1"
+    label <- x
+    names(label) <- "a\u0080b"
+    x <- labelled(x, label)
+    tibble::tibble(x)
+  })
 })