test_that("dm_zoom_to() works", { # no zoom in unzoomed `dm` expect_false( is_zoomed(dm_for_filter()) ) # zoom in zoomed `dm` expect_true( is_zoomed(dm_for_filter() %>% dm_zoom_to(tf_1)) ) expect_s3_class( dm_for_filter() %>% dm_zoom_to(tf_3), c("dm_zoomed", "dm") ) }) test_that("dm_discard_zoomed() works", { # no zoom in zoomed out from zoomed `dm` expect_false(is_zoomed(dm_for_filter() %>% dm_zoom_to(tf_1) %>% dm_discard_zoomed())) expect_s3_class( dm_for_filter() %>% dm_zoom_to(tf_3) %>% dm_discard_zoomed(), c("dm") ) }) test_that("print() and format() methods for subclass `dm_zoomed` work", { expect_snapshot( dm_for_filter() %>% dm_zoom_to(tf_5) %>% as_dm_zoomed_df() %>% tbl_sum() ) expect_snapshot( dm_for_filter() %>% dm_zoom_to(tf_2) %>% as_dm_zoomed_df() %>% tbl_sum() ) }) test_that("dm_get_zoom() and tbl_zoomed() works", { expect_identical( dm_for_filter() %>% dm_zoom_to(tf_2) %>% dm_get_zoom() %>% pluck("table"), "tf_2" ) expect_equivalent_tbl( dm_for_filter() %>% dm_zoom_to(tf_2) %>% dm_get_zoom() %>% pluck("zoom") %>% pluck(1), tf_2() ) # function for getting only the tibble itself works expect_equivalent_tbl( dm_for_filter() %>% dm_zoom_to(tf_3) %>% tbl_zoomed(), tf_3() ) }) test_that("dm_insert_zoomed() works", { # test that a new tbl is inserted, based on the requested one expect_equivalent_dm( dm_zoom_to(dm_for_filter(), tf_4) %>% dm_insert_zoomed("tf_4_new"), dm_for_filter() %>% dm(tf_4_new = tf_4()) %>% dm_add_pk(tf_4_new, h) %>% dm_add_fk(tf_4_new, c(j, j1), tf_3) %>% dm_add_fk(tf_5, l, tf_4_new, on_delete = "cascade") ) # test that an error is thrown if 'repair = check_unique' and duplicate table names expect_dm_error( dm_zoom_to(dm_for_filter(), tf_4) %>% dm_insert_zoomed("tf_4", repair = "check_unique"), "need_unique_names" ) # test that in case of 'repair = unique' and duplicate table names -> renames of old and new expect_equivalent_dm( # FIXME: This produced occasional warnings on GitHub Actions, why? dm_for_filter() %>% dm_zoom_to(tf_4) %>% dm_insert_zoomed("tf_4", repair = "unique", quiet = TRUE), dm_for_filter() %>% dm_rename_tbl(tf_4...4 = tf_4) %>% dm(tf_4...7 = tf_4()) %>% dm_add_pk(tf_4...7, h) %>% dm_add_fk(tf_4...7, c(j, j1), tf_3) %>% dm_add_fk(tf_5, l, tf_4...7, on_delete = "cascade") ) }) test_that("dm_update_tbl() works", { # setting table tf_7 as zoomed table for tf_6 and removing its primary key and foreign keys pointing to it new_dm_for_filter <- dm_get_def(dm_for_filter()) %>% mutate( zoom = if_else(table == "tf_6", list(tf_7()), list(NULL)), col_tracker_zoom = if_else(table == "tf_6", list(character()), list(NULL)), ) %>% dm_from_def(zoomed = TRUE) # test that the old table is updated correctly expect_equivalent_dm( dm_update_zoomed(new_dm_for_filter), dm_for_filter() %>% dm_select_tbl(-tf_6) %>% dm(tf_6 = tf_7()) ) }) # after #271: test_that("all cols are tracked in zoomed table", { expect_identical( dm_nycflights_small() %>% dm_zoom_to(flights) %>% col_tracker_zoomed(), set_names(colnames(dm_nycflights_small()$flights)) ) }) # tests for compound keys ------------------------------------------------- test_that("zoom output for compound keys", { # FIXME: COMPOUND: Need proper test skip_if_remote_src() expect_snapshot({ nyc_comp() %>% dm_zoom_to(weather) nyc_comp() %>% dm_zoom_to(weather) %>% dm_update_zoomed() nyc_comp_2 <- nyc_comp() %>% dm_zoom_to(weather) %>% dm_insert_zoomed("weather_2") nyc_comp_2 %>% get_all_keys() attr(igraph::E(create_graph_from_dm(nyc_comp_2)), "vnames") nyc_comp_3 <- nyc_comp() %>% dm_zoom_to(flights) %>% dm_insert_zoomed("flights_2") nyc_comp_3 %>% get_all_keys() attr(igraph::E(create_graph_from_dm(nyc_comp_3)), "vnames") }) }) test_that("dm_get_zoom() works to zoom on empty tables", { zdm <- dm(x = tibble()) %>% dm_zoom_to(x) expect_identical( dm_get_zoom(zdm), tibble(table = "x", zoom = list(tibble())) ) }) # test that inserting a zoomed table retains the color -------------------- test_that("dm_insert_zoomed() retains color", { expect_identical( dm_for_filter() %>% dm_set_colors("cyan" = tf_2) %>% dm_zoom_to(tf_2) %>% dm_insert_zoomed("tf_2_new") %>% dm_get_def() %>% filter(table == "tf_2_new") %>% pull(display), "#00FFFFFF" ) })