Yes, a bug prevented callNextMethod() from detecting the special case of
the `[` call, for which it did have code.
Should be fixed in the current 2.11.0 (r 50976).
Thanks for the helpful bug report.
John Chambers
bernd_bischl at gmx.net wrote:> Hi,
>
> there seems to be a possible bug in callNextMethod in conjunction with
> the [-operator.
>
> Relevant info, minimal example and sessionInfo follow below:
>
> ###############################
>
> setClass("foo", representation = representation(a =
"numeric"))
> setClass("bar", contains = "foo")
>
> setMethod(
> f = "[",
> signature = signature("foo"),
> def = function(x,i,j,...,drop=TRUE) {
> cat("drop in foo-[ :", drop, "\n")
> return(1)
> }
> )
>
> setMethod(
> f = "[",
> signature = signature("bar"),
> def = function(x,i,j,...,drop=TRUE) {
> cat("drop in bar-[ :", drop, "\n")
> # we lose the value of drop here, when the call gets
> dispatched to the super method by callNextMethod
> callNextMethod()
> }
> )
>
> x <- new("foo")
> x[1, drop=FALSE]
> # drop in foo-[ : FALSE
> y <- new("bar")
> y[1, drop=FALSE]
> # drop in bar-[ : FALSE
> # drop in foo-[ : TRUE
>
> ###############################
>
> #?callNextMethod
> #The statement that the method is called with the current arguments is
> more precisely as follows. Arguments that were missing in the current
> call are still missing (remember that "missing" is a valid class
in a
> method signature). For a formal argument, say x, that appears in the
> original call, there is a corresponding argument in the next method call
> equivalent to x = x. In effect, this means that the next method sees the
> same actual arguments, but arguments are evaluated only once.
>
> ###############################
>
>
> #S3 gets this right:
>
> '[.foo' <- function(x, i, j, ..., drop=TRUE) {
> cat("drop in foo-[ :", drop, "\n")
> }
>
> '[.bar' <- function(x, i, j, ..., drop=TRUE) {
> cat("drop in bar-[ :", drop, "\n")
> NextMethod()
> }
>
> x <- 1
> class(x) <- c("bar", "foo")
> x[1, drop=FALSE]
> # drop in bar-[ : FALSE
> # drop in foo-[ : FALSE
>
> ###############################
>
> > sessionInfo()
> R version 2.11.0 Under development (unstable) (2010-01-12 r50970)
> i386-pc-mingw32
>
> locale:
> [1] LC_COLLATE=German_Germany.1252 LC_CTYPE=German_Germany.1252
> [3] LC_MONETARY=German_Germany.1252 LC_NUMERIC=C
> [5] LC_TIME=German_Germany.1252
>
> attached base packages:
> [1] stats graphics grDevices utils datasets methods base
>
> loaded via a namespace (and not attached):
> [1] tools_2.11.0
>
> ______________________________________________
> R-devel at r-project.org mailing list
> https://stat.ethz.ch/mailman/listinfo/r-devel
>
>