find the .External() call when rewriting module function formals

Author: kevinushey

ChangeLog

@@ -12,6 +12,12 @@
 	* inst/tinytest/test_internal_function.R: Idem
 	* inst/tinytest/test_internal_function_cpp11.R: Idem
 
+	* R/00_classes.R (.cppfunction_formals_gets): Find the .External() call
+	in the body of the function instead of assuming it is the second
+	element, which it is not once coverage tools have instrumented the body
+	* R/00_classes.R (.cppfunction_set_external_args): New helper
+	* inst/tinytest/test_module.R: Test it with an instrumented body
+
 2026-10-23  Dirk Eddelbuettel  <edd@debian.org>
 
 	* DESCRIPTION (Version, Date): Roll micro version and date

R/00_classes.R

@@ -117,13 +117,23 @@ setClass( "C++Function",
 	contains = "function"
 )
 
-.cppfunction_formals_gets <- function (fun, envir = environment(fun), value) {
-    bd <- body(fun)
-    b2 <- bd[[2L]]
-    for( i in seq_along(value) ){
-        b2[[3L+i]] <- as.name( names(value)[i] )
+## passes the arguments named in 'names' on from the .External(entry,
+## pointer, ...) call in expr; the call is searched for rather than assumed
+## to be a top-level statement, as coverage tools wrap each statement
+.cppfunction_set_external_args <- function( expr, names ){
+    if( !is.call( expr ) )
+        return( expr )
+    if( identical( expr[[1L]], as.name( ".External" ) ) )
+        return( as.call( c( as.list( expr )[1:3], lapply( names, as.name ) ) ) )
+    for( i in seq_along( expr )[-1L] ){
+        if( is.call( expr[[i]] ) )
+            expr[[i]] <- .cppfunction_set_external_args( expr[[i]], names )
     }
-    bd[[2]] <- b2
+    expr
+}
+
+.cppfunction_formals_gets <- function (fun, envir = environment(fun), value) {
+    bd <- .cppfunction_set_external_args( body(fun), names(value) )
     f <- fun@.Data
     formals(f) <- value
     body(f) <- bd

inst/tinytest/test_module.R

@@ -50,6 +50,12 @@ expect_equal( foo_formals(), 20.0 )
 expect_equal( foo_formals( y = 3.0 ), 6.0 )
 expect_error( foo_short_formals(), "expecting 2, got 1" )
 
+## formals<- finds the .External() call wherever it is in the body, e.g.
+## inside the block that coverage tools (covr) wrap each statement in
+wrapped <- quote({ if (TRUE) { covr:::count("key"); .External(entry, pointer, ...) } })
+expect_equal( deparse( Rcpp:::.cppfunction_set_external_args( wrapped, c("x", "y") ) ),
+              deparse( quote({ if (TRUE) { covr:::count("key"); .External(entry, pointer, x, y) } }) ) )
+
 w <- new( ModuleWorld )
 expect_equal( w$greet(), "hello" )
 w$set( "hello world" )