From 69e84f0ed657638d152918392f33e875ee400d58 Mon Sep 17 00:00:00 2001
From: hornik <hornik@00db46b3-68df-0310-9c12-caf00c1e9a41>
Date: Fri, 14 Feb 2025 12:11:10 +0000
Subject: [PATCH] Add namespace_loads_from_file_load().

git-svn-id: https://svn.r-project.org/R/trunk@87717 00db46b3-68df-0310-9c12-caf00c1e9a41
---
 src/library/tools/R/utils.R | 43 +++++++++++++++++++++++++++++++++++++
 1 file changed, 43 insertions(+)

diff --git a/src/library/tools/R/utils.R b/src/library/tools/R/utils.R
index 5904d50752..e17f3f6f48 100644
--- a/src/library/tools/R/utils.R
+++ b/src/library/tools/R/utils.R
@@ -2878,6 +2878,49 @@ function(ch, default = TRUE, logical = TRUE, otherwise = default, n = 2L)
         ch
 }
 
+### **
+
+namespace_loads_from_file_load <-
+function(f, verbose = FALSE)
+{
+    if(verbose) message(sprintf("processing %s", f))
+
+    fun <- local({
+        make_namespace_load_tracer <- function() {
+            local({
+                .packages <- character()
+                .nframes <- integer()
+                function(p, n) {
+                    .packages <<- c(.packages, p)
+                    .nframes <<- c(.nframes, n)
+                }
+            })
+        }
+        trace_namespace_loads <- function(expr, tracer) {
+            ..namespace_load_tracer <- tracer
+            suppressMessages({
+                trace(base::loadNamespace,
+                      function() {
+                          pkg <- as.character(parent.frame()$package)
+                          dynGet("..namespace_load_tracer")(pkg[[1L]],
+                              sys.nframe())
+                      },
+                      print = FALSE)
+            })
+            on.exit(suppressMessages(untrace(base::loadNamespace)))
+            expr
+        }
+        function(file) {
+            tracer <- make_namespace_load_tracer()
+            tmpenv <- new.env()
+            trace_namespace_loads(load(file, tmpenv), tracer)
+            with(environment(tracer),
+                 .packages[.nframes == min(.nframes)])
+        }
+    })
+
+    R(fun, list(f))
+}
 
 ### Local variables: ***
 ### mode: outline-minor ***