From f737b4b7bb42fcbbd7436bcd7f390a5398dd2a4d Mon Sep 17 00:00:00 2001 From: E Nelson Date: Tue, 28 Apr 2026 15:22:39 -0400 Subject: [PATCH] refactor: replace sendCustomMessage with renderUI in test app, use input_switch Replace the custom setEnabled JS message handler with renderUI()-based toggling, which exercises the actual Shiny rendering/re-binding code path including renderValue re-firing on element replacement. Replace actionButton toggles with bslib::input_switch for clearer intent. Co-Authored-By: Claude Sonnet 4.6 --- tests/testthat/apps/download-button/app.R | 154 +++++++++--------- .../testthat/test-downloadButton-shinytest2.R | 7 +- 2 files changed, 86 insertions(+), 75 deletions(-) diff --git a/tests/testthat/apps/download-button/app.R b/tests/testthat/apps/download-button/app.R index 49858cb85..26eb6cc97 100644 --- a/tests/testthat/apps/download-button/app.R +++ b/tests/testthat/apps/download-button/app.R @@ -1,7 +1,7 @@ library(shiny) # This app covers the three `enabled` values for both downloadButton and downloadLink, -# plus a simulated shinyjs-disabled case, with toggle buttons for each scenario. +# plus a simulated shinyjs-disabled case, with toggle switches for each scenario. # Create a downloadHandler that just serves a simple text file for testing. handler <- function() { @@ -11,69 +11,36 @@ handler <- function() { ) } -# Mirrors what shinyjs::enable() / shinyjs::disable() does: adds/removes the -# shinyjs-disabled class and the standard disabled attributes. This lets us test -# that the download buttons/links respond to external JS changes to their enabled state, -# without making us require shinyjs. -set_enabled_js <- HTML( - " - Shiny.addCustomMessageHandler('setEnabled', function(data) { - var el = document.getElementById(data.id); - if (data.enabled) { - el.classList.remove('disabled'); - el.classList.remove('shinyjs-disabled'); - el.removeAttribute('aria-disabled'); - el.removeAttribute('tabindex'); - } else { - el.classList.add('disabled'); - el.classList.add('shinyjs-disabled'); - el.setAttribute('aria-disabled', 'true'); - el.setAttribute('tabindex', '-1'); - } - }); -" -) - ui <- fluidPage( - tags$script(set_enabled_js), - # Block of download Button tests - h3("downloadButton"), - downloadButton("btn_auto", "Auto (default)"), - actionButton("toggle_btn_auto", "Toggle"), + uiOutput("btn_auto_ui"), + bslib::input_switch("toggle_btn_auto", "Enabled", value = TRUE), - downloadButton("btn_off", "Disabled", enabled = FALSE), - actionButton("toggle_btn_off", "Toggle"), + uiOutput("btn_off_ui"), + bslib::input_switch("toggle_btn_off", "Enabled", value = FALSE), - downloadButton("btn_on", "Pre-enabled", enabled = TRUE), - actionButton("toggle_btn_on", "Toggle"), + uiOutput("btn_on_ui"), + bslib::input_switch("toggle_btn_on", "Enabled", value = TRUE), # This mimics what happens when a download button is wrapped in a # shinyjs::disabled() call within the UI (and therefore at render time). - htmltools::tagAppendAttributes( - downloadButton("btn_shinyjs", "shinyjs-disabled"), - class = "shinyjs-disabled" - ), - actionButton("toggle_btn_shinyjs", "Toggle"), + uiOutput("btn_shinyjs_ui"), + bslib::input_switch("toggle_btn_shinyjs", "Enabled", value = FALSE), - # Block of download Link tests h3("downloadLink"), - downloadLink("lnk_auto", "Auto (default)"), - actionButton("toggle_lnk_auto", "Toggle"), + uiOutput("lnk_auto_ui"), + bslib::input_switch("toggle_lnk_auto", "Enabled", value = TRUE), - downloadLink("lnk_off", "Disabled", enabled = FALSE), - actionButton("toggle_lnk_off", "Toggle"), + uiOutput("lnk_off_ui"), + bslib::input_switch("toggle_lnk_off", "Enabled", value = FALSE), - downloadLink("lnk_on", "Pre-enabled", enabled = TRUE), - actionButton("toggle_lnk_on", "Toggle"), + uiOutput("lnk_on_ui"), + bslib::input_switch("toggle_lnk_on", "Enabled", value = TRUE), - htmltools::tagAppendAttributes( - downloadLink("lnk_shinyjs", "shinyjs-disabled"), - class = "shinyjs-disabled" - ), - actionButton("toggle_lnk_shinyjs", "Toggle") + uiOutput("lnk_shinyjs_ui"), + bslib::input_switch("toggle_lnk_shinyjs", "Enabled", value = FALSE) ) server <- function(input, output, session) { @@ -86,30 +53,71 @@ server <- function(input, output, session) { output$lnk_on <- handler() output$lnk_shinyjs <- handler() - # Each reactiveVal tracks the current intended state, starting from - # the post-render-value state (auto/on start enabled; off/shinyjs start disabled). - make_toggle <- function(id, initial_enabled) { - enabled <- reactiveVal(initial_enabled) - observeEvent(input[[paste0("toggle_", id)]], { - new_state <- !enabled() - enabled(new_state) - # This mimics what shinyjs::enable()/disable() would do, which is to send - # a message to the client to update the button's enabled state via JS. - session$sendCustomMessage( - "setEnabled", - list(id = id, enabled = new_state) - ) - }) - } + output$btn_auto_ui <- renderUI({ + if (isTRUE(input$toggle_btn_auto)) { + downloadButton("btn_auto", "Auto (default)") + } else { + downloadButton("btn_auto", "Auto (default)", enabled = FALSE) + } + }) - make_toggle("btn_auto", TRUE) - make_toggle("btn_off", FALSE) - make_toggle("btn_on", TRUE) - make_toggle("btn_shinyjs", FALSE) - make_toggle("lnk_auto", TRUE) - make_toggle("lnk_off", FALSE) - make_toggle("lnk_on", TRUE) - make_toggle("lnk_shinyjs", FALSE) + output$btn_off_ui <- renderUI({ + if (isTRUE(input$toggle_btn_off)) { + downloadButton("btn_off", "Disabled", enabled = TRUE) + } else { + downloadButton("btn_off", "Disabled", enabled = FALSE) + } + }) + + output$btn_on_ui <- renderUI({ + if (isTRUE(input$toggle_btn_on)) { + downloadButton("btn_on", "Pre-enabled", enabled = TRUE) + } else { + downloadButton("btn_on", "Pre-enabled", enabled = FALSE) + } + }) + + output$btn_shinyjs_ui <- renderUI({ + btn <- downloadButton("btn_shinyjs", "shinyjs-disabled") + if (!isTRUE(input$toggle_btn_shinyjs)) { + htmltools::tagAppendAttributes(btn, class = "shinyjs-disabled") + } else { + btn + } + }) + + output$lnk_auto_ui <- renderUI({ + if (isTRUE(input$toggle_lnk_auto)) { + downloadLink("lnk_auto", "Auto (default)") + } else { + downloadLink("lnk_auto", "Auto (default)", enabled = FALSE) + } + }) + + output$lnk_off_ui <- renderUI({ + if (isTRUE(input$toggle_lnk_off)) { + downloadLink("lnk_off", "Disabled", enabled = TRUE) + } else { + downloadLink("lnk_off", "Disabled", enabled = FALSE) + } + }) + + output$lnk_on_ui <- renderUI({ + if (isTRUE(input$toggle_lnk_on)) { + downloadLink("lnk_on", "Pre-enabled", enabled = TRUE) + } else { + downloadLink("lnk_on", "Pre-enabled", enabled = FALSE) + } + }) + + output$lnk_shinyjs_ui <- renderUI({ + lnk <- downloadLink("lnk_shinyjs", "shinyjs-disabled") + if (!isTRUE(input$toggle_lnk_shinyjs)) { + htmltools::tagAppendAttributes(lnk, class = "shinyjs-disabled") + } else { + lnk + } + }) } shinyApp(ui, server) diff --git a/tests/testthat/test-downloadButton-shinytest2.R b/tests/testthat/test-downloadButton-shinytest2.R index ff6500ae0..80ddeeb39 100644 --- a/tests/testthat/test-downloadButton-shinytest2.R +++ b/tests/testthat/test-downloadButton-shinytest2.R @@ -17,7 +17,8 @@ app_process <- callr::r_bg( port = port, host = "127.0.0.1", launch.browser = FALSE, - quiet = TRUE + quiet = TRUE, + test.mode = TRUE ) }, args = list( @@ -62,7 +63,9 @@ is_disabled <- function(id) { # --------------------------------------------------------------------------- click_toggle <- function(id) { - app$click(input = paste0("toggle_", id), wait_ = FALSE) + input_name <- paste0("toggle_", id) + current <- isTRUE(app$get_value(input = input_name)) + do.call(app$set_inputs, setNames(list(!current), input_name)) app$wait_for_idle() }