Error when recording tests using shinytest2 in an app with sub-modules

I am trying to record tests in an app with submodules and I end up getting the below error:

Error (test-shinytest2.R:25:3): {shinytest2} recording: test2
Error in `app_find_node_id(self, private, input = input, output = output, 
    selector = selector)`: Cannot find HTML element with selector #main-sub-submit_user.shiny-bound-input
Backtrace:
    ▆
 1. └─app$click("main-sub-submit_user") at test-shinytest2.R:25:3
 2.   └─shinytest2:::app_click(...)
 3.     └─shinytest2:::app_find_node_id(self, private, input = input, output = output, selector = selector)
 4.       └─shinytest2:::app_abort(...)
 5.         └─rlang::abort(..., app = self, call = call)

Error (test-shinytest2.R:39:3): {shinytest2} recording: sample_app
Error in `app_find_node_id(self, private, input = input, output = output, 
    selector = selector)`: Cannot find HTML element with selector #main-sub-submit_user.shiny-bound-input
Backtrace:
    ▆
 1. └─app$click("main-sub-submit_user") at test-shinytest2.R:39:3
 2.   └─shinytest2:::app_click(...)
 3.     └─shinytest2:::app_find_node_id(self, private, input = input, output = output, selector = selector)
 4.       └─shinytest2:::app_abort(...)
 5.         └─rlang::abort(..., app = self, call = call)

Here is the sample app used :
app.R

# === app.R ==== 
library(shiny)
library(bslib)
library(DT)

ui <- page_navbar(
  title = "My TestApp",
  bg = "#2D89C8",
  inverse = TRUE,
  nav_panel(
    title = "Panel 1",
    mod_main_ui("main")
  )
)

server <- function(input, output, session) {
  mod_main_server("main")
}

shinyApp(ui, server)

Modules:

# ==== Sub module ====
mod_sub_ui <- function(id) {
  ns <- NS(id)
  fluidPage(
    fluidRow(
      column(6,
             actionButton(ns("add_user"), "Add User"),
             actionButton(ns("del_user"), "Delete User"))),
    hr(),
    fluidRow(
      DTOutput(ns("table_users"))
    )
  )
}

mod_sub_server <- function(id) {
  moduleServer(
    id,
    function(input, output, session) {
      ns <- session$ns
      # Sample user list
      user_df <- tibble::tribble(
        ~id, ~name,
        "user1", "Andrew",
        "user2", "Roshan",
        "user3", "Kraig",
        "user4", "Denny",
        "user5", "John"
      )
      
      rVals <- reactiveValues(
        user_data = NULL
      )
      
      observeEvent(input$add_user, {
        showModal(
          modalDialog(
            titel = "ADD USER",
            selectInput(ns("sel_user"), "Select User", choices = user_df$name),
            selectInput(ns("sel_role"), "Select Role", choices = c("ADMIN", "User")),
            footer = tagList(
              actionButton(ns("submit_user"), "Submit"),
              modalButton("Close")
            )
          ))
      })
      
      observeEvent(input$del_user, {
        showModal(
          modalDialog(
            titel = "DELETE USER",
            selectInput(ns("sel_user_del"), "Select User to Delete", choices = user_df$name),
            footer = tagList(
              actionButton(ns("delete_user"), "DELETE"),
              modalButton("Close")
            )
          ))
      })
      
      observeEvent(input$submit_user, {
        # browser()
        Name <- input$sel_user
        Role <- input$sel_role
        new_user <- tibble::tibble(Name, Role)
        rVals$user_data <- rbind(rVals$user_data, new_user)
        removeModal()
      })
      
      observeEvent(input$delete_user, {
        # browser()
        del_row <- which(rVals$user_data$Name == input$sel_user_del)
        rVals$user_data <- rVals$user_data[-del_row, ] 
        removeModal()
      })
      
      output$table_users <- renderDT(rVals$user_data)
      
    }
  )
}

# ==== Main module ====
mod_main_ui <- function(id) {
  ns <- NS(id)
  fluidPage(
    fluidRow(
      column(12, uiOutput(ns("tab_submodule")))
    )
  )
}

mod_main_server <- function(id, user_id, newIAM) {
  ns <- NS(id)
  mod_sub_server(ns("sub"))
  moduleServer(
    id,
    function(input, output, session) {
      ns <- session$ns
      output$tab_submodule <- renderUI({
        mod_sub_ui(ns("sub"))
      })
    }
  )
}

This topic was automatically closed 90 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.