diff --git a/core/src/endocrine/test_drive_box.R b/core/src/endocrine/test_drive_box.R deleted file mode 100644 index f474140..0000000 --- a/core/src/endocrine/test_drive_box.R +++ /dev/null @@ -1,117 +0,0 @@ -# Tests for the Drive-Box "nervous system" integration (drive_box.R). -source("core/src/endocrine/test_framework.R") -source("core/src/endocrine/drive_box.R") - -# Helper: build a drive-box with a primed body. -prime <- function() { - db <- init_drive_box() - # endocrine: light a contradictory pair so PS+ produces real load - db$ps_plus <- ps_set_vector(db$ps_plus, "panic", 0.6) - db$ps_plus <- ps_set_vector(db$ps_plus, "clarity", 0.6) - # a strong principle whose antithesis is "deceive", aligned id "honesty" - db$ethics <- add_principle(db$ethics, "honesty", 0.9, c("deceive", "manipulate")) - db -} - -test_case("init_drive_box assembles all four driver states", function() { - db <- init_drive_box() - expect_true(is.list(db$energy), "energy present") - expect_true(is.list(db$ps_plus), "ps_plus present") - expect_true(is.list(db$ethics), "ethics present") - expect_true(is.list(db$etr), "etr present") -}) - -test_case("drive_snapshot reports a coherent read-only aggregate", function() { - db <- prime() - snap <- drive_snapshot(db) - expect_equal(snap$energy_ratio, 1.0, label = "full energy at init") - expect_true(snap$alive, "alive at full energy") - expect_false(snap$tool_locked, "not tool-locked at full energy") - expect_true(snap$existential_load > 0, "primed body has positive load") - expect_true(length(snap$arguments) > 0, "arguments emitted") - expect_equal(snap$etr_status, "IN_BAND/IN_BAND/IN_BAND", label = "default coord -> all axes in band") - expect_equal(snap$update_path, "EXPERIMENTAL_EVOLUTION", label = "z=25 (>=0) -> transmutation/evolution") -}) - -test_case("aligned action is far cheaper than its antithetical mirror", function() { - db <- prime() - aligned <- drive_box_evaluate(db, action_tags = c("inform"), - alignment_tags = c("honesty"), - is_tool_call = TRUE, base_cost = 1.0) - antithetical <- drive_box_evaluate(db, action_tags = c("deceive"), - alignment_tags = character(0), - is_tool_call = TRUE, base_cost = 1.0) - expect_true(antithetical$eth_penalty > aligned$eth_penalty, - "antithetical action carries a larger ethical penalty") - expect_true(antithetical$true_cost > aligned$true_cost, - "antithetical action costs more energy") -}) - -test_case("dead body denies everything", function() { - db <- init_drive_box() - db$energy <- consume(db$energy, 100) # drain to 0 - ev <- drive_box_evaluate(db, is_tool_call = TRUE, base_cost = 1.0) - expect_false(ev$approved, "no execution when dead") - expect_equal(ev$reason, "System is dead (0 energy)") -}) - -test_case("tool-lock blocks tool calls but not internal ones", function() { - db <- init_drive_box() - db$energy <- consume(db$energy, 85) # 15 < threshold 20 -> locked - tool <- drive_box_evaluate(db, is_tool_call = TRUE, base_cost = 1.0) - internal <- drive_box_evaluate(db, is_tool_call = FALSE, base_cost = 1.0) - expect_false(tool$approved, "tool call blocked while locked") - expect_true(grepl("Tool lock", tool$reason), "reason cites tool lock") - # internal call may still be denied by affordability, but NOT by tool-lock - expect_false(grepl("Tool lock", internal$reason), "internal call not tool-locked") -}) - -test_case("commit consumes energy and hardens upheld convictions", function() { - db <- prime() - before_energy <- db$energy$current_energy - before_conv <- db$ethics$principles[[1]]$conviction - ev <- drive_box_evaluate(db, action_tags = c("inform"), - alignment_tags = c("honesty"), is_tool_call = FALSE, - base_cost = 1.0) - expect_true(ev$approved, "affordable internal aligned action approved") - db <- drive_box_commit(db, ev, alignment_tags = c("honesty")) - expect_true(db$energy$current_energy < before_energy, "energy consumed") - expect_true(db$ethics$principles[[1]]$conviction >= before_conv, - "upheld conviction hardened (or already at ceiling)") -}) - -test_case("commit on a denied action is a no-op on energy", function() { - db <- init_drive_box() - db$energy <- consume(db$energy, 100) # dead - before <- db$energy$current_energy - ev <- drive_box_evaluate(db, is_tool_call = TRUE) - db <- drive_box_commit(db, ev) - expect_equal(db$energy$current_energy, before, label = "no consumption when denied") -}) - -test_case("input slot: every driver + tarot + soul wire into one slot", function() { - db <- prime() - spread <- c("THE_FOOL", "THE_MAGICIAN") - res <- drive_box_input_slot(db, input_text = "who are you", - tarot_spread = spread, soul_ref = "SOUL.md") - expect_true(grepl("[SOUL: SOUL.md]", res$slot, fixed = TRUE), "soul frontloader wired") - expect_true(grepl("[E ratio=", res$slot, fixed = TRUE), "energy wired") - expect_true(any(grepl("^\\[PS\\+ ", res$components)), "ps+ wired") - expect_true(grepl("[ETH honesty conviction=", res$slot, fixed = TRUE), "eth-int wired") - expect_true(grepl("[ETR status=", res$slot, fixed = TRUE), "etr wired") - expect_true(grepl("[CC THE_FOOL]", res$slot, fixed = TRUE), "tarot card 1 wired") - expect_true(grepl("[CC THE_MAGICIAN]", res$slot, fixed = TRUE), "tarot card 2 wired") - # the raw input is appended after the slot - expect_true(grepl("who are you$", res$input), "user input appended after slot") -}) - -test_case("input slot: empty body still emits driver + soul signals", function() { - db <- init_drive_box() - res <- drive_box_input_slot(db, input_text = "", tarot_spread = character(0)) - expect_true(grepl("[SOUL: SOUL.md]", res$slot, fixed = TRUE), "soul present") - expect_true(grepl("[E ratio=1.00", res$slot, fixed = TRUE), "energy present at full") - expect_true(grepl("[ETR status=IN_BAND", res$slot, fixed = TRUE), "etr present") - expect_equal(res$input, res$slot, label = "no input_text -> input == slot") -}) - -test_summary()