Improve coverage

DESCRIPTION

@@ -21,6 +21,7 @@ Imports:
     Rcpp
 Suggests:
     testthat,
+    withr,
     knitr,
     rmarkdown,
     Lahman (>= 3.0.1),

R/type-sum.r

@@ -16,9 +16,10 @@
 #' obj_sum(mean)
 #' @export
 obj_sum <- function(x) UseMethod("obj_sum")
+
 #' @export
 obj_sum.default <- function(x) {
-  paste0(type_sum(x), if (is_vector_s3(x)) size_sum(x))
+  paste0(type_sum(x), size_sum(x))
 }
 
 #' @export
@@ -54,7 +55,7 @@ type_sum.default <- function(x) {
 }
 
 size_sum <- function(x) {
-  if (!is_vector(x)) return("")
+  if (!is_vector_s3(x)) return("")
 
   dim <- dim(x) %||% length(x)
   paste0(" [", paste0(dim, collapse = ","), "]" )

tests/testthat/output/glimpse/iris-empty-70.txt

@@ -0,0 +1 @@
+Observations: 150

tests/testthat/output/trunc_mat/iris--70.txt

@@ -0,0 +1,15 @@
+Source: local data frame [150 x 5]
+
+   Sepal.Length Sepal.Width Petal.Length Petal.Width Species
+          <dbl>       <dbl>        <dbl>       <dbl>  <fctr>
+1           5.1         3.5          1.4         0.2  setosa
+2           4.9         3.0          1.4         0.2  setosa
+3           4.7         3.2          1.3         0.2  setosa
+4           4.6         3.1          1.5         0.2  setosa
+5           5.0         3.6          1.4         0.2  setosa
+6           5.4         3.9          1.7         0.4  setosa
+7           4.6         3.4          1.4         0.3  setosa
+8           5.0         3.4          1.5         0.2  setosa
+9           4.4         2.9          1.4         0.2  setosa
+10          4.9         3.1          1.5         0.1  setosa
+..          ...         ...          ...         ...     ...

tests/testthat/output/trunc_mat/knit-120.txt

@@ -0,0 +1,5 @@
+[1] "\n\n|a     |b     |c     |d     |e      |f          |g                   |h         |\n|:-----|:-----|:-----|:-----|:------|:----------|:-------------------|:---------|\n|<dbl> |<int> |<lgl> |<chr> |<fctr> |<date>     |<time>              |<list>    |\n|1.0   |1     |TRUE  |a     |a      |2015-12-10 |2015-12-09 10:51:35 |<int [1]> |\n|2.5   |2     |FALSE |b     |b      |2015-12-11 |2015-12-09 10:51:36 |<int [1]> |\n\n\n"
+attr(,"class")
+[1] "knit_asis"
+attr(,"knit_cacheable")
+[1] TRUE

tests/testthat/test-equality.r

@@ -81,3 +81,7 @@ test_that("equality handles data frames with 0 columns (#1506)", {
   df0 <- data_frame(x = numeric(0), y = character(0) )
   expect_equal(df0, df0)
 })
+
+test_that("equality fails if types different", {
+  expect_equal(all.equal(tbl_df(iris), iris), "Different types: x tbl_df, tbl, data.frame, y data.frame")
+})

tests/testthat/test-frame-data.R

@@ -95,3 +95,12 @@ test_that("frame_data creates n-col empty data frame", {
   df <- frame_data(~x, ~y)
   expect_equal(names(df), c("x", "y"))
 })
+
+test_that("frame_data recognizes quoted non-formula call", {
+  df <- frame_data(
+    ~x, ~y,
+    quote(mean(1)), 1
+  )
+  expect_equal(df$x, list(quote(mean(1))))
+  expect_equal(df$y, 1)
+})

tests/testthat/test-glimpse.r

@@ -9,6 +9,10 @@ test_that("glimpse output matches known output", {
     glimpse(tbl_df(iris), width = 70L),
     "glimpse/iris-70.txt")
 
+  expect_output_identical(
+    glimpse(tbl_df(iris[integer()]), width = 70L),
+    "glimpse/iris-empty-70.txt")
+
   expect_output_identical(
     glimpse(tbl_df(df_all), width = 70L),
     "glimpse/all-70.txt")

tests/testthat/test-matrixToDataFrame.R

@@ -49,5 +49,10 @@ test_that("handles atomic vectors", {
   x <- matrix(list("a"), nrow = 2)
   out <- matrixToDataFrame(x)
   expect_equal( x[,1], list( "a", "a" ) )
-
+
+})
+
+test_that("error conditions", {
+  expect_error(matrixToDataFrame(1:10), "not a matrix")
+  expect_error(matrixToDataFrame(iris3), "not a matrix")
 })

tests/testthat/test-options.R

@@ -0,0 +1,22 @@
+context("options")
+
+test_that("tibble option takes preference", {
+  withr::with_options(
+    list(tibble.width = 10,
+         dplyr.width = 20),
+    expect_equal(tibble_opt("width"), 10))
+})
+
+test_that("dplyr option is used for compatibility", {
+  withr::with_options(
+    list(tibble.width = NULL,
+         dplyr.width = 20),
+    expect_equal(tibble_opt("width"), 20))
+})
+
+test_that("fallback to default option", {
+  withr::with_options(
+    list(tibble.width = NULL,
+         dplyr.width = NULL),
+    expect_equal(tibble_opt("width"), op.tibble[["tibble.width"]]))
+})

tests/testthat/test-tbl-df.r

@@ -35,6 +35,14 @@ test_that("[.tbl_df is careful about names (#1245)",{
   expect_error( foo[, c("x", "y", "z") ] )
 })
 
+test_that("[.tbl_df is no-op if args missing",{
+  expect_identical(df_all[], df_all)
+})
+
+test_that("[.tbl_df warns for drop argument",{
+  expect_warning(df_all[1, 2, drop = TRUE], "ignored")
+})
+
 
 # [[ ----------------------------------------------------------------------
 

tests/testthat/test-trunc-mat.r

@@ -13,6 +13,10 @@ test_that("trunc_mat output matches known output", {
     print(tbl_df(iris), n = 3L, width = 5L),
     "trunc_mat/iris-3-5.txt")
 
+  expect_output_identical(
+    print(tbl_df(iris), n = NULL, width = 70L),
+    "trunc_mat/iris--70.txt")
+
   expect_output_identical(
     print(df_all, n = NULL, width = 30L),
     "trunc_mat/all--30.txt")
@@ -32,7 +36,14 @@ test_that("trunc_mat output matches known output", {
   knit <- knitr::knit_print(trunc_mat(df_all, width = 60L))
   expect_output_identical(
     print(knit),
-    "trunc_mat/knit.txt")
+    "trunc_mat/knit-60.txt")
+  expect_is(knit, "knit_asis")
+  expect_true(attr(knit, "knit_cacheable"))
+
+  knit <- knitr::knit_print(trunc_mat(df_all, width = 120L))
+  expect_output_identical(
+    print(knit),
+    "trunc_mat/knit-120.txt")
   expect_is(knit, "knit_asis")
   expect_true(attr(knit, "knit_cacheable"))
 })