The R Project SVN R

Rev

Rev 38671 | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 38671 Rev 38673
Line 3... Line 3...
3 
int callLength(SEXP obj);
 3 
int callLength(SEXP obj);
4 
int R_embeddedShutdown(Rboolean ask);
 4 
int R_embeddedShutdown(Rboolean ask);
5 
 
 5 
 
6 
main(int argc, char *argv[])
 6 
main(int argc, char *argv[])
7 
{
 7 
{
8 
  SEXP objs[100];
 8 
    SEXP objs[100];
9 
  int i;
 9 
    int i;
10 
  Rf_initEmbeddedR(sizeof(argv)/sizeof(argv[0]), argv);
 10 
    Rf_initEmbeddedR(sizeof(argv)/sizeof(argv[0]), argv);
11 
 
 11 
 
12 
  for(i = 0; i < 100; i++) {
 12 
    for(i = 0; i < 100; i++) {
13 
    objs[i] = allocVector(VECSXP, 1000);
 13 
	objs[i] = allocVector(VECSXP, 1000);
14 
    R_PreserveObject(objs[i]);
 14 
	R_PreserveObject(objs[i]);
15 
    callLength(objs[i]);
 15 
	callLength(objs[i]);
16 
  }
 16 
    }
17 
 
 17 
 
18 
  R_embeddedShutdown(FALSE);
 18 
    R_embeddedShutdown(FALSE);
19 
}
 19 
}
20 
 
 20 
 
21 
int
 21 
int
22 
callLength(SEXP obj)
 22 
callLength(SEXP obj)
23 
{
 23 
{
24 
    SEXP e, val;
 24 
    SEXP e, val;
25 
    int errorOccurred;
 25 
    int errorOccurred;
26 
    int len = -1;
 26 
    int len = -1;
27 
 
 27 
 
28 
    PROTECT(e = allocVector(LANGSXP,2));
 - 
 
29 
    SETCAR(e, Rf_install("length"));
 28 
    PROTECT(e = lang2(install("length"), obj));
30 
    SETCAR(CDR(e), obj);
 - 
 
31 
 
 - 
 
32 
    PROTECT(val = R_tryEval(e, R_GlobalEnv, &errorOccurred));
 29 
    val = R_tryEval(e, R_GlobalEnv, &errorOccurred);
33 
    len = INTEGER(val)[0];
 30 
    len = INTEGER(val)[0];
34 
    UNPROTECT(2);
 31 
    UNPROTECT(1);
35
32
36 
    return(len);
 33 
    return(len);
37 
}
 34 
}
38 
 
 35 
 
39 
 
 36