From f27bae0f642f81b0fed5fee7967ce34531749408 Mon Sep 17 00:00:00 2001
From: Rich FitzJohn <r.fitzjohn@imperial.ac.uk>
Date: Mon, 18 Dec 2023 13:51:13 +0000
Subject: [PATCH] Use global validation on task load

---
 R/environment.R                       | 29 +++++++++++++++++++++++++++
 R/task.R                              |  1 +
 tests/testthat/test-task-expression.R | 29 +++++++++++++++++++++++++--
 3 files changed, 57 insertions(+), 2 deletions(-)

diff --git a/R/environment.R b/R/environment.R
index 7c026fc6..f48e15c8 100644
--- a/R/environment.R
+++ b/R/environment.R
@@ -220,3 +220,32 @@ discover_globals <- function(name, packages, sources, root) {
   cli::cli_alert_success("Found {n} {cli::qty(n)}symbol{?s}")
   res
 }
+
+
+check_globals <- function(globals, envir, call = call) {
+  if (length(globals) == 0) {
+    return()
+  }
+  values <- rlang::env_get_list(envir, names(globals), inherit = TRUE,
+                                last = topenv())
+  hashes <- vcapply(values, rlang::hash)
+  err <- hashes != globals
+  if (any(err)) {
+    nms <- names(globals)[err]
+    n <- length(err)
+    hint <-
+    cli::cli_abort(
+      c("Unexpected value{?s} for global variable{?s}: {squote(nms)}",
+        i = paste(
+          "{cli::qty(n)}When we loaded your environment to run this task,",
+          "the value of {?this variable/these variables} differed from the",
+          "value we saw when saving the task originally.",
+          "{?This variable/These variables} were likely created when",
+          "sourcing your environment source scripts, so it's possible",
+          "that you changed these scripts since creating the task?"),
+        i = paste(
+          "Disable this check at task creation by setting the option",
+          "'hipercow.validate_globals' to FALSE")),
+      call = call)
+  }
+}
diff --git a/R/task.R b/R/task.R
index b485373d..c996d7d7 100644
--- a/R/task.R
+++ b/R/task.R
@@ -164,6 +164,7 @@ task_eval <- function(id, envir = .GlobalEnv, root = NULL) {
 
   result <- rlang::try_fetch({
     environment_apply(data$environment, envir, root, top)
+    check_globals(data$variables$globals, envir, top)
     withr::local_dir(file.path(root$path$root, data$path))
     switch(
       data$type,
diff --git a/tests/testthat/test-task-expression.R b/tests/testthat/test-task-expression.R
index c344b357..0059dacb 100644
--- a/tests/testthat/test-task-expression.R
+++ b/tests/testthat/test-task-expression.R
@@ -120,7 +120,7 @@ test_that("error on double quote", {
 test_that("can run a task that uses variable from globals", {
   path <- withr::local_tempfile()
   root <- init_quietly(path)
-  writeLines(c("a <- 1", "b <- 2"), file.path(path, "src.R"))
+  writeLines("a <- 1", file.path(path, "src.R"))
   suppressMessages(
     hipercow_environment_create("foo", sources = "src.R", globals = "a",
                                 root = path))
@@ -143,7 +143,7 @@ test_that("can run a task that uses variable from globals", {
 test_that("can save information for global validation", {
   path <- withr::local_tempfile()
   root <- init_quietly(path)
-  writeLines(c("a <- 1", "b <- 2"), file.path(path, "src.R"))
+  writeLines("a <- 1", file.path(path, "src.R"))
   suppressMessages(
     hipercow_environment_create("foo", sources = "src.R", globals = "a",
                                 root = path))
@@ -164,3 +164,28 @@ test_that("can save information for global validation", {
   expect_equal(d$variables,
                list(locals = list(b = 2), globals = c(a = rlang::hash(a))))
 })
+
+
+test_that("can validate globals on load", {
+  path <- withr::local_tempfile()
+  root <- init_quietly(path)
+  writeLines("a <- 2", file.path(path, "src.R"))
+  suppressMessages(
+    hipercow_environment_create("foo", sources = "src.R", globals = "a",
+                                root = path))
+
+  a <- 2
+  withr::local_options(hipercow.validate_globals = TRUE)
+  id1 <- withr::with_dir(path,
+                         task_create_expr(sqrt(a), environment = "foo"))
+  id2 <- withr::with_dir(path,
+                         task_create_expr(sqrt(a), environment = "foo"))
+
+  env <- new.env(parent = topenv())
+  expect_true(task_eval(id1, env, root = path))
+  expect_equal(task_result(id1, root = path), sqrt(2))
+  writeLines("a <- 3", file.path(path, "src.R"))
+  expect_false(task_eval(id2, env, root = path))
+  err <- task_result(id2, root = path)
+  expect_match(err$message, "Unexpected value for global variable: 'a'")
+})