Restore original quo_name() behaviour

Use label() to create default names. Currently unexported.
Part of #636

Author: lionel-

R/expr.R

@@ -154,14 +154,45 @@ expr_label <- function(expr) {
 #' @rdname expr_label
 #' @export
 expr_name <- function(expr) {
-  switch(typeof(expr),
+  switch_type(expr,
     NULL = "NULL",
     symbol =
       if (is_missing(expr)) {
         "<empty>"
       } else {
         as_string(expr)
       },
+    quosure = ,
+    language =
+      if (is_data_pronoun(expr)) {
+        data_pronoun_name(expr) %||% "<unknown>"
+      } else {
+        name <- deparse_one(expr)
+        name <- gsub("\n.*$", "...", name)
+        name
+      },
+    if (is_scalar_atomic(expr)) {
+      # So 1L is translated to "1" and not "1L"
+      as.character(expr)
+    } else if (length(expr) == 1) {
+      name <- expr_text(expr)
+      name <- gsub("\n.*$", "...", name)
+      name
+    } else {
+      abort("`expr` must quote a symbol, scalar, or call")
+    }
+  )
+}
+label <- function(expr) {
+  expr <- quo_squash(expr)
+
+  if (is_missing(expr)) {
+    return("<empty>")
+  }
+
+  switch(typeof(expr),
+    NULL = "NULL",
+    symbol = as_string(expr),
     language = {
       if (is_data_pronoun(expr)) {
         data_pronoun_name(expr) %||% "<unknown>"

R/quo.R

@@ -398,21 +398,8 @@ quo_text <- function(quo, width = 60L, nlines = Inf) {
 #' @rdname quo_label
 #' @export
 quo_name <- function(quo) {
-  expr <- quo_squash(quo)
-  if (is_missing(expr)) {
-    return("<empty>")
-  }
-  if (quo_name_needs_compat &&
-        is_scalar_atomic(expr) &&
-        is_reference(env_parent(caller_env()), ns_env("tidyr"))) {
-    return(as.character(expr))
-  }
-  expr_name(expr)
+  expr_name(quo_squash(quo))
 }
-# COMPAT: tidyr 0.8.1
-delayedAssign("quo_name_needs_compat", {
-  is_installed("tidyr") && utils::packageVersion("tidyr") <= "0.8.1"
-})
 
 quo_squash_impl <- function(x, parent = NULL, warn = FALSE) {
   switch_expr(x,

R/quotation.R

@@ -425,11 +425,10 @@ exprs_auto_name <- function(exprs, width = NULL, printer = NULL) {
       "The `printer` argument is soft-deprecated as of rlang 0.3.0."
     ))
   }
-  printer <- quo_name
 
   have_name <- have_name(exprs)
   if (any(!have_name)) {
-    nms <- map_chr(exprs[!have_name], printer)
+    nms <- map_chr(exprs[!have_name], label)
     names(exprs)[!have_name] <- nms
   }
 

R/trace.R

@@ -596,9 +596,10 @@ trace_as_tree <- function(x, dir = getwd(), srcrefs = NULL) {
   tree
 }
 
+# FIXME: Add something like call_deparse_line()
 trace_call_text <- function(call, collapse) {
   if (is_null(collapse)) {
-    return(expr_name(call))
+    return(label(call))
   }
 
   if (is_call(call, "%>%")) {
@@ -607,7 +608,7 @@ trace_call_text <- function(call, collapse) {
     call <- call2(node_car(call), quote(...))
   }
 
-  text <- expr_name(call)
+  text <- label(call)
   if (collapse > 0L) {
     n_collapsed_text <- sprintf(" ... +%d", collapse)
   } else {

tests/testthat/test-deparse.R

@@ -318,6 +318,7 @@ test_that("needs_backticks() detects non-syntactic symbols", {
 test_that("expr_text() and expr_name() interpret unicode tags (#611)", {
   expect_identical(expr_text(quote(`<U+006F>`)), "o")
   expect_identical(expr_name(quote(`~f<U+006F><U+006F>`)), "~foo")
+  expect_identical(label(quote(`~f<U+006F><U+006F>`)), "~foo")
 })
 
 test_that("expr_text() deparses non-syntactic symbols with backticks (#211)", {
@@ -336,6 +337,7 @@ test_that("expr_name() deparses empty arguments", {
   expect_identical(expr_name(expr()), "<empty>")
   expect_identical(quo_name(quo()), "<empty>")
   expect_identical(names(quos_auto_name(quos(, ))), "<empty>")
+  expect_identical(label(expr()), "<empty>")
 })
 
 test_that("expr_deparse() handles newlines in strings (#484)", {
@@ -360,7 +362,9 @@ test_that("expr_deparse() handles ANSI escapes in strings", {
   expect_identical(expr_deparse("\\0"), deparse("\\0"))
 })
 
-test_that("expr_name() handles .data pronoun", {
+test_that("label() and expr_name() handles .data pronoun", {
   expect_identical(expr_name(quote(.data[["bar"]])), "bar")
   expect_identical(quo_name(quo(.data[["bar"]])), "bar")
+  expect_identical(label(quote(.data[["bar"]])), "bar")
+  expect_identical(label(quo(.data[["bar"]])), "bar")
 })

tests/testthat/test-expr.R

@@ -47,22 +47,35 @@ test_that("expr_label() truncates long calls", {
 
 # expr_name() --------------------------------------------------------
 
-test_that("name symbols, calls, and literals", {
+test_that("expr_name() with symbols, calls, and literals", {
   expect_identical(expr_name(quote(foo)), "foo")
   expect_identical(expr_name(quote(foo(bar))), "foo(bar)")
-  expect_identical(expr_name(1L), "1L")
-  expect_identical(expr_name("foo"), "\"foo\"")
+  expect_identical(expr_name(1L), "1")
+  expect_identical(expr_name("foo"), "foo")
   expect_identical(expr_name(function() NULL), "function () ...")
   expect_identical(expr_name(expr(function() { a; b })), "function() ...")
-  expect_identical(expr_name(1:2), "<int>")
-  expect_identical(expr_name(env()), "<env>")
+  expect_identical(expr_name(NULL), "NULL")
+  expect_error(expr_name(1:2), "must quote")
+  expect_error(expr_name(env()), "must quote")
 })
 
-test_that("supports special objects", {
-  expect_match(expr_name(quote(foo := bar)), ":=")
-  expect_identical(expr_name(quo(foo)), "~foo")
-  expect_identical(expr_name(~foo), "~foo")
-  expect_identical(expr_name(NULL), "NULL")
+test_that("label() with symbols, calls, and literals", {
+  expect_identical(label(quote(foo)), "foo")
+  expect_identical(label(quote(foo(bar))), "foo(bar)")
+  expect_identical(label(1L), "1L")
+  expect_identical(label("foo"), "\"foo\"")
+  expect_identical(label(function() NULL), "function () ...")
+  expect_identical(label(expr(function() { a; b })), "function() ...")
+  expect_identical(label(1:2), "<int>")
+  expect_identical(label(env()), "<env>")
+})
+
+test_that("label() supports special objects", {
+  expect_match(label(quote(foo := bar)), ":=")
+  expect_identical(label(quo(foo)), "foo")
+  expect_identical(label(quo(foo(!!quo(bar)))), "foo(bar)")
+  expect_identical(label(~foo), "~foo")
+  expect_identical(label(NULL), "NULL")
 })