diff --git a/tests/testthat/test-shinytest2-tm_t_pp_laboratory.R b/tests/testthat/test-shinytest2-tm_t_pp_laboratory.R new file mode 100644 index 0000000000..0ed9495981 --- /dev/null +++ b/tests/testthat/test-shinytest2-tm_t_pp_laboratory.R @@ -0,0 +1,384 @@ +app_driver_tm_t_pp_laboratory <- function() { + data <- teal.data::teal_data() + data <- within(data, { + ADSL <- teal.data::rADSL + ADLB <- teal.data::rADLB + }) + + datanames <- c("ADSL", "ADLB") + teal.data::datanames(data) <- datanames + teal.data::join_keys(data) <- teal.data::default_cdisc_join_keys[datanames] + + init_teal_app_driver( + data = data, + modules = tm_t_pp_laboratory( + label = "Vitals", + dataname = "ADLB", + parentname = "ADSL", + patient_col = "USUBJID", + paramcd = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADLB"]], c("PARAMCD", "STUDYID")), + selected = "PARAMCD" + ), + param = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADLB"]], c("PARAM", "SEX")), + selected = "PARAM" + ), + timepoints = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADLB"]], c("ADY", "AGE")), + selected = "ADY" + ), + anrind = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADLB"]], c("ANRIND", "AGEU")), + selected = "ANRIND" + ), + aval_var = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADLB"]], c("AVAL", "AGE")), + selected = "AVAL" + ), + avalu_var = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADLB"]], c("AVALU", "SEX")), + selected = "AVALU" + ), + pre_output = NULL, + post_output = NULL + ) + ) +} + +testthat::test_that("e2e - tm_t_pp_laboratory: Module initializes in teal without errors and produces table output.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_laboratory() + app_driver$expect_no_shiny_error() + app_driver$expect_no_validation_error() + testthat::expect_true( + app_driver$is_visible(app_driver$active_module_element("lab_values_table")) + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_pp_laboratory: Starts with specified label, patient_id, paramcd, param, + timepoints, aval_var, avalu_var, anrind, round_value", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_laboratory() + + testthat::expect_equal( + app_driver$get_text("#teal-main_ui-root-active_tab > li.active > a"), + "Vitals" + ) + testthat::expect_equal( + app_driver$get_active_module_input("patient_id"), + "AB12345-CHN-3-id-128" + ) + testthat::expect_equal( + app_driver$get_active_module_input("paramcd-dataset_ADLB_singleextract-select"), + "PARAMCD" + ) + testthat::expect_equal( + app_driver$get_active_module_input("param-dataset_ADLB_singleextract-select"), + "PARAM" + ) + testthat::expect_equal( + app_driver$get_active_module_input("timepoints-dataset_ADLB_singleextract-select"), + "ADY" + ) + testthat::expect_equal( + app_driver$get_active_module_input("aval_var-dataset_ADLB_singleextract-select"), + "AVAL" + ) + testthat::expect_equal( + app_driver$get_active_module_input("avalu_var-dataset_ADLB_singleextract-select"), + "AVALU" + ) + testthat::expect_equal( + app_driver$get_active_module_input("anrind-dataset_ADLB_singleextract-select"), + "ANRIND" + ) + testthat::expect_equal( + app_driver$get_active_module_input("round_value"), + "4" + ) + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_t_pp_laboratory: Selecting patient_id changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_laboratory() + table_before <- rvest::html_table( + app_driver$get_html_rvest(app_driver$active_module_element("lab_values_table")) + )[[2]] + app_driver$set_active_module_input("patient_id", "AB12345-USA-1-id-261") + testthat::expect_false( + identical( + table_before, + rvest::html_table(app_driver$get_html_rvest(app_driver$active_module_element("lab_values_table")))[[2]] + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_pp_laboratory: Deselection of patient_id throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_laboratory() + app_driver$set_active_module_input("patient_id", NULL) + testthat::expect_false( + app_driver$is_visible( + app_driver$active_module_element("lab_values_table"), + visibility_property = TRUE + ) + ) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text("patient_id_input .shiny-validation-message"), + "Please select a patient" + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_pp_laboratory: Selecting paramcd-level changes the table + and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_laboratory() + table_before <- rvest::html_table( + app_driver$get_html_rvest(app_driver$active_module_element("lab_values_table")) + )[[2]] + app_driver$set_active_module_input("paramcd-dataset_ADLB_singleextract-select", "STUDYID") + testthat::expect_false( + identical( + table_before, + rvest::html_table(app_driver$get_html_rvest(app_driver$active_module_element("lab_values_table")))[[2]] + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_pp_laboratory: Deselection of paramcd-level throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_laboratory() + app_driver$set_active_module_input("paramcd-dataset_ADLB_singleextract-select", NULL) + testthat::expect_false( + app_driver$is_visible( + app_driver$active_module_element("lab_values_table"), + visibility_property = TRUE + ) + ) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text("paramcd-dataset_ADLB_singleextract-select_input .shiny-validation-message"), + "Please select PARAMCD variable." + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_pp_laboratory: Selecting param-variable changes the table + and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_laboratory() + table_before <- rvest::html_table( + app_driver$get_html_rvest(app_driver$active_module_element("lab_values_table")) + )[[2]] + app_driver$set_active_module_input("param-dataset_ADLB_singleextract-select", "SEX") + testthat::expect_false( + identical( + table_before, + rvest::html_table(app_driver$get_html_rvest(app_driver$active_module_element("lab_values_table")))[[2]] + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_t_pp_laboratory: Deselection of param-variable throws validation error.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_laboratory() + app_driver$set_active_module_input("param-dataset_ADLB_singleextract-select", NULL) + testthat::expect_false( + app_driver$is_visible( + app_driver$active_module_element("lab_values_table"), + visibility_property = TRUE + ) + ) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text("param-dataset_ADLB_singleextract-select_input .shiny-validation-message"), + "Please select PARAM variable." + ) + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_t_pp_laboratory: Selecting timepoints-variable changes the table + and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_laboratory() + table_before <- rvest::html_table( + app_driver$get_html_rvest(app_driver$active_module_element("lab_values_table")) + )[[2]] + app_driver$set_active_module_input("timepoints-dataset_ADLB_singleextract-select", "AGE") + testthat::expect_false( + identical( + table_before, + rvest::html_table(app_driver$get_html_rvest(app_driver$active_module_element("lab_values_table")))[[2]] + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_pp_laboratory: Deselection of timepoints-variable throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_laboratory() + app_driver$set_active_module_input("timepoints-dataset_ADLB_singleextract-select", NULL) + testthat::expect_false( + app_driver$is_visible( + app_driver$active_module_element("lab_values_table"), + visibility_property = TRUE + ) + ) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text( + "timepoints-dataset_ADLB_singleextract-select_input .shiny-validation-message" + ), + "Please select timepoints variable." + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_pp_laboratory: Selecting avalu-variable changes the table + and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_laboratory() + table_before <- rvest::html_table( + app_driver$get_html_rvest(app_driver$active_module_element("lab_values_table")) + )[[2]] + app_driver$set_active_module_input("avalu_var-dataset_ADLB_singleextract-select", "SEX") + testthat::expect_false( + identical( + table_before, + rvest::html_table(app_driver$get_html_rvest(app_driver$active_module_element("lab_values_table")))[[2]] + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_pp_laboratory: Deselection of avalu-variable throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_laboratory() + app_driver$set_active_module_input("avalu_var-dataset_ADLB_singleextract-select", NULL) + testthat::expect_false( + app_driver$is_visible( + app_driver$active_module_element("lab_values_table"), + visibility_property = TRUE + ) + ) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text( + "avalu_var-dataset_ADLB_singleextract-select_input .shiny-validation-message" + ), + "Please select AVALU variable." + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_pp_laboratory: Selecting aval_var-variable changes the table + and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_laboratory() + table_before <- rvest::html_table( + app_driver$get_html_rvest(app_driver$active_module_element("lab_values_table")) + )[[2]] + app_driver$set_active_module_input("aval_var-dataset_ADLB_singleextract-select", "AGE") + testthat::expect_false( + identical( + table_before, + rvest::html_table(app_driver$get_html_rvest(app_driver$active_module_element("lab_values_table")))[[2]] + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_pp_laboratory: Deselection of aval_var-variable throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_laboratory() + app_driver$set_active_module_input("aval_var-dataset_ADLB_singleextract-select", NULL) + testthat::expect_false( + app_driver$is_visible( + app_driver$active_module_element("lab_values_table"), + visibility_property = TRUE + ) + ) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text("aval_var-dataset_ADLB_singleextract-select_input .shiny-validation-message"), + "Please select AVAL variable." + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_pp_laboratory: Selecting arind-variable changes the table + and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_laboratory() + table_before <- rvest::html_table( + app_driver$get_html_rvest(app_driver$active_module_element("lab_values_table")) + )[[2]] + app_driver$set_active_module_input("anrind-dataset_ADLB_singleextract-select", "AGEU") + testthat::expect_false( + identical( + table_before, + rvest::html_table(app_driver$get_html_rvest(app_driver$active_module_element("lab_values_table")))[[2]] + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_pp_laboratory: Deselection of arind-variable throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_laboratory() + app_driver$set_active_module_input("anrind-dataset_ADLB_singleextract-select", NULL) + testthat::expect_false( + app_driver$is_visible( + app_driver$active_module_element("lab_values_table"), + visibility_property = TRUE + ) + ) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text("anrind-dataset_ADLB_singleextract-select_input .shiny-validation-message"), + "Please select ANRIND variable." + ) + app_driver$stop() +})