1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
|
# For issue #1006
test_that("sliderInput steps don't have rounding errors", {
# Need to use expect_identical; expect_equal is too forgiving of rounding error
expect_identical(findStepSize(-5.5, 4, NULL), 0.1)
})
test_that("sliderInput validation", {
# Number
x <- 10
expect_silent(sliderInput('s', 's', x-1, x+1, x))
expect_silent(sliderInput('s', 's', x-1, x+1, x-1))
expect_silent(sliderInput('s', 's', x-1, x+1, c(x-1, x+1)))
expect_warning(sliderInput('s', 's', x-1, x+1, x+2))
expect_warning(sliderInput('s', 's', x-1, x+1, x-2))
expect_warning(sliderInput('s', 's', x-1, x+1, c(x-2, x)))
expect_warning(sliderInput('s', 's', x-1, x+1, c(x, x+2)))
expect_error(sliderInput('s', 's', x-1, x+1))
expect_error(sliderInput('s', 's', x-1, x+1, NULL))
expect_error(sliderInput('s', 's', x-1, NULL, x))
expect_error(sliderInput('s', 's', NULL, x+1, x))
expect_error(sliderInput('s', 's', NULL, NULL, x))
expect_error(sliderInput('s', 's', x-1, x+1, NA_real_))
expect_error(sliderInput('s', 's', x-1, x+1, c(x, NA_real_)))
# Date
x <- Sys.Date()
expect_silent(sliderInput('s', 's', x-1, x+1, x))
expect_silent(sliderInput('s', 's', x-1, x+1, x-1))
expect_silent(sliderInput('s', 's', x-1, x+1, c(x-1, x+1)))
expect_warning(sliderInput('s', 's', x-1, x+1, x+2))
expect_warning(sliderInput('s', 's', x-1, x+1, x-2))
expect_warning(sliderInput('s', 's', x-1, x+1, c(x-2, x)))
expect_warning(sliderInput('s', 's', x-1, x+1, c(x, x+2)))
expect_error(sliderInput('s', 's', x-1, x+1))
expect_error(sliderInput('s', 's', x-1, x+1, NULL))
expect_error(sliderInput('s', 's', x-1, NULL, x))
expect_error(sliderInput('s', 's', NULL, x+1, x))
expect_error(sliderInput('s', 's', NULL, NULL, x))
expect_error(sliderInput('s', 's', x-1, x+1, as.Date(NA)))
# POSIXct
x <- Sys.time()
expect_silent(sliderInput('s', 's', x-1, x+1, x))
expect_silent(sliderInput('s', 's', x-1, x+1, x-1))
expect_silent(sliderInput('s', 's', x-1, x+1, c(x-1, x+1)))
expect_warning(sliderInput('s', 's', x-1, x+1, x+2))
expect_warning(sliderInput('s', 's', x-1, x+1, x-2))
expect_warning(sliderInput('s', 's', x-1, x+1, c(x-2, x)))
expect_warning(sliderInput('s', 's', x-1, x+1, c(x, x+2)))
expect_error(sliderInput('s', 's', x-1, x+1))
expect_error(sliderInput('s', 's', x-1, x+1, NULL))
expect_error(sliderInput('s', 's', x-1, NULL, x))
expect_error(sliderInput('s', 's', NULL, x+1, x))
expect_error(sliderInput('s', 's', NULL, NULL, x))
# POSIXLt
x <- as.POSIXlt(Sys.time())
expect_silent(sliderInput('s', 's', x-1, x+1, x))
expect_silent(sliderInput('s', 's', x-1, x+1, x-1))
expect_warning(sliderInput('s', 's', x-1, x+1, x+2))
expect_warning(sliderInput('s', 's', x-1, x+1, x-2))
if (getRversion() >= "4.0") {
expect_silent(sliderInput('s', 's', x-1, x+1, c(x-1, x+1)))
expect_warning(sliderInput('s', 's', x-1, x+1, c(x-2, x)))
expect_warning(sliderInput('s', 's', x-1, x+1, c(x, x+2)))
} else {
skip("c() doesn't work sensibly on POSIXlt objects with this version of R")
}
expect_error(sliderInput('s', 's', x-1, x+1))
expect_error(sliderInput('s', 's', x-1, x+1, NULL))
expect_error(sliderInput('s', 's', x-1, NULL, x))
expect_error(sliderInput('s', 's', NULL, x+1, x))
expect_error(sliderInput('s', 's', NULL, NULL, x))
# Size
x <- 10
## length 0
expect_error(sliderInput('s', 's', x-1, x+1, numeric(0)))
expect_error(sliderInput('s', 's', x-1, numeric(0), x))
expect_error(sliderInput('s', 's', numeric(0), x+1, x))
## length 1
expect_silent(sliderInput('s', 's', x-1, x+1, x))
## length 2
expect_silent(sliderInput('s', 's', x-1, x+1, c(x, x)))
## length 3+
expect_error(sliderInput('s', 's', x-1, x+1, c(x, x, x)))
expect_error(sliderInput('s', 's', x-1, c(x, x, x), x))
expect_error(sliderInput('s', 's', c(x, x, x), x+1, x))
})
|
