The R Project SVN R

Rev

Rev 51308 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 51308 Rev 51319
Line 1... Line 1...
1 
all_tests <- list(
 1 
basic_tests <- list(
2 
                  list(TRUE, all(logical(0))),
 - 
 
3 
                  list(TRUE, all(c(TRUE, TRUE))),
 - 
 
4 
                  list(TRUE, all(rep(TRUE, 2), rep(TRUE, 10))),
 - 
 
5 
                  list(NA, all(rep(TRUE, 2), c(TRUE, NA))),
 - 
 
6 
                  list(TRUE, all(rep(TRUE, 2), c(TRUE, NA), na.rm = TRUE)),
 - 
 
7 
                  list(FALSE, all(FALSE)),
 - 
 
8 
                  list(NA, all(c(NA, TRUE))),
 - 
 
9 
                  list(FALSE, all(c(NA, FALSE))),
 - 
 
10 
                  list(FALSE, all(rep(TRUE, 2), c(TRUE, FALSE))),
 - 
 
11 
                  list(FALSE, all(c(TRUE, FALSE), c(TRUE, NA)), na.rm = TRUE))
 - 
 
12 
 
 - 
 
13 
any_tests <- list(
 - 
 
14 
                  list(FALSE, any(logical(0))),
 - 
 
15 
                  list(TRUE, any(TRUE)),
 - 
 
16 
                  list(TRUE, any(FALSE, TRUE)),
 - 
 
17 
                  list(TRUE, any(c(FALSE, TRUE))),
 - 
 
18 
                  list(FALSE, any(c(FALSE, FALSE))),
 2 
     list(input=c(TRUE, FALSE), any=TRUE, all=FALSE),
19 
                  list(TRUE, any(c(TRUE, NA, FALSE))),
 3 
     list(input=c(FALSE, TRUE), any=TRUE, all=FALSE),
20 
                  list(TRUE, any(c(TRUE, NA, FALSE), na.rm = TRUE)),
 - 
 
21 
                  list(NA, any(c(NA, FALSE))),
 - 
 
22 
                  list(TRUE, any(c(NA, TRUE))),
 - 
 
23 
                  list(FALSE, any(c(NA, FALSE), na.rm = TRUE)))
 - 
 
24 
 
 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.
- 
 
 23 
list_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 
 
25 
test_list <- function(L)
 58 
do_tests <- function(L)
26 
{
 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 
    }
27 
    lab <- deparse(substitute(L))
 85 
    lab <- deparse(substitute(L))
28 
    for (i in seq_along(L)) {
 86 
    for (i in seq_along(L)) {
29 
        case <- L[[i]]
 87 
        case <- L[[i]]
30 
        if (!identical(case[[1]], case[[2]])) {
 88 
        do_check(case, any)
31 
            stop("test failed at ", lab, "[[", i, "]]")
 89 
        do_check(case, all)
32 
        }
 - 
 
33 
    }
 90 
    }
34 
}
 91 
}
35 
 
 92 
 
36 
test_list(all_tests)
 93 
do_tests(basic_tests)
37 
test_list(any_tests)
 94 
do_tests(list_input_tests)