# ────────────────────────────────────────────────────────────────────────────── # disco_method() # ────────────────────────────────────────────────────────────────────────────── test_that("disco_method builds a closure with correct classes and private env", { # fake builder that records the knowledge it was called with make_builder <- function() { function(k) { e <- new.env(parent = emptyenv()) e$k <- k list( set_knowledge = function(knowledge) { e$k <- knowledge invisible(NULL) }, run = function(data) { list(data = data, knowledge = e$k) } ) } } builder <- make_builder() m <- disco_method(builder, method_class = "pc") # classes expect_s3_class(m, c("pc", "disco_method", "function")) # private env has builder and NULL knowledge env <- environment(m) expect_true(is.function(env$builder)) expect_null(env$knowledge) # data guard expect_error(m(1:3), "`data` must be a data frame.", fixed = TRUE) # when called, passes env$knowledge (NULL) to builder and returns runner$run() my_df <- data.frame(x = 1:3, y = 3:1) out <- m(my_df) expect_type(out, "list") expect_identical(out$knowledge, NULL) expect_identical(out$data, my_df) }) # ────────────────────────────────────────────────────────────────────────────── # set_knowledge() # ────────────────────────────────────────────────────────────────────────────── test_that("set_knowledge.disco_method returns a new method that injects knowledge", { # fake builder with capturable knowledge flow make_builder <- function() { function(k) { e <- new.env(parent = emptyenv()) e$k <- k list( set_knowledge = function(knowledge) { e$k <- knowledge invisible(NULL) }, run = function(data) { list(data = data, knowledge = e$k) } ) } } builder <- make_builder() m <- disco_method(builder, "pc") # original method remains knowledge-free my_df <- data.frame(a = 1:2, b = 2:1) out0 <- m(my_df) expect_null(out0$knowledge) # set knowledge -> returns a new disco_method preserving class kn <- list(tag = "my-knowledge") m2 <- set_knowledge(m, kn) expect_s3_class(m2, c("pc", "disco_method", "function")) # the new method injects knowledge via runner$set_knowledge() out1 <- m2(my_df) expect_identical(out1$knowledge, kn) # the original method is unchanged (immutability check) out2 <- m(my_df) expect_null(out2$knowledge) }) test_that("set_knowledge wrapped method still validates data.frame input", { # mocking a builder builder <- function(k) { e <- new.env(parent = emptyenv()) e$k <- k list( set_knowledge = function(knowledge) { e$k <- knowledge invisible(NULL) }, run = function(data) { list(data = data, knowledge = e$k) } ) } m <- disco_method(builder, "pc") m2 <- set_knowledge(m, list(foo = "bar")) expect_error(m2(1:5), "`data` must be a data frame.", fixed = TRUE) })