1 2## tests for digest, taken from the examples in the manual page 3 4suppressMessages(library(digest)) 5 6# calculate sha1 fingerprints 7x.numeric <- c(seq(0, 1, length = 4 ^ 3), -Inf, Inf, NA, NaN) 8x.list <- list(letters, x.numeric) 9x.dataframe <- data.frame(X = letters, 10 Y = x.numeric[2], 11 Z = factor(letters), 12 stringsAsFactors = FALSE) 13x.matrix.num <- as.matrix(x.numeric) 14x.matrix.letter <- as.matrix(letters) 15x.dataframe.round <- x.dataframe 16x.dataframe.round$Y <- signif(x.dataframe.round$Y, 14) 17x.factor <- factor(letters) 18x.array.num <- as.array(x.numeric) 19x.formula <- a~b+c|d 20x.paren_formula <- a~(b+c) 21x.no_paren_formula <- a~b+c 22 23# tests using detailed numbers 24expect_false(identical(x.numeric, signif(x.numeric, 14))) 25expect_false(identical(x.matrix.num, signif(x.matrix.num, 14))) 26 27# returns the correct SHA1 28expect_true( 29 identical( 30 sha1(x.numeric), 31 { 32 z <- digest:::num2hex(x.numeric) 33 attr(z, "digest::sha1") <- list( 34 class = class(x.numeric), 35 digits = 14L, 36 zapsmall = 7L 37 ) 38 digest(z, algo = "sha1") 39 } 40 ) 41) 42# Verify that all numeric values (especially +-Inf and NA/NaN) return unique 43# SHA1 hashes 44expect_false( 45 any(duplicated(sapply(x.numeric, sha1))) 46) 47expect_true( 48 identical( 49 sha1(letters), 50 { 51 z <- letters 52 attr(z, "digest::sha1") <- list( 53 class = "character", 54 digits = 14L, 55 zapsmall = 7L 56 ) 57 digest(z, algo = "sha1") 58 } 59 ) 60) 61expect_true( 62 identical( 63 sha1(x.list), 64 { 65 z <- sapply(x.list, sha1) 66 attr(z, "digest::sha1") <- list( 67 class = "list", 68 digits = 14L, 69 zapsmall = 7L 70 ) 71 digest(z, algo = "sha1") 72 } 73 ) 74) 75options(sha1PackageVersion = "0.6.22.1") 76expect_true( 77 identical( 78 sha1(x.dataframe), 79 { 80 z <- sapply(x.dataframe, sha1) 81 attr(z, "digest::sha1") <- list( 82 class = "data.frame", 83 digits = 14L, 84 zapsmall = 7L 85 ) 86 digest(z, algo = "sha1") 87 } 88 ) 89) 90## expect_true( 91## identical( 92## sha1(x.matrix.num), 93## { 94## z <- matrix( 95## apply(x.matrix.num, 2, digest:::num2hex), 96## ncol = ncol(x.matrix.num) 97## ) 98## attr(z, "digest::sha1") <- list( 99## class = "matrix", 100## digits = 14L, 101## zapsmall = 7L 102## ) 103## digest(z, algo = "sha1") 104## } 105## ) 106## ) 107## expect_true( 108## identical( 109## sha1(x.matrix.letter), 110## { 111## z <- x.matrix.letter 112## attr(z, "digest::sha1") <- list( 113## class = "matrix", 114## digits = 14L, 115## zapsmall = 7L 116## ) 117## digest(z, algo = "sha1") 118## } 119## ) 120## ) 121stopifnot( 122 identical( 123 sha1(x.factor), 124 { 125 z <- x.factor 126 attr(z, "digest::sha1") <- list( 127 class = "factor", 128 digits = 14L, 129 zapsmall = 7L 130 ) 131 digest(z, algo = "sha1") 132 } 133 ) 134) 135# a matrix and a vector should have a different hash 136expect_true( 137 !identical( 138 sha1(x.numeric), 139 sha1(matrix(x.numeric, nrow = 1)) 140 ) 141) 142expect_true( 143 !identical( 144 sha1(x.numeric), 145 sha1(matrix(x.numeric, ncol = 1)) 146 ) 147) 148expect_true( 149 !identical( 150 sha1(letters), 151 sha1(matrix(letters, nrow = 1)) 152 ) 153) 154expect_true( 155 !identical( 156 sha1(letters), 157 sha1(matrix(letters, ncol = 1)) 158 ) 159) 160 161# character(0) and numeric(0) should have a different hash 162expect_true(!identical(sha1(character(0)), sha1(numeric(0)))) 163 164# a POSIXct and a POSIXlt should give a different hash 165z <- as.POSIXct("2015-01-02 03:04:06.07", tz = "UTC") 166expect_true( 167 !identical( 168 sha1(z), 169 sha1(as.POSIXlt(z)) 170 ) 171) 172 173lm.model.0 <- lm(weight ~ Time, data = ChickWeight) 174lm.model.1 <- lm(weight ~ 1, data = ChickWeight) 175glm.model.0 <- glm(weight ~ Time, data = ChickWeight, family = poisson) 176glm.model.1 <- glm(weight ~ 1, data = ChickWeight, family = poisson) 177 178anova.list <- list( 179 lm = anova(lm.model.0, lm.model.1), 180 glm = anova(glm.model.0, glm.model.1), 181 glm.test = anova(glm.model.0, glm.model.1, test = "Chisq") 182) 183 184# works with lm anova" 185expect_true( 186 identical( 187 sha1(anova.list[["lm"]]), 188 { 189 y <- apply( 190 anova.list[["lm"]], 191 1, 192 digest:::num2hex, 193 digits = 4, 194 zapsmall = 7 195 ) 196 attr(y, "digest::sha1") <- list( 197 class = c("anova", "data.frame"), 198 digits = 4L, 199 zapsmall = 7L 200 ) 201 digest(y, algo = "sha1") 202 } 203 ) 204) 205# works with glm anova" 206expect_true( 207 identical( 208 sha1(anova.list[["glm"]]), 209 { 210 y <- apply( 211 anova.list[["glm"]], 212 1, 213 digest:::num2hex, 214 digits = 4, 215 zapsmall = 7 216 ) 217 attr(y, "digest::sha1") <- list( 218 class = c("anova", "data.frame"), 219 digits = 4L, 220 zapsmall = 7L 221 ) 222 digest(y, algo = "sha1") 223 } 224 ) 225) 226expect_true( 227 identical( 228 sha1(anova.list[["glm.test"]]), 229 { 230 y <- apply( 231 anova.list[["glm.test"]], 232 1, 233 digest:::num2hex, 234 digits = 4, 235 zapsmall = 7 236 ) 237 attr(y, "digest::sha1") <- list( 238 class = c("anova", "data.frame"), 239 digits = 4L, 240 zapsmall = 7L 241 ) 242 digest(y, algo = "sha1") 243 } 244 ) 245) 246expect_true( 247 identical( 248 sha1(x.formula, environment=FALSE), 249 { 250 y <- sapply( 251 X=x.formula, 252 FUN=sha1, 253 digits=14L, 254 zapsmall=7L, 255 ...=list(environment=FALSE), 256 algo="sha1" 257 ) 258 attr(y, "digest::sha1") <- list( 259 class="formula", 260 digits=14L, 261 zapsmall=7L, 262 environment=FALSE 263 ) 264 digest(y, algo="sha1") 265 } 266 ) 267) 268expect_true( 269 identical( 270 sha1(x.formula), 271 { 272 y <- c( 273 sapply( 274 X=x.formula, 275 FUN=sha1, 276 digits=14L, 277 zapsmall=7L, 278 ...=list(environment=TRUE), 279 algo="sha1" 280 ), 281 digest(environment(x.formula), algo="sha1") 282 ) 283 attr(y, "digest::sha1") <- list( 284 class="formula", 285 digits=14L, 286 zapsmall=7L 287 ) 288 digest(y, algo="sha1") 289 } 290 ) 291) 292expect_true( 293 sha1(x.paren_formula) != sha1(x.no_paren_formula) 294) 295 296test.element <- list( 297 # NULL 298 NULL, 299 # empty classes 300 logical(0), integer(0), numeric(0), character(0), list(), data.frame(), 301 # scalar 302 TRUE, FALSE, 1L, 1, "a", 303 # date. Make sure to add the time zone. Otherwise the test might fail 304 as.POSIXct("2015-01-02 03:04:06.07", tz = "UTC"), 305 # vector 306 c(TRUE, FALSE), 1:3, seq(0, 10, length = 4), letters[1:3], 307 factor(letters[4:6]), 308 as.POSIXct(c("2015-01-02 03:04:06.07", "1960-12-31 23:59:59"), tz = "UTC") 309) 310select.vector <- which(sapply(test.element, length) > 1) 311test.element <- c( 312 test.element, 313 # add a data.frame 314 list(expand.grid(test.element[select.vector])), 315 # add a list 316 list(test.element[select.vector]), 317 # add matrices 318 list(matrix(1:10)), 319 list(matrix(seq(0, 10, length = 4))), 320 list(matrix(letters)) 321) 322# different values for digits or zapsmall gives different hashes 323# expect for NULL 324expect_true( 325 identical( 326 sha1(NULL, digits = 14), 327 sha1(NULL, digits = 13) 328 ) 329) 330expect_true( 331 identical( 332 sha1(NULL, zapsmall = 14), 333 sha1(NULL, zapsmall = 13) 334 ) 335) 336for (i in tail(seq_along(test.element), -1)) { 337 expect_true( 338 !identical( 339 sha1(test.element[[i]], digits = 14), 340 sha1(test.element[[i]], digits = 13) 341 ) 342 ) 343 expect_true( 344 !identical( 345 sha1(test.element[[i]], zapsmall = 7), 346 sha1(test.element[[i]], zapsmall = 6) 347 ) 348 ) 349} 350test.element <- c(test.element, anova.list) 351 352#cat("\ncorrect <- c(\n") 353#cat( 354# sprintf(" \"%s\"", sapply(test.element, sha1)), 355# sep = ",\n" 356#) 357#cat(")\n") 358 359correct <- c( 360 "8d9c05ec7ae28b219c4c56edbce6a721bd68af82", 361 "d61eeea290dd09c5a3eba41c2b3174b6e4e2366d", 362 "af23305d27f0409c91bdb86ba7c0cdb2e09a5dc6", 363 "0c9ca70ce773deb0d9c0b0579c3b94856edf15cc", 364 "095886422ad26e315c0960ef6b09842a1f9cc0ce", 365 "6cc04c6c432bb91e210efe0b25c6ca809e6df2e3", 366 "c1113ba008a349de64da2a7a724e501c1eb3929b", 367 "6e12370bdc6fc457cc154f0525e22c6aa6439f4d", 368 "1c1b5393c68a643bc79c277c6d7374d0b30cd985", 369 "b48c17a2ac82601ff38df374f87d76005fb61cbd", 370 "35280c99aa6a48bfc2810b72b763ccac0f632207", 371 "f757cc017308d217f35ed8f0c001a57b97308fb7", 372 "cfcf101b8449af67d34cdc1bcb0432fe9e4de08e", 373 "a14384d1997440bad13b97b3ccfb3b8c0392e79a", 374 "555f6bea49e58a2c2541060a21c2d4f9078c3086", 375 "631d18dec342e2cb87614864ba525ebb9ad6a124", 376 "b6c04f16b6fdacc794ea75c8c8dd210f99fafa65", 377 "25485ba7e315956267b3fdc521b421bbb046325d", 378 "6def3ca353dfc1a904bddd00e6a410d41ac7ab01", 379 "cf220bcf84c3d0ab1b01f8f764396941d15ff20f", 380 "2af8021b838f613aee7670bed19d0ddf1d6bc0c1", 381 "270ed85d46524a59e3274d89a1bbf693521cb6af", 382 "60e09482f12fda20f7d4a70e379c969c5a73f512", 383 "10380001af2a541b5feefc7aab9f719b67330a42", 384 "4580ff07f27eb8321421efac1676a80d9239572a", 385 "d3022c5a223caaf77e9c564e024199e5d6f51bd5", 386 "f54742ac61edd8c3980354620816c762b524dfc7" 387) 388# each object should yield a different hash 389expect_true(!any(duplicated(correct))) 390# returns the same SHA1 on both 32-bit and 64-bit OS" 391## for (i in seq_along(test.element)) { 392## expect_true( 393## identical( 394## sha1(test.element[[i]]), 395## correct[i] 396## ) 397## ) 398## } 399 400# does work with empty lists and data.frames 401expect_true(is.character(sha1(list()))) 402expect_true(is.character(sha1(data.frame()))) 403expect_true(is.character(sha1(list(a = 1, b = list(), c = data.frame())))) 404 405# does work with complex type 406expect_true(is.character(sha1(2 + 5i))) # single complex number 407expect_true(is.character(sha1(1:10 + 5i))) # vector of complex numbers 408 409# complex number with only the real part should be different from real number 410expect_true(sha1(2) != sha1(2 + 0i)) 411 412# does work with Date type 413expect_true(is.character(sha1(Sys.Date()))) 414expect_true(sha1(as.Date("1980-01-01")) != sha1(as.Date("1990-01-01"))) 415 416# different hashes for differently shaped arrays that contain the same data 417data <- 1:8 418a <- array(data, dim = c(2,2,2)) # cube 2x2x2 419b <- array(data, dim = c(2,4,1)) # matrix 2x4 420expect_true(sha1(a) != sha1(b)) 421 422# test error message 423junk <- pi 424class(junk) <- c("A", "B") 425#error.message <- try(sha1(junk)) 426#expect_true(grepl("sha1\\(\\) has no method for the 'A', 'B' class", error.message)) 427 428junk <- function( 429 x, y = list(...), test = TRUE, start = NULL, text = "abc", family = poisson, 430 ... 431){ 432 sha1(x) 433} 434#expect_true(sha1(junk) == "be194e8cdae926c13fd4e2c65bf6cb7a28dd0505") 435expect_true(sha1(junk) == sha1(junk, environment = TRUE)) 436expect_true(sha1(junk) != sha1(junk, environment = FALSE)) 437 438#expect_true(sha1(matrix(integer(0))) == "e13485e1b995f3e36d43674dcbfedea08ce237bc") 439expect_true( 440 !identical( 441 sha1(matrix(integer(0))), 442 sha1(matrix(character(0))) 443 ) 444) 445expect_true( 446 !identical( 447 sha1(matrix(integer(0))), 448 sha1(matrix(numeric(0))) 449 ) 450) 451 452## if (getRversion() < "3.5.0") { 453## expect_true( 454## identical( 455## sha1(serialize("e13485e1b995f3e36d43674dcbfedea08ce237bc", NULL)), 456## "93ab6a61f1a2ad50d4bf58396dc38cd3821b2eaf" 457## ) 458## ) 459## } 460 461x <- letters 462for (algo in c("md5", "sha1", "crc32", "sha256", "sha512", "xxhash32", 463 "xxhash64", "murmur32")) { 464 y <- x 465 attr(y, "digest::sha1") <- digest:::attr_sha1(x, 14L, 7L, algo = algo) 466 expect_true( 467 identical( 468 sha1(x, algo = algo), 469 digest(y, algo = algo) 470 ) 471 ) 472 473} 474 475expect_true(is.character(sha1(sessionInfo()))) 476 477# check the effect of attributes from version 0.6.22.2 478options(sha1PackageVersion = utils::packageVersion("digest")) 479check_attribute_effect <- function(x) { 480 y <- x 481 attr(y, "test") <- "junk" 482 expect_false(sha1(x) == sha1(y)) 483} 484test.element <- list(2 + 5i, x.array.num, Sys.Date(), Sys.time(), y ~ x) 485test.element <- c(test.element, list(x.dataframe), anova.list, function(x){x}) 486for (z in test.element) { 487 check_attribute_effect(z) 488} 489 490# check that sha1() on contributed functions maintain there hash after storing 491f <- tempfile(fileext = ".rds") 492x <- digest::sha1 493saveRDS(x, f) 494y <- readRDS(f) 495expect_identical(sha1(x), sha1(y)) 496expect_identical(sha1(x, environment = FALSE), sha1(y, environment = FALSE)) 497