Guard against loss of class (#567)

* Apply the "spec_tbl_df" class *after* `vroom_select()`

Avoid potential dispatch of a `[.spec_tbl_df` method that prematurely drops the subclass and spec and problems attributes

* No longer necessary to store / restore this

* Add tests

Author: jennybc

R/col_types.R

@@ -374,8 +374,6 @@ vroom_enquo <- function(x) {
 }
 
 vroom_select <- function(x, col_select, id) {
-  spec <- attr(x, "spec")
-
   # reorder and rename columns
   if (inherits(col_select, "quosures") || !quo_is_null(col_select)) {
     if (inherits(col_select, "quosures")) {
@@ -392,7 +390,6 @@ vroom_select <- function(x, col_select, id) {
     x <- x[vars]
     names(x) <- names(vars)
   }
-  attr(x, "spec") <- spec
   x
 }
 

R/vroom.R

@@ -292,9 +292,9 @@ vroom <- function(
   }
 
   out <- tibble::as_tibble(out, .name_repair = identity)
-  class(out) <- c("spec_tbl_df", class(out))
 
   out <- vroom_select(out, col_select, id)
+  class(out) <- c("spec_tbl_df", class(out))
 
   if (should_show_col_types(has_col_types, show_col_types)) {
     show_col_types(out, locale)

tests/testthat/test-vroom.R

@@ -1307,3 +1307,50 @@ test_that("vroom can read a datetime column with no data and skip 1", {
     equals = tibble::tibble(dt = as.POSIXct(character()))
   )
 })
+
+# https://github.com/tidyverse/vroom/issues/554
+# https://github.com/tidyverse/vroom/issues/534
+test_that("vroom(col_select =) output has 'spec_tbl_df' class, spec, and problems when readr is attached", {
+  # Register readr's [.spec_tbl_df method which drops attributes and the "spec_tbl_df" class
+  readr_single_bracket <- function(x, ...) {
+    attr(x, "spec") <- NULL
+    attr(x, "problems") <- NULL
+    class(x) <- setdiff(class(x), "spec_tbl_df")
+    NextMethod(`[`)
+  }
+  registerS3method("[", "spec_tbl_df", readr_single_bracket)
+
+  # Unfortunately you can't just de-register the method and
+  # local_mocked_s3_method() only works if method exists to begin with.
+  # We'll do next best thing which is to put a pass-through method back.
+  withr::defer({
+    registerS3method("[", "spec_tbl_df", function(x, ...) NextMethod(`[`))
+  })
+
+  expect_warning(
+    dat <- vroom(
+      I("a,b\n1,2\nz,3\n4,5"),
+      col_types = "dc",
+      col_select = c(a, b),
+      show_col_types = FALSE,
+      altrep = FALSE
+    ),
+    class = "vroom_parse_issue"
+  )
+
+  expect_s3_class(dat, "spec_tbl_df")
+  expect_equal(
+    attr(dat, "spec", exact = TRUE),
+    cols(
+      a = col_double(),
+      b = col_character(),
+      .delim = ","
+    )
+  )
+  expect_no_error(probs <- problems(dat))
+  if (exists("probs")) {
+    expect_equal(nrow(probs), 1)
+    expect_equal(probs$row, 3)
+    expect_equal(probs$col, 1)
+  }
+})

tests/testthat/test-vroom_fwf.R

@@ -468,3 +468,51 @@ test_that("vroom_fwf correctly reads DOS files with no trailing newline (https:/
 
   expect_equal(out, out2)
 })
+
+# https://github.com/tidyverse/vroom/issues/554
+# https://github.com/tidyverse/vroom/issues/534
+test_that("vroom_fwf(col_select =) output has 'spec_tbl_df' class, spec, and problems when readr is attached", {
+  # Register readr's [.spec_tbl_df method which drops attributes and the "spec_tbl_df" class
+  readr_single_bracket <- function(x, ...) {
+    attr(x, "spec") <- NULL
+    attr(x, "problems") <- NULL
+    class(x) <- setdiff(class(x), "spec_tbl_df")
+    NextMethod(`[`)
+  }
+  registerS3method("[", "spec_tbl_df", readr_single_bracket)
+
+  # Unfortunately you can't just de-register the method and
+  # local_mocked_s3_method() only works if method exists to begin with.
+  # We'll do next best thing which is to put a pass-through method back.
+  withr::defer({
+    registerS3method("[", "spec_tbl_df", function(x, ...) NextMethod(`[`))
+  })
+
+  expect_warning(
+    dat <- vroom_fwf(
+      I("a  b  \n1  2  \nz  3  \n4  5  "),
+      fwf_widths(c(3, 3)),
+      col_types = "dc",
+      col_select = c(X1, X2),
+      show_col_types = FALSE,
+      altrep = FALSE
+    ),
+    class = "vroom_parse_issue"
+  )
+
+  expect_s3_class(dat, "spec_tbl_df")
+  expect_equal(
+    attr(dat, "spec", exact = TRUE),
+    cols(
+      X1 = col_double(),
+      X2 = col_character(),
+      .delim = ""
+    )
+  )
+  expect_no_error(probs <- problems(dat))
+  if (exists("probs")) {
+    expect_equal(nrow(probs), 2)
+    expect_equal(probs$row, c(1, 2))
+    expect_equal(probs$col, c(1, 1))
+  }
+})