1test_that("tribble() constructs 'tibble' as expected", { 2 result <- tribble( 3 ~colA, ~colB, 4 "a", 1, 5 "b", 2 6 ) 7 8 compared <- tibble(colA = c("a", "b"), colB = c(1, 2)) 9 expect_equal(result, compared) 10 11 ## wide 12 wide <- tribble( 13 ~colA, ~colB, ~colC, ~colD, 14 1, 2, 3, 4, 15 5, 6, 7, 8 16 ) 17 18 wide_expectation <- tibble( 19 colA = c(1, 5), 20 colB = c(2, 6), 21 colC = c(3, 7), 22 colD = c(4, 8) 23 ) 24 25 expect_equal(wide, wide_expectation) 26 27 ## long 28 long <- tribble( 29 ~colA, ~colB, 30 1, 6, 31 2, 7, 32 3, 8, 33 4, 9, 34 5, 10 35 ) 36 37 long_expectation <- tibble( 38 colA = as.numeric(1:5), 39 colB = as.numeric(6:10) 40 ) 41 42 expect_equal(long, long_expectation) 43}) 44 45test_that("tribble() tolerates a trailing comma", { 46 result <- tribble( 47 ~colA, ~colB, 48 "a", 1, 49 "b", 2, 50 ) 51 52 compared <- tibble(colA = c("a", "b"), colB = c(1, 2)) 53 expect_equal(result, compared) 54}) 55 56test_that("tribble() handles columns with a class (#161)", { 57 sys_date <- Sys.Date() 58 sys_time <- Sys.time() 59 date_time_col <- tribble( 60 ~dt, ~dttm, 61 sys_date, sys_time, 62 as.Date("2003-01-02"), as.POSIXct("2004-04-05 13:45:17", tz = "UTC") 63 ) 64 65 date_time_col_expectation <- tibble( 66 dt = c(sys_date, as.Date("2003-01-02")), 67 dttm = vec_c(sys_time, as.POSIXct("2004-04-05 13:45:17", tz = "UTC")) 68 ) 69 70 expect_equal(date_time_col, date_time_col_expectation) 71}) 72 73test_that("tribble() creates lists for non-atomic inputs (#7)", { 74 expect_identical( 75 tribble(~a, ~b, NA, "A", letters, LETTERS[-1L]), 76 tibble(a = list(NA, letters), b = list("A", LETTERS[-1L])) 77 ) 78 79 expect_identical( 80 tribble(~a, ~b, NA, NULL, 1, 2), 81 tibble(a = c(NA, 1), b = list(NULL, 2)) 82 ) 83}) 84 85test_that("tribble() errs appropriately on bad calls", { 86 87 # no colname 88 expect_legacy_error( 89 tribble(1, 2, 3), 90 error_tribble_needs_columns(), 91 fixed = TRUE 92 ) 93 94 # invalid colname syntax 95 expect_legacy_error( 96 tribble(a ~ b), 97 error_tribble_lhs_column_syntax(quote(a)), 98 fixed = TRUE 99 ) 100 101 # invalid colname syntax 102 expect_legacy_error( 103 tribble(~a + b), 104 error_tribble_rhs_column_syntax(quote(a + b)), 105 fixed = TRUE 106 ) 107 108 # tribble() must be passed colnames 109 expect_error( 110 tribble( 111 "a", "b", 112 1, 2 113 ) 114 ) 115 116 # tribble() must produce rectangular structure (no filling) 117 expect_legacy_error( 118 tribble( 119 ~a, ~b, ~c, 120 1, 2, 121 3, 4, 5 122 ), 123 error_tribble_non_rectangular(3, 5), 124 fixed = TRUE 125 ) 126 127 expect_legacy_error( 128 tribble( 129 ~a, ~b, ~c, ~d, 130 1, 2, 3, 4, 5, 131 6, 7, 8, 9, 132 ), 133 error_tribble_non_rectangular(4, 9), 134 fixed = TRUE 135 ) 136}) 137 138test_that("tribble can have list columns", { 139 df <- tribble( 140 ~x, ~y, 141 1, list(a = 1), 142 2, list(b = 2) 143 ) 144 expect_equal(df$x, c(1, 2)) 145 expect_equal(df$y, list(list(a = 1), list(b = 2))) 146}) 147 148test_that("tribble creates n-col empty data frame", { 149 skip_enh_empty_tribble_unspecified() 150 df <- tribble(~x, ~y) 151 expect_equal(df, tibble(x = logical(), y = logical())) 152}) 153 154test_that("tribble recognizes quoted non-formula call", { 155 df <- tribble( 156 ~x, ~y, 157 quote(mean(1)), 1 158 ) 159 expect_equal(df$x, list(quote(mean(1)))) 160 expect_equal(df$y, 1) 161}) 162 163test_that("tribble returns 0x0 tibble when there's no argument", { 164 df <- tribble() 165 expect_equal(df, tibble()) 166}) 167 168# ---- frame_matrix() ---- 169 170test_that("frame_matrix constructs a matrix as expected", { 171 result <- frame_matrix( 172 ~col1, ~col2, 173 10, 3, 174 5, 2 175 ) 176 expected <- matrix(c(10, 5, 3, 2), ncol = 2) 177 colnames(expected) <- c("col1", "col2") 178 expect_equal(result, expected) 179}) 180 181test_that("frame_matrix constructs empty matrix as expected", { 182 result <- frame_matrix( 183 ~col1, ~col2 184 ) 185 expected <- matrix(logical(), ncol = 2) 186 colnames(expected) <- c("col1", "col2") 187 expect_equal(result, expected) 188}) 189 190test_that("frame_matrix cannot have list columns", { 191 expect_legacy_error( 192 frame_matrix( 193 ~x, ~y, 194 "a", 1:3, 195 "b", 4:6 196 ), 197 error_frame_matrix_list(c(2, 4)), 198 fixed = TRUE 199 ) 200}) 201