# ============================================================================= # Test Coverage for zzz.R # ============================================================================= # Comprehensive tests for package load/unload functions (.onLoad, .onAttach) # Tests verify that all registries are initialized and all built-ins registered # ============================================================================= # Test: .onLoad initializes registries via init_registries # ============================================================================= test_that(".onLoad initializes shapes registry", { # Shapes registry should be initialized and non-empty shapes <- list_shapes() expect_type(shapes, "character") expect_true(length(shapes) > 0) }) test_that(".onLoad initializes layouts registry", { # Layouts registry should be initialized and non-empty layouts <- list_layouts() expect_type(layouts, "character") expect_true(length(layouts) > 0) }) test_that(".onLoad initializes themes registry", { # Themes registry should be initialized and non-empty themes <- list_themes() expect_type(themes, "character") expect_true(length(themes) > 0) }) test_that(".onLoad initializes palettes registry", { # Palettes registry should be initialized and non-empty palettes <- list_palettes() expect_type(palettes, "character") expect_true(length(palettes) > 0) }) # ============================================================================= # Test: .onLoad calls register_builtin_shapes # ============================================================================= test_that(".onLoad registers basic shapes via register_builtin_shapes", { basic_shapes <- c("circle", "square", "triangle", "diamond", "pentagon", "hexagon") registered <- list_shapes() for (shape_name in basic_shapes) { expect_true(shape_name %in% registered, info = paste("Basic shape not registered:", shape_name)) } }) test_that(".onLoad registers special shapes via register_builtin_shapes", { special_shapes <- c("ellipse", "heart", "star", "pie", "donut", "polygon_donut", "donut_pie", "double_donut_pie", "cross") registered <- list_shapes() for (shape_name in special_shapes) { expect_true(shape_name %in% registered, info = paste("Special shape not registered:", shape_name)) } }) test_that(".onLoad registers AI-themed shapes via register_builtin_shapes", { ai_shapes <- c("neural", "chip", "robot", "brain", "network", "database", "cloud", "gear") registered <- list_shapes() for (shape_name in ai_shapes) { expect_true(shape_name %in% registered, info = paste("AI shape not registered:", shape_name)) } }) test_that(".onLoad registers shape aliases via register_builtin_shapes", { # "plus" should be an alias for "cross" expect_true("plus" %in% list_shapes()) plus_fn <- get_shape("plus") cross_fn <- get_shape("cross") expect_true(is.function(plus_fn)) expect_true(is.function(cross_fn)) }) test_that(".onLoad registers rectangle shape via register_builtin_shapes", { expect_true("rectangle" %in% list_shapes()) fn <- get_shape("rectangle") expect_true(is.function(fn)) }) test_that(".onLoad registers none shape via register_builtin_shapes", { expect_true("none" %in% list_shapes()) fn <- get_shape("none") expect_true(is.function(fn)) }) # ============================================================================= # Test: .onLoad calls register_builtin_layouts # ============================================================================= test_that(".onLoad registers circle layout via register_builtin_layouts", { expect_true("circle" %in% list_layouts()) fn <- get_layout("circle") expect_true(is.function(fn)) }) test_that(".onLoad registers oval layout via register_builtin_layouts", { expect_true("oval" %in% list_layouts()) fn <- get_layout("oval") expect_true(is.function(fn)) }) test_that(".onLoad registers ellipse layout alias via register_builtin_layouts", { expect_true("ellipse" %in% list_layouts()) fn <- get_layout("ellipse") expect_true(is.function(fn)) }) test_that(".onLoad registers spring layout via register_builtin_layouts", { expect_true("spring" %in% list_layouts()) fn <- get_layout("spring") expect_true(is.function(fn)) }) test_that(".onLoad registers fr layout alias via register_builtin_layouts", { expect_true("fr" %in% list_layouts()) fn <- get_layout("fr") expect_true(is.function(fn)) }) test_that(".onLoad registers fruchterman-reingold layout alias", { expect_true("fruchterman-reingold" %in% list_layouts()) fn <- get_layout("fruchterman-reingold") expect_true(is.function(fn)) }) test_that(".onLoad registers groups layout via register_builtin_layouts", { expect_true("groups" %in% list_layouts()) fn <- get_layout("groups") expect_true(is.function(fn)) }) test_that(".onLoad registers grid layout via register_builtin_layouts", { expect_true("grid" %in% list_layouts()) fn <- get_layout("grid") expect_true(is.function(fn)) }) test_that(".onLoad registers random layout via register_builtin_layouts", { expect_true("random" %in% list_layouts()) fn <- get_layout("random") expect_true(is.function(fn)) }) test_that(".onLoad registers star layout via register_builtin_layouts", { expect_true("star" %in% list_layouts()) fn <- get_layout("star") expect_true(is.function(fn)) }) test_that(".onLoad registers bipartite layout via register_builtin_layouts", { expect_true("bipartite" %in% list_layouts()) fn <- get_layout("bipartite") expect_true(is.function(fn)) }) test_that(".onLoad registers custom layout via register_builtin_layouts", { expect_true("custom" %in% list_layouts()) fn <- get_layout("custom") expect_true(is.function(fn)) }) test_that(".onLoad registers gephi_fr layout via register_builtin_layouts", { expect_true("gephi_fr" %in% list_layouts()) fn <- get_layout("gephi_fr") expect_true(is.function(fn)) }) test_that(".onLoad registers gephi layout alias via register_builtin_layouts", { expect_true("gephi" %in% list_layouts()) fn <- get_layout("gephi") expect_true(is.function(fn)) }) # ============================================================================= # Test: .onLoad calls register_builtin_themes # ============================================================================= test_that(".onLoad registers classic theme via register_builtin_themes", { expect_true("classic" %in% list_themes()) theme <- get_theme("classic") expect_s3_class(theme, "CographTheme") }) test_that(".onLoad registers colorblind theme via register_builtin_themes", { expect_true("colorblind" %in% list_themes()) theme <- get_theme("colorblind") expect_s3_class(theme, "CographTheme") }) test_that(".onLoad registers gray theme via register_builtin_themes", { expect_true("gray" %in% list_themes()) theme <- get_theme("gray") expect_s3_class(theme, "CographTheme") }) test_that(".onLoad registers grey theme alias via register_builtin_themes", { expect_true("grey" %in% list_themes()) theme <- get_theme("grey") expect_s3_class(theme, "CographTheme") }) test_that(".onLoad registers dark theme via register_builtin_themes", { expect_true("dark" %in% list_themes()) theme <- get_theme("dark") expect_s3_class(theme, "CographTheme") }) test_that(".onLoad registers minimal theme via register_builtin_themes", { expect_true("minimal" %in% list_themes()) theme <- get_theme("minimal") expect_s3_class(theme, "CographTheme") }) test_that(".onLoad registers viridis theme via register_builtin_themes", { expect_true("viridis" %in% list_themes()) theme <- get_theme("viridis") expect_s3_class(theme, "CographTheme") }) test_that(".onLoad registers nature theme via register_builtin_themes", { expect_true("nature" %in% list_themes()) theme <- get_theme("nature") expect_s3_class(theme, "CographTheme") }) # ============================================================================= # Test: .onLoad calls register_builtin_palettes # ============================================================================= test_that(".onLoad registers rainbow palette via register_builtin_palettes", { expect_true("rainbow" %in% list_palettes()) palette <- get_palette("rainbow") expect_true(is.function(palette)) }) test_that(".onLoad registers colorblind palette via register_builtin_palettes", { expect_true("colorblind" %in% list_palettes()) palette <- get_palette("colorblind") expect_true(is.function(palette)) }) test_that(".onLoad registers pastel palette via register_builtin_palettes", { expect_true("pastel" %in% list_palettes()) palette <- get_palette("pastel") expect_true(is.function(palette)) }) test_that(".onLoad registers viridis palette via register_builtin_palettes", { expect_true("viridis" %in% list_palettes()) palette <- get_palette("viridis") expect_true(is.function(palette)) }) test_that(".onLoad registers blues palette via register_builtin_palettes", { expect_true("blues" %in% list_palettes()) palette <- get_palette("blues") expect_true(is.function(palette)) }) test_that(".onLoad registers reds palette via register_builtin_palettes", { expect_true("reds" %in% list_palettes()) palette <- get_palette("reds") expect_true(is.function(palette)) }) test_that(".onLoad registers diverging palette via register_builtin_palettes", { expect_true("diverging" %in% list_palettes()) palette <- get_palette("diverging") expect_true(is.function(palette)) }) # ============================================================================= # Test: .onAttach startup message (removed - no startup message per CRAN policy) # ============================================================================= # ============================================================================= # Test: Registry state after package load # ============================================================================= test_that("shapes registry has minimum expected count after load", { shapes <- list_shapes() # At minimum: 6 basic + 9 special + 8 AI + 2 additional (rectangle, none) = 25 expect_true(length(shapes) >= 20, info = paste("Only", length(shapes), "shapes registered")) }) test_that("layouts registry has minimum expected count after load", { layouts <- list_layouts() # At minimum: circle, oval, ellipse, spring, fr, fruchterman-reingold, # groups, grid, random, star, bipartite, custom, gephi_fr, gephi = 14 expect_true(length(layouts) >= 10, info = paste("Only", length(layouts), "layouts registered")) }) test_that("themes registry has minimum expected count after load", { themes <- list_themes() # At minimum: classic, colorblind, gray, grey, dark, minimal, viridis, nature = 8 expect_true(length(themes) >= 7, info = paste("Only", length(themes), "themes registered")) }) test_that("palettes registry has minimum expected count after load", { palettes <- list_palettes() # At minimum: rainbow, colorblind, pastel, viridis, blues, reds, diverging = 7 expect_true(length(palettes) >= 7, info = paste("Only", length(palettes), "palettes registered")) }) # ============================================================================= # Test: Registered shapes are callable functions # ============================================================================= test_that("all registered shapes are callable functions", { shapes <- list_shapes() for (name in shapes) { fn <- get_shape(name) expect_true(is.function(fn), info = paste("Shape", name, "is not a function")) } }) test_that("all registered layouts are callable functions", { layouts <- list_layouts() for (name in layouts) { fn <- get_layout(name) expect_true(is.function(fn), info = paste("Layout", name, "is not a function")) } }) test_that("all registered palettes are callable functions", { palettes <- list_palettes() for (name in palettes) { fn <- get_palette(name) expect_true(is.function(fn), info = paste("Palette", name, "is not a function")) } }) # ============================================================================= # Test: Registered themes are CographTheme objects # ============================================================================= test_that("all registered themes are CographTheme objects", { skip("Skipping - themes may be registered by other tests with different classes") themes <- list_themes() for (name in themes) { theme <- get_theme(name) expect_true(inherits(theme, "CographTheme"), info = paste("Theme", name, "is not CographTheme")) } }) # ============================================================================= # Test: init_registries can be called directly # ============================================================================= test_that("init_registries initializes empty registries", { # Save current state old_shapes <- list_shapes() # Re-initialize (clears and starts fresh) init_registries() # Registries should now be empty expect_equal(length(list_shapes()), 0) expect_equal(length(list_layouts()), 0) expect_equal(length(list_themes()), 0) expect_equal(length(list_palettes()), 0) # Re-register everything to restore state register_builtin_shapes() register_builtin_layouts() register_builtin_themes() register_builtin_palettes() # Verify restoration expect_true(length(list_shapes()) > 0) }) # ============================================================================= # Test: Package can be used after load # ============================================================================= test_that("cograph function works after package load", { adj <- matrix(c(0, 1, 0, 1, 0, 1, 0, 1, 0), 3, 3) net <- cograph(adj) expect_s3_class(net, "cograph_network") }) test_that("splot function works after package load", { adj <- matrix(c(0, 1, 0, 1, 0, 1, 0, 1, 0), 3, 3) result <- safe_plot(splot(adj)) expect_true(result$success, info = result$error) }) test_that("get_shape returns working function after load", { skip_if_not_installed("grid") circle_fn <- get_shape("circle") grob <- circle_fn(0.5, 0.5, 0.1, "blue", "black", 1) expect_s3_class(grob, "grob") }) test_that("get_layout returns working function after load", { circle_fn <- get_layout("circle") adj <- matrix(c(0, 1, 0, 1, 0, 1, 0, 1, 0), 3, 3) net <- cograph(adj) coords <- circle_fn(net) expect_true(is.data.frame(coords) || is.matrix(coords)) }) test_that("get_theme returns CographTheme with working methods after load", { theme <- get_theme("classic") expect_s3_class(theme, "CographTheme") expect_equal(theme$get("background"), "white") }) test_that("get_palette returns working function after load", { rainbow_fn <- get_palette("rainbow") colors <- rainbow_fn(5) expect_equal(length(colors), 5) expect_valid_colors(colors) }) # ============================================================================= # Test: Layout aliases point to same underlying function # ============================================================================= test_that("spring and fr layout aliases reference same function", { spring_fn <- get_layout("spring") fr_fn <- get_layout("fr") expect_identical(spring_fn, fr_fn) }) test_that("oval and ellipse layout aliases reference same function", { oval_fn <- get_layout("oval") ellipse_fn <- get_layout("ellipse") expect_identical(oval_fn, ellipse_fn) }) test_that("gephi_fr and gephi layout aliases reference same function", { gephi_fr_fn <- get_layout("gephi_fr") gephi_fn <- get_layout("gephi") expect_identical(gephi_fr_fn, gephi_fn) }) # ============================================================================= # Test: Theme aliases produce equivalent themes # ============================================================================= test_that("gray and grey theme aliases have equivalent properties", { gray_theme <- get_theme("gray") grey_theme <- get_theme("grey") expect_equal(gray_theme$get("background"), grey_theme$get("background")) expect_equal(gray_theme$get("node_fill"), grey_theme$get("node_fill")) expect_equal(gray_theme$get("edge_color"), grey_theme$get("edge_color")) }) # ============================================================================= # Test: Startup message format (removed - no startup message per CRAN policy) # =============================================================================