updates to clip testing

R/clipboard.R

@@ -51,6 +51,7 @@ write_clipboard <- function(x, ...) {
 #' @export
 #' @rdname clipboard
 write_clipboard.default <- function(x, ...) {
+  x <- as.character(x)
   clipr::write_clip(x, allow_non_interactive = TRUE)
 }
 
@@ -88,7 +89,7 @@ read_clipboard <- function(method = read_clipboard_methods(), ...) {
   fuj::require_namespace("clipr")
   switch(
     match_param(method),
-    default = type_convert2(clipr::read_clip(TRUE)),
+    default = type_convert2(clipr_read_clip(TRUE)),
     tibble = ,
     excel = ,
     calc = ,
@@ -113,6 +114,21 @@ read_clipboard <- function(method = read_clipboard_methods(), ...) {
   )
 }
 
+clipr_read_clip <- function(...) {
+  withCallingHandlers(
+    clipr::read_clip(...),
+    simpleWarning = function(e) {
+      if (grepl(
+        "System clipboard contained no readable text", 
+        conditionMessage(e),
+        fixed = TRUE
+      )) {
+       tryInvokeRestart("muffleWarning") 
+      }
+    }
+  )
+}
+
 #' @export
 #' @rdname clipboard
 read_clipboard_methods <- function() {
@@ -163,7 +179,7 @@ do_read_table_clipboard <- function(
     ...
 ) {
   res <- utils::read.table(
-    file = textConnection(clipr::read_clip(TRUE)),
+    file = textConnection(clipr_read_clip(TRUE)),
     header           = header,
     sep              = sep,
     row.names        = row.names,

tests/testthat/test-clipboard.R

@@ -1,6 +1,8 @@
 need_clipr <- function() {
   testthat::skip_if_not_installed("clipr")
-  testthat::skip_if_not(clipr::clipr_available(allow_non_interactive = TRUE))
+
+  # not sure if this is needed
+  # testthat::skip_if_not(clipr::clipr_available(allow_non_interactive = TRUE))
 }
 
 test_that("clipboard", {
@@ -16,8 +18,11 @@ test_that("clipboard", {
   test_clipboard(c(0.1234, -0.1586, 0.0001200))
   test_clipboard(-1:4)
   test_clipboard(as.Date("2020-01-02") + 0:4)
-  test_clipboard(runif(1e6))
+  test_clipboard(runif(1e4))
 
+  expect_error(clear_clipboard(), NA)
+  expect_equal(read_clipboard(), NULL) # previously ""
+
   x <- quick_dfl(
     var1 = 1:3,
     var2 = letters[1:3],
@@ -26,13 +31,14 @@ test_that("clipboard", {
   )
 
   expect_error(write_clipboard(x), NA)
-  expect_equal(read_clipboard("data.frame"), x)
-
-  expect_error(clear_clipboard(), NA)
-  expect_equal(read_clipboard(), NA) # previously ""
+  res <- read_clipboard("data.frame")
+  expect_s3_class(res, "data.frame")
+  if (package_available("tibble")) 
+  expect_equal(as.data.frame(res), x)
 
   # finally test tibble
   skip_if_not_installed("tibble")
+  expect_s3_class(res, "tbl_df")
   expect_equal(read_clipboard("tibble"), tibble::as_tibble(x))
 })
 

tests/testthat/test-strings.R

@@ -70,7 +70,6 @@ test_that("Extract dates", {
 })
 
 test_that("print_c()", {
-  skip_if_not(is_windows(), "mark::write_clipboard() needs to be updated")
   expect_equal(
     utils::capture.output(print_c(1:3)),
     c("c(", "1,", "2,", "3,", "NULL", ")")