Skip to content

Error when recording tests in an app with sub-modules #390

@NanduKrishnan-H

Description

@NanduKrishnan-H

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"))
      })
    }
  )
}

Does anyone have any ideas for resolving this issue?

Metadata

Metadata

Assignees

No one assigned

    Labels

    No labels
    No labels

    Type

    No type

    Projects

    No projects

    Milestone

    No milestone

    Relationships

    None yet

    Development

    No branches or pull requests

    Issue actions