fix PR#18824 -- debugonce(<simple_body>) and "typo" in r87345`s patch

git-svn-id: https://svn.r-project.org/R/trunk@87347 00db46b3-68df-0310-9c12-caf00c1e9a41

Author: maechler

doc/NEWS.Rd

@@ -360,11 +360,15 @@
       \PR{18782}.
 
       \item \code{axisTicks(usr, ...)} documentation clarification for
-      \code{log=TRUE}, fixing bug \PR{18821} thanks to Duncan Murdoch.
+      \code{log=TRUE}, fixing bug \PR{18821} thanks to \I{Duncan Murdoch}.
 
       \item \code{debug()} and \code{debugonce(fun)} now also accept a
       string \code{fun} when it names an S4 generic, fixing \PR{18822}
-      thanks to Michael Jagan.
+      thanks to \I{Michael Jagan}.
+
+      \item \code{debugonce(<S4-simple-body>, signature=*)} now works
+      correctly when \dQuote{called twice}, fixing \PR{18824} thanks to
+      \I{Michael Jagan}.
     }
   }
 }

src/library/methods/R/debug.R

@@ -2,20 +2,20 @@
                          once = FALSE)
 {
     stopifnot(is.null(condition), identical(text, ""))
-    fun <- getGeneric(fun, mustWork = TRUE)
+    fun <- getGeneric(fun, mustFind = TRUE)
 
     if(isdebugged(fun, signature = signature))
         return(invisible(NULL))
-    
-    m <- selectMethod(fun, signature)
+
+    m <- .untracedFunction(selectMethod(fun, signature))
     bd <- body(m)
 
     isrematch <- isRematched(m)
     if(isrematch)
         bd <- body(bd[[2L]][[3L]])
 
     at <- if(is(bd, "{")) 2L else numeric()
-    
+
     tracer <- if(once) {
         ## If the method is rematched we're in .local so we need to reach up one
         ## frame to get the generic and target in that case

tests/reg-tests-1e.R

@@ -1552,13 +1552,54 @@ for(x in list(x3 = {n <- 3L; x <- diag(n); x[n,n] <- 0; x},
 }
 ## kappa(..)  returned 1 or {0 with a warning} in R <= 4.4.2
 
+
 ## hexadecimal contants with and without exponent.
 0x1.234p0
 0x1.234p7
 0x1.234p-7
 0x1.234
 ## last was a (deliberate) parse error in R <= 4.4.2, but not as documented.
 
+
+## PR#18822 -- debug("<S4-generic>")
+m0 <- selectMethod("Ops", signature = (SIG <- c("array", "array")))
+stopifnot(is.function(m0), inherits(m0, "PossibleMethod"))
+debug    ("Ops", signature = SIG) # gave Error
+(m1 <- selectMethod("Ops", SIG))
+untrace("Ops", signature=SIG) ; m2 <- selectMethod("Ops", SIG)
+debugonce("Ops", signature = SIG) # Error ..
+m3 <- selectMethod("Ops", SIG)
+untrace("Ops", signature=SIG) ; m4 <- selectMethod("Ops", SIG)
+stopifnot(exprs = {
+    is(m0, "MethodDefinition")
+    identical(m0, m2)
+    identical(m0, m4)
+    is(m1, "MethodDefinitionWithTrace")
+    is(m3, "MethodDefinitionWithTrace") # but not the same
+})
+## both debug(..) and debugonce(..) failed
+
+
+## debugonce(<simple>) error when called twice --  PR#18824
+setGeneric("zzz", function(x) standardGeneric("zzz"))
+setMethod("zzz", c(x = "NULL"), function(x) NULL)
+m0 <- selectMethod(zzz, signature = "NULL")
+debugonce(zzz, signature = "NULL")
+m1 <- selectMethod(zzz, signature = "NULL")
+debugonce(zzz, signature = "NULL") # gave error "cannot use 'at' argument unless ..."
+m2 <- selectMethod(zzz, signature = "NULL")
+untrace(zzz, signature = "NULL")
+m3 <- selectMethod(zzz, signature = "NULL")
+stopifnot(exprs = {
+    is(m0, "MethodDefinition")
+    is(m1, "MethodDefinitionWithTrace")
+    identical(m0, m3)
+    identical(m1, m2)
+})
+## 2nd debugonce() call failed in R <= 4.4.2
+
+
+
 ## keep at end
 rbind(last =  proc.time() - .pt,
       total = proc.time())