Skip to content

Commit 57e8734

Browse files
gadenbuiecpsievertschloerke
authored
Add 309: Test flexdashboard tab and page management with {bslib} (#155)
Co-authored-by: Carson Sievert <[email protected]> Co-authored-by: Barret Schloerke <[email protected]> Co-authored-by: schloerke <[email protected]> Co-authored-by: gadenbuie <[email protected]>
1 parent 0d2533a commit 57e8734

File tree

5 files changed

+197
-3
lines changed

5 files changed

+197
-3
lines changed

R/data-apps-deps.R

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -58,6 +58,6 @@ apps_deps_map <- list(`001-hello` = "rsconnect", `012-datatables` = "ggplot2",
5858
"rversions", "sf", "withr"), `302-bootswatch-themes` = c("ggplot2",
5959
"progress", "rversions", "sf", "withr"), `304-bslib-card` = c("rlang",
6060
"rversions"), `305-bslib-value-box` = c("rlang", "rversions"
61-
), `310-bslib-sidebar-dynamic` = c("rversions", "testthat"
62-
), `311-bslib-sidebar-toggle-methods` = c("rversions", "testthat"
63-
))
61+
), `309-flexdashboard-tabs-navs` = "rmarkdown", `310-bslib-sidebar-dynamic` = c("rversions",
62+
"testthat"), `311-bslib-sidebar-toggle-methods` = c("rversions",
63+
"testthat"))
Lines changed: 73 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,73 @@
1+
---
2+
title: 309
3+
output:
4+
flexdashboard::flex_dashboard:
5+
theme:
6+
version: 3 #<< set to 3, 4, 5, ...
7+
orientation: row
8+
resize_reload: false
9+
params:
10+
bs_version: ""
11+
runtime: shiny
12+
---
13+
14+
Page 1 {data-test-id="Page 1"}
15+
===================================
16+
17+
## Box 1-1 {.tabset data-test-id="Box 1-1"}
18+
19+
### Tab 1-1a {data-test-id="Tab 1-1a"}
20+
21+
**About this test**: This app tests our usage of Bootstrap's Tab plugin.
22+
Test this app in all major versions of Bootstrap.
23+
24+
1. Change the active tabs on this page.
25+
2. Switch to Page 2 under "Other"
26+
3. Switch to Page 3 under "Other"
27+
28+
Verify that only the expected pages are visible
29+
and that the active navbar menu state is correctly shown.
30+
31+
This is Bootstrap `r params$bs_version`.
32+
33+
### Tab 1-1b {data-test-id="Tab 1-1b"}
34+
35+
Tab content, page 1, box 1, tab b
36+
37+
## Box 1-2 {.tabset data-test-id="Box 1-2"}
38+
39+
### Tab 1-2a {data-test-id="Tab 1-2a"}
40+
41+
Tab content, page 1, box 2, tab a
42+
43+
### Tab 1-2b {data-test-id="Tab 1-2b"}
44+
45+
Tab content, page 1, box 2, tab b
46+
47+
48+
Page 2 {data-navmenu="Other" data-test-id="Page 2"}
49+
===================================
50+
51+
## Row
52+
53+
### Box 2-1 {data-test-id="Box 2-1"}
54+
55+
Content, page 2, box 1
56+
57+
### Box 2-2 {data-test-id="Box 2-2"}
58+
59+
Content, page 2, box 2
60+
61+
62+
Page 3 {data-navmenu="Other" data-test-id="Page 3"}
63+
===================================
64+
65+
## Row
66+
67+
### Box 3-1 {data-test-id="Box 3-1"}
68+
69+
Content, page 3, box 1
70+
71+
### Box 3-2 {data-test-id="Box 3-2"}
72+
73+
Content, page 3, box 2
Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
shinytest2::test_app()
Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,2 @@
1+
# Load application support files into testing environment
2+
shinytest2::load_app_env()
Lines changed: 118 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,118 @@
1+
library(shinytest2)
2+
3+
is_element_visible <- function(selector) {
4+
sprintf("$('%s:visible').length > 0", selector)
5+
}
6+
7+
is_test_element_visible <- function(test_id) {
8+
is_element_visible(sprintf('[data-test-id="%s"]', test_id))
9+
}
10+
11+
expect_test_element_visible <- function(app, test_id) {
12+
expect_true(app$get_js(is_test_element_visible(!!test_id)))
13+
return(invisible(app))
14+
}
15+
16+
expect_test_element_hidden <- function(app, test_id) {
17+
expect_false(app$get_js(is_test_element_visible(!!test_id)))
18+
return(invisible(app))
19+
}
20+
21+
for (bs_version in 3:5) {
22+
test_that(paste0("309-flexdashboard-tabs-navs with BS", bs_version), {
23+
app <- AppDriver$new(
24+
name = "309-flexdashboard-tabs-navs",
25+
seed = 62868,
26+
height = 1292,
27+
width = 798,
28+
view = interactive(),
29+
render_args = list(
30+
params = list(bs_version = bs_version),
31+
output_options = list(theme = list(version = bs_version))
32+
)
33+
)
34+
35+
app$wait_for_idle()
36+
app$wait_for_js(is_test_element_visible("Page 1"))
37+
38+
# ---- Page 1 ----
39+
# Page 1 and its boxes are visible
40+
expect_test_element_visible(app, "Page 1")
41+
expect_test_element_visible(app, "Box 1-1")
42+
expect_test_element_visible(app, "Box 1-2")
43+
44+
# Check tab state on Page 1 (first tabs are visible)
45+
expect_test_element_visible(app, "Tab 1-1a")
46+
expect_test_element_visible(app, "Tab 1-2a")
47+
# second tabs are hidden
48+
expect_test_element_hidden(app, "Tab 1-1b")
49+
expect_test_element_hidden(app, "Tab 1-2b")
50+
51+
# Pages 2 and 3 and their elements are hidden
52+
expect_test_element_hidden(app, "Page 2")
53+
expect_test_element_hidden(app, "Box 2-1")
54+
expect_test_element_hidden(app, "Box 2-2")
55+
expect_test_element_hidden(app, "Page 3")
56+
expect_test_element_hidden(app, "Box 3-1")
57+
expect_test_element_hidden(app, "Box 3-2")
58+
59+
# ---- Page 1: Change Tabs ----
60+
# activate second tabs and check that visibility has switched
61+
app$
62+
click(selector = '[data-test-id="Page 1"] .nav-tabs [href$="tab-1-1b"]')$
63+
wait_for_js(is_test_element_visible("Tab 1-1b"))
64+
65+
app$
66+
click(selector = '[data-test-id="Page 1"] .nav-tabs [href$="tab-1-2b"]')$
67+
wait_for_js(is_test_element_visible("Tab 1-2b"))
68+
69+
# now first tabs are hidden
70+
expect_test_element_hidden(app, "Tab 1-1a")
71+
expect_test_element_hidden(app, "Tab 1-2a")
72+
# second tabs are visible
73+
expect_test_element_visible(app, "Tab 1-1b")
74+
expect_test_element_visible(app, "Tab 1-2b")
75+
76+
# ---- Page 2 ----
77+
app$
78+
click(selector = ".nav .dropdown .dropdown-toggle")$
79+
wait_for_js(is_element_visible(".nav .dropdown .dropdown-menu"))$
80+
click(selector = '.nav .dropdown-item[href$="page-2"]')$
81+
wait_for_js(is_test_element_visible("Page 2"))
82+
83+
# Page 2 is visible
84+
expect_test_element_visible(app, "Page 2")
85+
expect_test_element_visible(app, "Box 2-1")
86+
expect_test_element_visible(app, "Box 2-2")
87+
88+
# Pages 1 and 3 and their elements are hidden
89+
expect_test_element_hidden(app, "Page 1")
90+
expect_test_element_hidden(app, "Box 1-1")
91+
expect_test_element_hidden(app, "Box 1-2")
92+
expect_test_element_hidden(app, "Page 3")
93+
expect_test_element_hidden(app, "Box 3-1")
94+
expect_test_element_hidden(app, "Box 3-2")
95+
96+
# ---- Page 3 ----
97+
app$
98+
click(selector = ".nav .dropdown .dropdown-toggle")$
99+
wait_for_js(is_element_visible(".nav .dropdown .dropdown-menu"))$
100+
click(selector = '.nav .dropdown-item[href$="page-3"]')$
101+
wait_for_js(is_test_element_visible("Page 3"))
102+
103+
# Page 3 is visible
104+
expect_test_element_visible(app, "Page 3")
105+
expect_test_element_visible(app, "Box 3-1")
106+
expect_test_element_visible(app, "Box 3-2")
107+
108+
# Pages 1 and 2 and their elements are hidden
109+
expect_test_element_hidden(app, "Page 1")
110+
expect_test_element_hidden(app, "Box 1-1")
111+
expect_test_element_hidden(app, "Box 1-2")
112+
expect_test_element_hidden(app, "Page 2")
113+
expect_test_element_hidden(app, "Box 2-1")
114+
expect_test_element_hidden(app, "Box 2-2")
115+
116+
app$stop()
117+
})
118+
}

0 commit comments

Comments
 (0)