Bug 4073 - Problem with S4 slots in C code

[gmbecker]

https://bugs.r-project.org/show_bug.cgi?id=4073

Very old bug. Needs confirmation it either a) can be closed as fixed or irrelevant, or b) is still the now.

[aitap]

Not sure whether the original reporter was doing something wrong, but the behaviour can still be reproduced:

flr.c:

#include <R.h>
#include <Rinternals.h>
#include <Rdefines.h>

SEXP Test(void)
    {
    SEXP FLQuant, v, 
         d1, d2, d3, d4, d5,  
         dim,   dimnames, names;    

    //Create new S4 object    
    PROTECT(FLQuant = NEW_OBJECT(MAKE_CLASS("FLQuant")));

    //Create array for slot    
    //Set dimensions of array
    PROTECT(dim     = allocVector(INTSXP, 5));       
    INTEGER(dim)[0] = 1;
    INTEGER(dim)[1] = 1;
    INTEGER(dim)[2] = 1; 
    INTEGER(dim)[3] = 1; 
    INTEGER(dim)[4] = 1; 
        
    //Allocate memory
    PROTECT(v = Rf_allocArray(REALSXP, dim)); 
    
    //Create dimension names
    PROTECT(dimnames = allocVector(VECSXP, 5));
    
    PROTECT(d1 = allocVector(INTSXP, 1));
    INTEGER(d1)[0] = 1; 
    SET_VECTOR_ELT(dimnames, 0, d1);
    
    PROTECT(d2 = allocVector(INTSXP, 1));
    INTEGER(d2)[0] = 2000; 
    SET_VECTOR_ELT(dimnames, 1, d2);
     
    PROTECT(d3 = allocVector(STRSXP, 1));
    SET_STRING_ELT(d3, 0, mkChar("combined"));
    SET_VECTOR_ELT(dimnames, 2, d3);
    
    PROTECT(d4 = allocVector(STRSXP, 1));
    SET_STRING_ELT(d4, 0, mkChar("all"));
    SET_VECTOR_ELT(dimnames, 3, d4);
    
    PROTECT(d5 = allocVector(STRSXP, 1));
    SET_STRING_ELT(d5, 0, mkChar("all"));
    SET_VECTOR_ELT(dimnames, 4, d5);
    
    //Create names for dimensions
    PROTECT(names = allocVector(STRSXP, 5));
    SET_STRING_ELT(names, 0, mkChar("age"));
    SET_STRING_ELT(names, 1, mkChar("year"));
    SET_STRING_ELT(names, 2, mkChar("sex"));
    SET_STRING_ELT(names, 3, mkChar("season"));
    SET_STRING_ELT(names, 4, mkChar("area"));
    setAttrib(dimnames, R_NamesSymbol, names);
    setAttrib(v, R_DimNamesSymbol, dimnames);
    
    //Set data
    REAL(v)[0] = 2;
	// NOTE: expecting that the returned S4 object will contain "2"
           
    //Set slot
    SET_SLOT(FLQuant, install(".Data"), v);

    UNPROTECT(10);
    
    return FLQuant;
    }

repro.R:

setClass("FLQuant",
	representation("array"),
	prototype = array(1, dim=c(1,1,1,1,1), dimnames=list(
		age="0", year="0", sex="combined", season="all", area="all"
	))
)

(fl <- new("FLQuant"))
(aa <- array(2, dim=c(1,1,1,1,1), dimnames=list(
	age="1", year="2000", sex="combined", season="all", area="all")
))
fl@.Data <- aa
(fl)

tools::Rcmd('SHLIB flr.c')
dyn.load(paste0('flr', .Platform$dynlib.ext))

test<-function() .Call("Test")
(fl2 <- test())

Output:

> setClass("FLQuant",
+       representation("array"),
+       prototype = array(1, dim=c(1,1,1,1,1), dimnames=list(
+               age="0", year="0", sex="combined", seas .... [TRUNCATED]

> (fl <- new("FLQuant"))
An object of class "FLQuant"
, , sex = combined, season = all, area = all

   year
age 0
  0 1


> (aa <- array(2, dim=c(1,1,1,1,1), dimnames=list(
+       age="1", year="2000", sex="combined", season="all", area="all")
+ ))
, , sex = combined, season = all, area = all

   year
age 2000
  1    2


> [email protected] <- aa

> (fl)
An object of class "FLQuant"
, , sex = combined, season = all, area = all

   year
age 2000
  1    2


> tools::Rcmd('SHLIB flr.c')
gcc -I"/usr/share/R/include" -DNDEBUG      -fpic  -g -O2 -fdebug-prefix-map=/home/jranke/git/r-backports/buster/r-base-4.2.0=. -fstack-protector-strong -Wformat -Werror=format-security -Wdate-time -D_FORTIFY_SOURCE=2  -c flr.c -o flr.o
gcc -shared -L/usr/lib/R/lib -Wl,-z,relro -o flr.so flr.o -L/usr/lib/R/lib -lR

> dyn.load(paste0('flr', .Platform$dynlib.ext))

> test<-function() .Call("Test")

> (fl2 <- test())
An object of class "FLQuant"
, , sex = combined, season = all, area = all

   year
age 0
  0 1


> stopifnot([email protected] == 2)
Error: [email protected] == 2 is not TRUE

Better documentation on manipulating S4 objects from C would certainly help.

[gmbecker]

@aitap thanks for the confirmation. The next step, as you alluded to is to figure out if what the original poster was doing should have worked, or if the approach was wrong. That will take some more work in this case.