diff --git a/NEWS.md b/NEWS.md index ec7d21b8..08fc04a6 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,7 @@ # tidyr (development version) +* Fixed an internal error in `pivot_wider()` (#1609, @krlmlr). + * The base pipe is now used throughout the documentation (#1613). * R >=4.1.0 is now required, in line with the [tidyverse diff --git a/R/pivot-wide.R b/R/pivot-wide.R index cdec75d7..591ac748 100644 --- a/R/pivot-wide.R +++ b/R/pivot-wide.R @@ -653,16 +653,17 @@ select_wider_id_cols <- function( rethrow_id_cols_oob <- function(cnd, names_from_cols, values_from_cols, call) { i <- cnd[["i"]] - check_string(i, .internal = TRUE) - - if (i %in% names_from_cols) { - stop_id_cols_oob(i, "names_from", call = call) - } else if (i %in% values_from_cols) { - stop_id_cols_oob(i, "values_from", call = call) - } else { - # Zap this special handler, throw the normal condition - zap() + if (is_string(i)) { + # Try to throw our custom error + if (i %in% names_from_cols) { + stop_id_cols_oob(i, "names_from", call = call) + } else if (i %in% values_from_cols) { + stop_id_cols_oob(i, "values_from", call = call) + } } + + # Otherwise fall through and throw standard tidyselect error + zap() } stop_id_cols_oob <- function(i, arg, call) { diff --git a/tests/testthat/_snaps/pivot-wide.md b/tests/testthat/_snaps/pivot-wide.md index 2658004c..cbaae558 100644 --- a/tests/testthat/_snaps/pivot-wide.md +++ b/tests/testthat/_snaps/pivot-wide.md @@ -111,6 +111,47 @@ x Problematic argument: * name_repair = "check_unique" +# doesn't crash when `id_cols` selects column removed by `names_from` (#1609) + + Code + pivot_wider(df, id_cols = x, values_from = y, names_from = x) + Condition + Error in `pivot_wider()`: + ! Can't select columns past the end. + i Locations 1, 100, 200, and 300 don't exist. + i There are only 0 columns. + +# doesn't crash when `id_cols` selects non-existent column (#1482) + + Code + pivot_wider(df, id_cols = c("non", "existent"), names_from = name, values_from = value) + Condition + Error in `pivot_wider()`: + ! Can't select columns that don't exist. + x Column `non` doesn't exist. + +--- + + Code + pivot_wider(df2, id_cols = all_of(c("a", "b", "c")), names_from = y, + values_from = z) + Condition + Error in `pivot_wider()`: + i In argument: `all_of(c("a", "b", "c"))`. + Caused by error in `all_of()`: + ! Can't subset elements that don't exist. + x Elements `a`, `b`, and `c` don't exist. + +--- + + Code + pivot_wider(df2, id_cols = 1:2, names_from = y, values_from = z) + Condition + Error in `pivot_wider()`: + ! Can't select columns past the end. + i Locations 1 and 2 don't exist. + i There are only 0 columns. + # `names_vary` is validated Code diff --git a/tests/testthat/test-pivot-wide.R b/tests/testthat/test-pivot-wide.R index 8d505634..2574d814 100644 --- a/tests/testthat/test-pivot-wide.R +++ b/tests/testthat/test-pivot-wide.R @@ -246,6 +246,60 @@ test_that("`pivot_wider_spec()` requires empty dots", { }) }) + +test_that("doesn't crash when `id_cols` selects column removed by `names_from` (#1609)", { + local_options(lifecycle_verbosity = "quiet") + + # Note how we have an "external vector" here. Ideally tidyselect would error + # on this, but for legacy reasons we currently allow it with a warning, and it + # produces a weird (but correct) tidyselect error + x <- c(1, 100, 200, 300) + + df <- tibble( + x = x, + y = c(1, 2, 3, 4) + ) + + # Should get tidyselect error, not internal error + expect_snapshot(error = TRUE, { + pivot_wider( + df, + id_cols = x, + values_from = y, + names_from = x + ) + }) +}) + +test_that("doesn't crash when `id_cols` selects non-existent column (#1482)", { + df <- tibble(name = c("x", "y"), value = c(1, 2)) + + # Should get tidyselect error, not internal error + expect_snapshot(error = TRUE, { + pivot_wider( + df, + id_cols = c("non", "existent"), + names_from = name, + values_from = value + ) + }) + + df2 <- tibble(y = c("a", "a", "b", "c"), z = c(21, 22, 23, 24)) + + expect_snapshot(error = TRUE, { + pivot_wider( + df2, + id_cols = all_of(c("a", "b", "c")), + names_from = y, + values_from = z + ) + }) + + expect_snapshot(error = TRUE, { + pivot_wider(df2, id_cols = 1:2, names_from = y, values_from = z) + }) +}) + # column names ------------------------------------------------------------- test_that("names_glue affects output names", {