Merge pull request #72 from r-lib/call-in-coerce-functions

Add call argument in coerce functions

NEWS.md

@@ -4,6 +4,8 @@
 
 * Fixed bug where `coerce_to_sparse_data_frame()` and `coerce_to_sparse_tibble()` didn't work with matrices with fully sparse columns. (#69)
 
+* All coerce functions have received a `call` argument. (#72)
+
 # sparsevctrs 0.1.0
 
 * Initial CRAN submission.

R/coerce.R

@@ -4,6 +4,7 @@
 #' [Matrix::sparseMatrix()].
 #' 
 #' @param x a data frame or tibble with sparse columns.
+#' @inheritParams rlang::args_error_context
 #'
 #' @details
 #' No checking is currently do to `x` to determine whether it contains sparse
@@ -22,22 +23,26 @@
 #' res <- coerce_to_sparse_matrix(sparse_tbl)
 #' res
 #' @export
-coerce_to_sparse_matrix <- function(x) {
+coerce_to_sparse_matrix <- function(x, call = rlang::caller_env(0)) {
   rlang::check_installed("Matrix")
 
   if (!inherits(x, "data.frame")) {
     cli::cli_abort(
-      "{.arg x} must be a {.cls data.frame}, not {.obj_type_friendly {x}}."
+      "{.arg x} must be a {.cls data.frame}, not {.obj_type_friendly {x}}.",
+      call = call
     )
   }
 
   if (!all(vapply(x, is.numeric, logical(1)))) {
     offenders <- which(!vapply(x, is.numeric, logical(1)))
     offenders <- names(x)[offenders]
-    cli::cli_abort(c(
-      x = "All columns of {.arg x} must be numeric.",
-      i = "Non-numeric columns: {.field {offenders}}."
-    ))
+    cli::cli_abort(
+      c(
+        x = "All columns of {.arg x} must be numeric.",
+        i = "Non-numeric columns: {.field {offenders}}."
+      ),
+      call = call
+    )
   }
 
   if (!any(vapply(x, is_sparse_numeric, logical(1)))) {
@@ -76,6 +81,7 @@ coerce_to_sparse_matrix <- function(x) {
 #' Turning a sparse matrix into a tibble.
 #' 
 #' @param x sparse matrix. 
+#' @inheritParams rlang::args_error_context
 #' 
 #' @details
 #' The only requirement from the sparse matrix is that it contains column names.
@@ -96,12 +102,13 @@ coerce_to_sparse_matrix <- function(x) {
 #' # All columns are sparse
 #' vapply(res, is_sparse_vector, logical(1))
 #' @export
-coerce_to_sparse_tibble <- function(x) {
+coerce_to_sparse_tibble <- function(x, call = rlang::caller_env(0)) {
   rlang::check_installed("tibble")
 
   if (!any(methods::is(x) == "sparseMatrix")) {
     cli::cli_abort(
-      "{.arg x} must be a {.cls sparseMatrix}, not {.obj_type_friendly {x}}."
+      "{.arg x} must be a {.cls sparseMatrix}, not {.obj_type_friendly {x}}.",
+      call = call
     )
   }
 
@@ -112,7 +119,8 @@ coerce_to_sparse_tibble <- function(x) {
 
   if (is.null(colnames(x))) {
     cli::cli_abort(
-      "{.arg x} must have column names."
+      "{.arg x} must have column names.",
+      call = call
     )
   }
 
@@ -126,6 +134,7 @@ coerce_to_sparse_tibble <- function(x) {
 #' Turning a sparse matrix into a data frame
 #' 
 #' @param x sparse matrix. 
+#' @inheritParams rlang::args_error_context
 #' 
 #' @details
 #' The only requirement from the sparse matrix is that it contains column names.
@@ -146,10 +155,11 @@ coerce_to_sparse_tibble <- function(x) {
 #' # All columns are sparse
 #' vapply(res, is_sparse_vector, logical(1))
 #' @export
-coerce_to_sparse_data_frame <- function(x) {
+coerce_to_sparse_data_frame <- function(x, call = rlang::caller_env(0)) {
   if (!any(methods::is(x) == "sparseMatrix")) {
     cli::cli_abort(
-      "{.arg x} must be a {.cls sparseMatrix}, not {.obj_type_friendly {x}}."
+      "{.arg x} must be a {.cls sparseMatrix}, not {.obj_type_friendly {x}}.",
+      call = call
     )
   }
 
@@ -160,7 +170,8 @@ coerce_to_sparse_data_frame <- function(x) {
 
   if (is.null(colnames(x))) {
     cli::cli_abort(
-      "{.arg x} must have column names."
+      "{.arg x} must have column names.",
+      call = call
     )
   }
 

tests/testthat/_snaps/coerce.md

@@ -31,6 +31,22 @@
       sparsevctrs: Sparse vector materialized
       sparsevctrs: Sparse vector materialized
 
+# coerce_to_sparse_matrix() can pass through error call
+
+    Code
+      tmp_fun(1)
+    Condition
+      Error in `tmp_fun()`:
+      ! `x` must be a <data.frame>, not a number.
+
+---
+
+    Code
+      tmp_fun(1)
+    Condition
+      Error in `tmp_fun()`:
+      ! `x` must be a <sparseMatrix>, not a number.
+
 # coerce_to_sparse_data_frame() errors with no column names
 
     Code
@@ -55,6 +71,14 @@
       Error in `coerce_to_sparse_data_frame()`:
       ! `x` must be a <sparseMatrix>, not an integer vector.
 
+# coerce_to_sparse_data_frame() can pass through error call
+
+    Code
+      tmp_fun(1)
+    Condition
+      Error in `tmp_fun()`:
+      ! `x` must be a <sparseMatrix>, not a number.
+
 # coerce_to_sparse_tibble() errors with no column names
 
     Code

tests/testthat/test-coerce.R

@@ -79,6 +79,17 @@ test_that("coerce_to_sparse_matrix() materializes non-zero defaulted columns", {
   expect_identical(res, exp)
 })
 
+test_that("coerce_to_sparse_matrix() can pass through error call", {
+  tmp_fun <- function(x) {
+    coerce_to_sparse_matrix(x, call = rlang::caller_env(0))
+  }
+
+  expect_snapshot(
+    error = TRUE,
+    tmp_fun(1)
+  )
+})
+
 ### coerce_to_sparse_data_frame ------------------------------------------------
 
 test_that("coerce_to_sparse_data_frame() works", {
@@ -140,6 +151,17 @@ test_that("coerce_to_sparse_data_frame() errors with wrong input", {
   )
 })
 
+test_that("coerce_to_sparse_data_frame() can pass through error call", {
+  tmp_fun <- function(x) {
+    coerce_to_sparse_data_frame(x, call = rlang::caller_env(0))
+  }
+
+  expect_snapshot(
+    error = TRUE,
+    tmp_fun(1)
+  )
+})
+
 ### coerce_to_sparse_tibble ----------------------------------------------------
 
 test_that("coerce_to_sparse_tibble() works", {
@@ -204,6 +226,19 @@ test_that("coerce_to_sparse_tibble() errors with wrong input", {
   )
 })
 
+test_that("coerce_to_sparse_matrix() can pass through error call", {
+  tmp_fun <- function(x) {
+    coerce_to_sparse_tibble(x, call = rlang::caller_env(0))
+  }
+
+  expect_snapshot(
+    error = TRUE,
+    tmp_fun(1)
+  )
+})
+
+### .sparse_matrix_to_list -----------------------------------------------------
+
 test_that(".sparse_matrix_to_list() handles fully sparse columns (#69)", {
   skip_if_not_installed("Matrix")
 
@@ -220,4 +255,4 @@ test_that(".sparse_matrix_to_list() handles fully sparse columns (#69)", {
     coerce_to_sparse_data_frame(x_mat_sparse),
     x_df
   )
-})
+})