From fa770058baf231502bee98f90400481d05741f98 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Kirill=20M=C3=BCller?= <krlmlr+r@mailbox.org>
Date: Tue, 12 Jan 2021 10:39:39 +0100
Subject: [PATCH] vec_cast() and as_hms() throw error if input can't be parsed

---
 R/cast.R                       | 9 ++++-----
 tests/testthat/test-coercion.R | 2 +-
 tests/testthat/test-subset.R   | 3 +--
 3 files changed, 6 insertions(+), 8 deletions(-)

diff --git a/R/cast.R b/R/cast.R
index 0c8d329..c5e5f42 100644
--- a/R/cast.R
+++ b/R/cast.R
@@ -77,7 +77,7 @@ vec_cast.integer.hms <- function(x, to, ...) as.integer(vec_data(x))
 vec_cast.hms.character <- function(x, to, ...) {
   ret <- parse_hms(x)
   lossy <- is.na(ret) & !is.na(x)
-  warn_lossy_cast(x, to, ..., lossy = lossy)
+  abort_lossy_cast(x, to, ..., lossy = lossy)
   ret
 }
 
@@ -97,13 +97,12 @@ vec_default_cast_old <- function(x, to, ...) {
   }
 }
 
-warn_lossy_cast <- function(x, to, ..., lossy) {
+abort_lossy_cast <- function(x, to, ..., lossy) {
   problems <- which(lossy)
   if (is_empty(problems)) return()
 
-  warn(
-    paste0("Lossy cast from <character> to <hms> at position(s) ", commas(problems)),
-    .subclass = "hms_lossy_cast"
+  abort(
+    paste0("Lossy cast from <character> to <hms> at position(s) ", commas(problems))
   )
 }
 
diff --git a/tests/testthat/test-coercion.R b/tests/testthat/test-coercion.R
index ba9205d..9d41a9e 100644
--- a/tests/testthat/test-coercion.R
+++ b/tests/testthat/test-coercion.R
@@ -23,7 +23,7 @@ test_that("coercion in", {
   expect_error(as_hms(FALSE))
 
   x <- c("12:34:56", "ab:cd:ef")
-  expect_condition(hms::as_hms(x), class = "hms_lossy_cast")
+  expect_error(hms::as_hms(x))
 })
 
 test_that("coercion out", {
diff --git a/tests/testthat/test-subset.R b/tests/testthat/test-subset.R
index 97ab1ef..b708d80 100644
--- a/tests/testthat/test-subset.R
+++ b/tests/testthat/test-subset.R
@@ -19,8 +19,7 @@ test_that("range updating warns if lossy cast", {
 
   x <- hms(1:3)
 
-  # r-lib/testthat#783
-  expect_warning(x[2] <- "a")
+  expect_error(x[2] <- "a")
 })
 
 test_that("index subsetting keeps class", {