From f25787cd26a8b4f5427ddd4764d51b2d876f5035 Mon Sep 17 00:00:00 2001 From: Jim Hester Date: Mon, 22 Nov 2021 11:40:23 -0500 Subject: [PATCH 1/8] Add support for show_col_types for edition 1 parser `read_table()` is one of the functions that currently doesn't have a vroom equivalent, so is still using the first edition parser. When we added support for `show_col_types` we didn't port that back to the first edition parser, so it was missing in `read_table()` and the `read_delim_chunked()` functions. Fixes #1331 --- NEWS.md | 1 + R/read_delim.R | 26 ++++++++++++++++++++------ R/read_delim_chunked.R | 25 ++++++++++++++++++------- R/read_log.R | 7 +++++-- R/read_table.R | 4 +++- 5 files changed, 47 insertions(+), 16 deletions(-) diff --git a/NEWS.md b/NEWS.md index 19f33e27..9ca4a2d7 100644 --- a/NEWS.md +++ b/NEWS.md @@ -4,6 +4,7 @@ * Jenny Bryan is now the maintainer. +* `read_table()` and edition 1 parsers gain support for `show_col_types()` (#1331) * Fix buffer overflow when trying to parse an integer from a field that is over 64 characters long (#1326) # readr 2.1.0 diff --git a/R/read_delim.R b/R/read_delim.R index 014030b2..df0c82cf 100644 --- a/R/read_delim.R +++ b/R/read_delim.R @@ -169,7 +169,8 @@ read_delim <- function(file, delim = NULL, quote = '"', return(read_delimited(file, tokenizer, col_names = col_names, col_types = col_types, locale = locale, skip = skip, skip_empty_rows = skip_empty_rows, - comment = comment, n_max = n_max, guess_max = guess_max, progress = progress + comment = comment, n_max = n_max, guess_max = guess_max, progress = progress, + show_col_types = show_col_types )) } if (!missing(quoted_na)) { @@ -230,7 +231,8 @@ read_csv <- function(file, read_delimited(file, tokenizer, col_names = col_names, col_types = col_types, locale = locale, skip = skip, skip_empty_rows = skip_empty_rows, - comment = comment, n_max = n_max, guess_max = guess_max, progress = progress + comment = comment, n_max = n_max, guess_max = guess_max, progress = progress, + show_col_types = show_col_types ) ) } @@ -300,7 +302,8 @@ read_csv2 <- function(file, return(read_delimited(file, tokenizer, col_names = col_names, col_types = col_types, locale = locale, skip = skip, skip_empty_rows = skip_empty_rows, - comment = comment, n_max = n_max, guess_max = guess_max, progress = progress + comment = comment, n_max = n_max, guess_max = guess_max, progress = progress, + show_col_types = show_col_types )) } vroom::vroom(file, @@ -349,7 +352,8 @@ read_tsv <- function(file, col_names = TRUE, col_types = NULL, return(read_delimited(file, tokenizer, col_names = col_names, col_types = col_types, locale = locale, skip = skip, skip_empty_rows = skip_empty_rows, - comment = comment, n_max = n_max, guess_max = guess_max, progress = progress + comment = comment, n_max = n_max, guess_max = guess_max, progress = progress, + show_col_types = show_col_types )) } @@ -386,9 +390,17 @@ read_tokens <- function(data, tokenizer, col_specs, col_names, locale_, n_max, p read_tokens_(data, tokenizer, col_specs, col_names, locale_, n_max, progress) } +should_show_col_types <- function(has_col_types, show_col_types) { + if (is.null(show_col_types)) { + return(isTRUE(!has_col_types)) + } + isTRUE(show_col_types) +} + read_delimited <- function(file, tokenizer, col_names = TRUE, col_types = NULL, locale = default_locale(), skip = 0, skip_empty_rows = TRUE, skip_quote = TRUE, - comment = "", n_max = Inf, guess_max = min(1000, n_max), progress = show_progress()) { + comment = "", n_max = Inf, guess_max = min(1000, n_max), progress = show_progress(), + show_col_types = should_show_col_types()) { name <- source_name(file) # If connection needed, read once. file <- standardise_path(file) @@ -420,7 +432,9 @@ read_delimited <- function(file, tokenizer, col_names = TRUE, col_types = NULL, ds <- datasource(data, skip = spec$skip, skip_empty_rows = skip_empty_rows, comment = comment, skip_quote = skip_quote) - if (is.null(col_types) && !inherits(ds, "source_string") && !is_testing()) { + has_col_types <- !is.null(col_types) + + if (((is.null(show_col_types) && !has_col_types) || isTRUE(show_col_types)) && !inherits(ds, "source_string") && !is_testing()) { show_cols_spec(spec) } diff --git a/R/read_delim_chunked.R b/R/read_delim_chunked.R index 63b2ce59..eed19895 100644 --- a/R/read_delim_chunked.R +++ b/R/read_delim_chunked.R @@ -68,6 +68,7 @@ read_delim_chunked <- function(file, callback, delim = NULL, chunk_size = 10000, comment = "", trim_ws = FALSE, skip = 0, guess_max = chunk_size, progress = show_progress(), + show_col_types = should_show_types(), skip_empty_rows = TRUE) { tokenizer <- tokenizer_delim(delim, quote = quote, @@ -79,7 +80,8 @@ read_delim_chunked <- function(file, callback, delim = NULL, chunk_size = 10000, callback = callback, chunk_size = chunk_size, tokenizer = tokenizer, col_names = col_names, col_types = col_types, locale = locale, skip = skip, skip_empty_rows = skip_empty_rows, comment = comment, guess_max = guess_max, - progress = progress + progress = progress, + show_col_types = show_col_types ) } @@ -89,7 +91,9 @@ read_csv_chunked <- function(file, callback, chunk_size = 10000, col_names = TRU locale = default_locale(), na = c("", "NA"), quoted_na = TRUE, quote = "\"", comment = "", trim_ws = TRUE, skip = 0, guess_max = chunk_size, - progress = show_progress(), skip_empty_rows = TRUE) { + progress = show_progress(), + show_col_types = should_show_types(), + skip_empty_rows = TRUE) { tokenizer <- tokenizer_csv( na = na, quoted_na = quoted_na, quote = quote, comment = comment, trim_ws = trim_ws, skip_empty_rows = skip_empty_rows @@ -98,7 +102,8 @@ read_csv_chunked <- function(file, callback, chunk_size = 10000, col_names = TRU callback = callback, chunk_size = chunk_size, tokenizer = tokenizer, col_names = col_names, col_types = col_types, locale = locale, skip = skip, skip_empty_rows = skip_empty_rows, comment = comment, - guess_max = guess_max, progress = progress + guess_max = guess_max, progress = progress, + show_col_types = show_col_types ) } @@ -108,7 +113,9 @@ read_csv2_chunked <- function(file, callback, chunk_size = 10000, col_names = TR locale = default_locale(), na = c("", "NA"), quoted_na = TRUE, quote = "\"", comment = "", trim_ws = TRUE, skip = 0, guess_max = chunk_size, - progress = show_progress(), skip_empty_rows = TRUE) { + progress = show_progress(), + show_col_types = should_show_types(), + skip_empty_rows = TRUE) { tokenizer <- tokenizer_delim( delim = ";", na = na, quoted_na = quoted_na, quote = quote, comment = comment, trim_ws = trim_ws, @@ -118,7 +125,8 @@ read_csv2_chunked <- function(file, callback, chunk_size = 10000, col_names = TR callback = callback, chunk_size = chunk_size, tokenizer = tokenizer, col_names = col_names, col_types = col_types, locale = locale, skip = skip, skip_empty_rows = skip_empty_rows, comment = comment, - guess_max = guess_max, progress = progress + guess_max = guess_max, progress = progress, + show_col_types = show_col_types ) } @@ -128,7 +136,9 @@ read_tsv_chunked <- function(file, callback, chunk_size = 10000, col_names = TRU locale = default_locale(), na = c("", "NA"), quoted_na = TRUE, quote = "\"", comment = "", trim_ws = TRUE, skip = 0, guess_max = chunk_size, - progress = show_progress(), skip_empty_rows = TRUE) { + progress = show_progress(), + show_col_types = should_show_types(), + skip_empty_rows = TRUE) { tokenizer <- tokenizer_tsv( na = na, quoted_na = quoted_na, quote = quote, comment = comment, trim_ws = trim_ws, skip_empty_rows = skip_empty_rows @@ -137,6 +147,7 @@ read_tsv_chunked <- function(file, callback, chunk_size = 10000, col_names = TRU callback = callback, chunk_size = chunk_size, tokenizer = tokenizer, col_names = col_names, col_types = col_types, locale = locale, skip = skip, skip_empty_rows = skip_empty_rows, comment = comment, - guess_max = guess_max, progress = progress + guess_max = guess_max, progress = progress, + show_col_types = show_col_types ) } diff --git a/R/read_log.R b/R/read_log.R index 691f5506..c75364e8 100644 --- a/R/read_log.R +++ b/R/read_log.R @@ -10,10 +10,13 @@ #' read_log(readr_example("example.log")) read_log <- function(file, col_names = FALSE, col_types = NULL, trim_ws = TRUE, - skip = 0, n_max = Inf, progress = show_progress()) { + skip = 0, n_max = Inf, + show_col_types = should_show_types(), + progress = show_progress()) { tokenizer <- tokenizer_log(trim_ws = trim_ws) read_delimited(file, tokenizer, col_names = col_names, col_types = col_types, - skip = skip, n_max = n_max, progress = progress + skip = skip, n_max = n_max, progress = progress, + show_col_types = show_col_types ) } diff --git a/R/read_table.R b/R/read_table.R index ca546b55..078417cd 100644 --- a/R/read_table.R +++ b/R/read_table.R @@ -34,6 +34,7 @@ read_table <- function(file, col_names = TRUE, col_types = NULL, locale = default_locale(), na = "NA", skip = 0, n_max = Inf, guess_max = min(n_max, 1000), progress = show_progress(), comment = "", + show_col_types = should_show_types(), skip_empty_rows = TRUE) { tokenizer <- tokenizer_ws( na = na, comment = comment, @@ -42,7 +43,8 @@ read_table <- function(file, col_names = TRUE, col_types = NULL, read_delimited(file, tokenizer, col_names = col_names, col_types = col_types, locale = locale, skip = skip, skip_empty_rows = skip_empty_rows, - skip_quote = FALSE, comment = comment, n_max = n_max, guess_max = guess_max, progress = progress + skip_quote = FALSE, comment = comment, n_max = n_max, guess_max = guess_max, progress = progress, + show_col_types = show_col_types ) } From bf256d114e0b82ee4f181400e65f4cf2b852ee53 Mon Sep 17 00:00:00 2001 From: Jim Hester Date: Mon, 22 Nov 2021 11:46:15 -0500 Subject: [PATCH 2/8] Remove should_show_col_types This is the helper we use in vroom, but I think having it in readr would be too confusing because we already have should_show_types --- R/read_delim.R | 7 ------- 1 file changed, 7 deletions(-) diff --git a/R/read_delim.R b/R/read_delim.R index df0c82cf..87406601 100644 --- a/R/read_delim.R +++ b/R/read_delim.R @@ -390,13 +390,6 @@ read_tokens <- function(data, tokenizer, col_specs, col_names, locale_, n_max, p read_tokens_(data, tokenizer, col_specs, col_names, locale_, n_max, progress) } -should_show_col_types <- function(has_col_types, show_col_types) { - if (is.null(show_col_types)) { - return(isTRUE(!has_col_types)) - } - isTRUE(show_col_types) -} - read_delimited <- function(file, tokenizer, col_names = TRUE, col_types = NULL, locale = default_locale(), skip = 0, skip_empty_rows = TRUE, skip_quote = TRUE, comment = "", n_max = Inf, guess_max = min(1000, n_max), progress = show_progress(), From 25b832ccd0dd112ce893da4ac4e4da11a7b55fec Mon Sep 17 00:00:00 2001 From: "Jennifer (Jenny) Bryan" Date: Tue, 23 Nov 2021 16:51:37 -0800 Subject: [PATCH 3/8] Correct function name --- R/read_delim.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/read_delim.R b/R/read_delim.R index 87406601..c296608e 100644 --- a/R/read_delim.R +++ b/R/read_delim.R @@ -393,7 +393,7 @@ read_tokens <- function(data, tokenizer, col_specs, col_names, locale_, n_max, p read_delimited <- function(file, tokenizer, col_names = TRUE, col_types = NULL, locale = default_locale(), skip = 0, skip_empty_rows = TRUE, skip_quote = TRUE, comment = "", n_max = Inf, guess_max = min(1000, n_max), progress = show_progress(), - show_col_types = should_show_col_types()) { + show_col_types = should_show_types()) { name <- source_name(file) # If connection needed, read once. file <- standardise_path(file) From 0e0b64ff7704affa8d0a4ed08da7a4838f00592e Mon Sep 17 00:00:00 2001 From: Jenny Bryan Date: Tue, 23 Nov 2021 18:17:15 -0800 Subject: [PATCH 4/8] document() --- man/read_delim_chunked.Rd | 9 +++++++++ man/read_log.Rd | 6 ++++++ man/read_table.Rd | 6 ++++++ man/spec_delim.Rd | 1 + 4 files changed, 22 insertions(+) diff --git a/man/read_delim_chunked.Rd b/man/read_delim_chunked.Rd index 47c215ec..fcfe1149 100644 --- a/man/read_delim_chunked.Rd +++ b/man/read_delim_chunked.Rd @@ -25,6 +25,7 @@ read_delim_chunked( skip = 0, guess_max = chunk_size, progress = show_progress(), + show_col_types = should_show_types(), skip_empty_rows = TRUE ) @@ -43,6 +44,7 @@ read_csv_chunked( skip = 0, guess_max = chunk_size, progress = show_progress(), + show_col_types = should_show_types(), skip_empty_rows = TRUE ) @@ -61,6 +63,7 @@ read_csv2_chunked( skip = 0, guess_max = chunk_size, progress = show_progress(), + show_col_types = should_show_types(), skip_empty_rows = TRUE ) @@ -79,6 +82,7 @@ read_tsv_chunked( skip = 0, guess_max = chunk_size, progress = show_progress(), + show_col_types = should_show_types(), skip_empty_rows = TRUE ) } @@ -192,6 +196,11 @@ in an interactive session and not while knitting a document. The automatic progress bar can be disabled by setting option \code{readr.show_progress} to \code{FALSE}.} +\item{show_col_types}{If \code{FALSE}, do not show the guessed column types. If +\code{TRUE} always show the column types, even if they are supplied. If \code{NULL} +(the default) only show the column types if they are not explicitly supplied +by the \code{col_types} argument.} + \item{skip_empty_rows}{Should blank rows be ignored altogether? i.e. If this option is \code{TRUE} then blank rows will not be represented at all. If it is \code{FALSE} then they will be represented by \code{NA} values in all the columns.} diff --git a/man/read_log.Rd b/man/read_log.Rd index 72b2bdf2..10ede013 100644 --- a/man/read_log.Rd +++ b/man/read_log.Rd @@ -11,6 +11,7 @@ read_log( trim_ws = TRUE, skip = 0, n_max = Inf, + show_col_types = should_show_types(), progress = show_progress() ) } @@ -87,6 +88,11 @@ supplied any commented lines are ignored \emph{after} skipping.} \item{n_max}{Maximum number of lines to read.} +\item{show_col_types}{If \code{FALSE}, do not show the guessed column types. If +\code{TRUE} always show the column types, even if they are supplied. If \code{NULL} +(the default) only show the column types if they are not explicitly supplied +by the \code{col_types} argument.} + \item{progress}{Display a progress bar? By default it will only display in an interactive session and not while knitting a document. The automatic progress bar can be disabled by setting option \code{readr.show_progress} to diff --git a/man/read_table.Rd b/man/read_table.Rd index 60b03c43..45ae32ad 100644 --- a/man/read_table.Rd +++ b/man/read_table.Rd @@ -15,6 +15,7 @@ read_table( guess_max = min(n_max, 1000), progress = show_progress(), comment = "", + show_col_types = should_show_types(), skip_empty_rows = TRUE ) } @@ -106,6 +107,11 @@ progress bar can be disabled by setting option \code{readr.show_progress} to \item{comment}{A string used to identify comments. Any text after the comment characters will be silently ignored.} +\item{show_col_types}{If \code{FALSE}, do not show the guessed column types. If +\code{TRUE} always show the column types, even if they are supplied. If \code{NULL} +(the default) only show the column types if they are not explicitly supplied +by the \code{col_types} argument.} + \item{skip_empty_rows}{Should blank rows be ignored altogether? i.e. If this option is \code{TRUE} then blank rows will not be represented at all. If it is \code{FALSE} then they will be represented by \code{NA} values in all the columns.} diff --git a/man/spec_delim.Rd b/man/spec_delim.Rd index 41fe90d0..2a3097af 100644 --- a/man/spec_delim.Rd +++ b/man/spec_delim.Rd @@ -114,6 +114,7 @@ spec_table( guess_max = 1000, progress = show_progress(), comment = "", + show_col_types = should_show_types(), skip_empty_rows = TRUE ) } From 1b12731365cb49ba50122b4fdb74fe7913b3ff11 Mon Sep 17 00:00:00 2001 From: "Jennifer (Jenny) Bryan" Date: Tue, 23 Nov 2021 18:20:59 -0800 Subject: [PATCH 5/8] Update NEWS.md --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index 9ca4a2d7..968f2da5 100644 --- a/NEWS.md +++ b/NEWS.md @@ -5,6 +5,7 @@ * Jenny Bryan is now the maintainer. * `read_table()` and edition 1 parsers gain support for `show_col_types()` (#1331) +* `read_table()`, `read_log()`, and `read_delim_chunked()` (and friends) gain the `show_col_types` argument found elsewhere. All `read_*()` functions now respect the `show_col_types` argument or option even when using the first edition parsing engine (#1331). * Fix buffer overflow when trying to parse an integer from a field that is over 64 characters long (#1326) # readr 2.1.0 From e592c7d95469881f2501686bf6e652aa77fad627 Mon Sep 17 00:00:00 2001 From: Jenny Bryan Date: Tue, 30 Nov 2021 11:57:01 -0800 Subject: [PATCH 6/8] Reformat for readability --- R/read_delim.R | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/R/read_delim.R b/R/read_delim.R index c296608e..14d6268c 100644 --- a/R/read_delim.R +++ b/R/read_delim.R @@ -427,7 +427,10 @@ read_delimited <- function(file, tokenizer, col_names = TRUE, col_types = NULL, has_col_types <- !is.null(col_types) - if (((is.null(show_col_types) && !has_col_types) || isTRUE(show_col_types)) && !inherits(ds, "source_string") && !is_testing()) { + if ( + ((is.null(show_col_types) && !has_col_types) || isTRUE(show_col_types)) && + !inherits(ds, "source_string") + ) { show_cols_spec(spec) } From cec9413b20b3b1c2851d86253b125e20d6c2d3ca Mon Sep 17 00:00:00 2001 From: Jenny Bryan Date: Tue, 30 Nov 2021 11:57:44 -0800 Subject: [PATCH 7/8] Refactor should_show_types(); add tests --- R/utils.R | 18 +++++++-- man/should_show_types.Rd | 11 ++++-- tests/testthat/_snaps/edition-1/col-spec.md | 42 +++++++++++++++++++++ tests/testthat/_snaps/edition-2/col-spec.md | 28 ++++++++++++++ tests/testthat/setup.R | 1 - tests/testthat/test-col-spec.R | 29 +++++++------- 6 files changed, 106 insertions(+), 23 deletions(-) create mode 100644 tests/testthat/_snaps/edition-1/col-spec.md create mode 100644 tests/testthat/_snaps/edition-2/col-spec.md diff --git a/R/utils.R b/R/utils.R index eb974616..735ca9db 100644 --- a/R/utils.R +++ b/R/utils.R @@ -27,12 +27,22 @@ show_progress <- function() { #' Determine whether column types should be shown #' -#' Column types are shown unless -#' - They are disabled by setting `options(readr.show_col_types = FALSE)` -#' - The column types are supplied with the `col_types` argument. +#' Wrapper around `getOption("readr.show_col_types")` that implements some fall +#' back logic if the option is unset. This returns: +#' * `TRUE` if the option is set to `TRUE` +#' * `FALSE` if the option is set to `FALSE` +#' * `FALSE` if the option is unset and we appear to be running tests +#' * `NULL` otherwise, in which case the caller determines whether to show +#' column types based on context, e.g. whether `show_col_types` or actual +#' `col_types` were explicitly specified #' @export should_show_types <- function() { - if (identical(getOption("readr.show_col_types", TRUE), FALSE)) { + opt <- getOption("readr.show_col_types", NA) + if (isTRUE(opt)) { + TRUE + } else if (identical(opt, FALSE)) { + FALSE + } else if (is.na(opt) && is_testing()) { FALSE } else { NULL diff --git a/man/should_show_types.Rd b/man/should_show_types.Rd index e9b36d96..bd995c95 100644 --- a/man/should_show_types.Rd +++ b/man/should_show_types.Rd @@ -7,9 +7,14 @@ should_show_types() } \description{ -Column types are shown unless +Wrapper around \code{getOption("readr.show_col_types")} that implements some fall +back logic if the option is unset. This returns: \itemize{ -\item They are disabled by setting \code{options(readr.show_col_types = FALSE)} -\item The column types are supplied with the \code{col_types} argument. +\item \code{TRUE} if the option is set to \code{TRUE} +\item \code{FALSE} if the option is set to \code{FALSE} +\item \code{FALSE} if the option is unset and we appear to be running tests +\item \code{NULL} otherwise, in which case the caller determines whether to show +column types based on context, e.g. whether \code{show_col_types} or actual +\code{col_types} were explicitly specified } } diff --git a/tests/testthat/_snaps/edition-1/col-spec.md b/tests/testthat/_snaps/edition-1/col-spec.md new file mode 100644 index 00000000..0c8ad674 --- /dev/null +++ b/tests/testthat/_snaps/edition-1/col-spec.md @@ -0,0 +1,42 @@ +# options(readr.show_col_spec) controls column specifications + + Code + out <- read_csv(readr_example("mtcars.csv")) + Message + + -- Column specification -------------------------------------------------------- + cols( + mpg = col_double(), + cyl = col_double(), + disp = col_double(), + hp = col_double(), + drat = col_double(), + wt = col_double(), + qsec = col_double(), + vs = col_double(), + am = col_double(), + gear = col_double(), + carb = col_double() + ) + +# `show_col_types` controls column specification + + Code + out <- read_csv(readr_example("mtcars.csv"), show_col_types = TRUE) + Message + + -- Column specification -------------------------------------------------------- + cols( + mpg = col_double(), + cyl = col_double(), + disp = col_double(), + hp = col_double(), + drat = col_double(), + wt = col_double(), + qsec = col_double(), + vs = col_double(), + am = col_double(), + gear = col_double(), + carb = col_double() + ) + diff --git a/tests/testthat/_snaps/edition-2/col-spec.md b/tests/testthat/_snaps/edition-2/col-spec.md new file mode 100644 index 00000000..f541714f --- /dev/null +++ b/tests/testthat/_snaps/edition-2/col-spec.md @@ -0,0 +1,28 @@ +# options(readr.show_col_spec) controls column specifications + + Code + out <- read_csv(readr_example("mtcars.csv")) + Message + Rows: 32 Columns: 11 + Message + -- Column specification -------------------------------------------------------- + Delimiter: "," + dbl (11): mpg, cyl, disp, hp, drat, wt, qsec, vs, am, gear, carb + + i Use `spec()` to retrieve the full column specification for this data. + i Specify the column types or set `show_col_types = FALSE` to quiet this message. + +# `show_col_types` controls column specification + + Code + out <- read_csv(readr_example("mtcars.csv"), show_col_types = TRUE) + Message + Rows: 32 Columns: 11 + Message + -- Column specification -------------------------------------------------------- + Delimiter: "," + dbl (11): mpg, cyl, disp, hp, drat, wt, qsec, vs, am, gear, carb + + i Use `spec()` to retrieve the full column specification for this data. + i Specify the column types or set `show_col_types = FALSE` to quiet this message. + diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R index 6d8c34d0..8418daf0 100644 --- a/tests/testthat/setup.R +++ b/tests/testthat/setup.R @@ -1,4 +1,3 @@ pre_test_options <- options( - readr.show_col_types = FALSE, readr.show_progress = FALSE ) diff --git a/tests/testthat/test-col-spec.R b/tests/testthat/test-col-spec.R index 7722e5d2..2b333839 100644 --- a/tests/testthat/test-col-spec.R +++ b/tests/testthat/test-col-spec.R @@ -137,7 +137,6 @@ test_that("spec object attached to read data", { ) }) - test_that("print(col_spec) works with dates", { out <- col_spec_standardise("a,b,c\n", col_types = cols( @@ -317,21 +316,21 @@ test_that("as.character() works on col_spec objects", { expect_equal(as.character(spec), "ddddf") }) -test_that("options(readr.show_col_spec) can turn off showing column specifications", { - skip_if_edition_first() - - old <- options("readr.show_col_types") - on.exit(options(old)) - - options(readr.show_col_types = NULL) - expect_message( - expect_message( - expect_message( - read_csv(readr_example("mtcars.csv")) - ) - ) +test_that("options(readr.show_col_spec) controls column specifications", { + withr::local_options(list(readr.show_col_types = TRUE)) + expect_snapshot( + out <- read_csv(readr_example("mtcars.csv")), + variant = edition_variant() ) - options(readr.show_col_types = FALSE) + withr::local_options(list(readr.show_col_types = FALSE)) expect_silent(read_csv(readr_example("mtcars.csv"))) }) + +test_that("`show_col_types` controls column specification", { + expect_snapshot( + out <- read_csv(readr_example("mtcars.csv"), show_col_types = TRUE), + variant = edition_variant() + ) + expect_silent(read_csv(readr_example("mtcars.csv"), show_col_types = FALSE)) +}) From 63a2da4b7983810e40efae17afa97ba536faacee Mon Sep 17 00:00:00 2001 From: Jenny Bryan Date: Tue, 30 Nov 2021 12:07:46 -0800 Subject: [PATCH 8/8] Move NEWS bullet --- NEWS.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/NEWS.md b/NEWS.md index 968f2da5..98072b3b 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,11 +1,11 @@ # readr (development version) +* `read_table()`, `read_log()`, and `read_delim_chunked()` (and friends) gain the `show_col_types` argument found elsewhere. All `read_*()` functions now respect the `show_col_types` argument or option even when using the first edition parsing engine (#1331). + # readr 2.1.1 * Jenny Bryan is now the maintainer. -* `read_table()` and edition 1 parsers gain support for `show_col_types()` (#1331) -* `read_table()`, `read_log()`, and `read_delim_chunked()` (and friends) gain the `show_col_types` argument found elsewhere. All `read_*()` functions now respect the `show_col_types` argument or option even when using the first edition parsing engine (#1331). * Fix buffer overflow when trying to parse an integer from a field that is over 64 characters long (#1326) # readr 2.1.0