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