tests/testthat/test-wa_textarea-browser.R

In shiny.webawesome: 'shiny' Bindings for 'Web Awesome' Components

test_that(
  "wa_textarea keeps browser and Shiny text aligned in the semantic harness",
  {
    testthat::skip_on_cran()
    testthat::skip_if_not_installed("shinytest2")
    skip_if_no_chrome()

    app <- new_browser_runtime_app("runtime-semantic")
    on.exit(app$stop(), add = TRUE)

    wait_for_custom_elements(app, "wa-textarea")

    app$run_js(
      paste(
        "const el = document.getElementById('text_area');",
        "el.value = 'delta';",
        "el.dispatchEvent(new Event('change', { bubbles: true }));"
      )
    )

    wait_for_shiny_input(app, input = "text_area", expected = "delta")

    testthat::expect_equal(app$get_value(input = "text_area"), "delta")
    testthat::expect_equal(
      app$get_text("#text_area_state"),
      'input$text_area = "delta"'
    )
    testthat::expect_equal(
      app$get_js("document.getElementById('text_area').value"),
      "delta"
    )

    app$click("update_textarea")

    wait_for_shiny_input(app, input = "text_area", expected = "gamma")

    testthat::expect_equal(app$get_value(input = "text_area"), "gamma")
    testthat::expect_equal(
      app$get_js("document.getElementById('text_area').label"),
      "Updated textarea label"
    )
    testthat::expect_equal(
      app$get_js("document.getElementById('text_area').hint"),
      "Updated textarea hint"
    )
  }
)

test_that(
  "wa_textarea autocorrect constructor mappings survive browser hydration",
  {
    testthat::skip_on_cran()
    testthat::skip_if_not_installed("shinytest2")
    skip_if_no_chrome()

    app <- new_browser_runtime_app("runtime-semantic")
    on.exit(app$stop(), add = TRUE)

    wait_for_custom_elements(app, "wa-textarea")

    cases <- list(
      list(
        id = "text_area_auto_true",
        attr = "on",
        prop = TRUE,
        native = "true"
      ),
      list(
        id = "text_area_auto_false",
        attr = "off",
        prop = FALSE,
        native = "false"
      ),
      list(
        id = "text_area_auto_on",
        attr = "on",
        prop = TRUE,
        native = "true"
      ),
      list(
        id = "text_area_auto_off",
        attr = "off",
        prop = FALSE,
        native = "false"
      ),
      list(
        id = "text_area_auto_null",
        attr = NULL,
        prop = NULL,
        native = NULL
      )
    )

    for (case in cases) {
      attr_js <- sprintf(
        "document.getElementById('%s').getAttribute('autocorrect')",
        case$id
      )
      prop_js <- sprintf("document.getElementById('%s').autocorrect", case$id)
      native_js <- paste0(
        "(() => {",
        sprintf("const el = document.getElementById('%s');", case$id),
        paste(
          "const native = el.shadowRoot &&",
          "el.shadowRoot.querySelector('textarea');"
        ),
        "return native ? native.getAttribute('autocorrect') : null;",
        "})()"
      )

      testthat::expect_equal(app$get_js(attr_js), case$attr)
      testthat::expect_equal(app$get_js(prop_js), case$prop)
      testthat::expect_equal(app$get_js(native_js), case$native)
    }
  }
)