1basic_tests <- list(
2     list(input=c(TRUE, FALSE), any=TRUE, all=FALSE),
3     list(input=c(FALSE, TRUE), any=TRUE, all=FALSE),
4
5     list(input=c(TRUE, TRUE), any=TRUE, all=TRUE),
6     list(input=c(FALSE, FALSE), any=FALSE, all=FALSE),
7
8     list(input=c(NA, FALSE), any=NA, all=FALSE, any.na.rm=FALSE),
9     list(input=c(FALSE, NA), any=NA, all=FALSE, any.na.rm=FALSE),
10
11     list(input=c(NA, TRUE), any=TRUE, all=NA, all.na.rm=TRUE),
12     list(input=c(TRUE, NA), any=TRUE, all=NA, all.na.rm=TRUE),
13
14     list(input=logical(0), any=FALSE, all=TRUE),
15
16     list(input=NA, any=NA, all=NA, any.na.rm=FALSE, any.na.rm=TRUE),
17
18     list(input=c(TRUE, NA, FALSE), any=TRUE, any.na.rm=TRUE,
19          all=FALSE, all.na.rm=FALSE)
20     )
21
22## any, all accept '...' for input.
23list_input_tests <-
24    list(
25         list(input=list(TRUE, TRUE), all=TRUE, any=TRUE),
26         list(input=list(FALSE, FALSE), all=FALSE, any=FALSE),
27         list(input=list(TRUE, FALSE), all=FALSE, any=TRUE),
28         list(input=list(FALSE, TRUE), all=FALSE, any=TRUE),
29
30         list(input=list(FALSE, NA),
31              all=FALSE, all.na.rm=FALSE, any=NA, any.na.rm=FALSE),
32         list(input=list(NA, FALSE),
33              all=FALSE, all.na.rm=FALSE, any=NA, any.na.rm=FALSE),
34
35         list(input=list(TRUE, NA),
36              all=NA, all.na.rm=TRUE, any=TRUE, any.na.rm=TRUE),
37         list(input=list(NA, TRUE),
38              all=NA, all.na.rm=TRUE, any=TRUE, any.na.rm=TRUE),
39
40         list(input=list(NA, NA),
41              any=NA, any.na.rm=FALSE, all=NA, all.na.rm=TRUE),
42
43         list(input=list(rep(TRUE, 2), rep(TRUE, 10)),
44              all=TRUE, any=TRUE),
45
46         list(input=list(rep(TRUE, 2), c(TRUE, NA)),
47              all=NA, all.na.rm=TRUE, any=TRUE),
48
49         list(input=list(rep(TRUE, 2), c(TRUE, FALSE)),
50              all=FALSE, any=TRUE),
51
52         list(input=list(c(TRUE, FALSE), c(TRUE, NA)),
53              all=FALSE, all.na.rm=FALSE, any=TRUE, any.na.rm=TRUE)
54         )
55
56
57
58do_tests <- function(L)
59{
60    run <- function(f, input, na.rm = FALSE)
61    {
62        if (is.list(input))
63            do.call(f, c(input, list(na.rm = na.rm)))
64        else f(input, na.rm = na.rm)
65    }
66
67    do_check <- function(case, f)
68    {
69        fun <- deparse(substitute(f))
70        if (!identical(case[[fun]], run(f, case$input))) {
71            cat("input: "); dput(case$input)
72            stop(fun, " returned ", run(f, case$input),
73                 " wanted ", case[[fun]], call. = FALSE)
74        }
75        narm <- paste(fun, ".na.rm", sep = "")
76        if (!is.null(case[[narm]])) {
77            if (!identical(case[[narm]],
78                           run(f, case$input, na.rm = TRUE))) {
79                cat("input: "); dput(case$input)
80                stop(narm, " returned ", run(f, case$input, na.rm = TRUE),
81                     " wanted ", case[[narm]], call. = FALSE)
82            }
83        }
84    }
85    lab <- deparse(substitute(L))
86    for (case in L) {
87        do_check(case, any)
88        do_check(case, all)
89    }
90}
91
92do_tests(basic_tests)
93do_tests(list_input_tests)
94