The R Project SVN R

Rev

Rev 14948 | Rev 38671 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
14948 duncan 1 
 
19500 hornik 2 
#include <R.h>
3 
#include <Rinternals.h>
4 
#include <Rdefines.h>
14948 duncan 5 
 
6 
#include "embeddedRCall.h"
7 
#include "Defn.h"
8 
 
9 
int
10 
eval_R_command(const char *funcName, int argc, char *argv[])
11 
{
12 
 SEXP e;
13 
 SEXP fun;
14 
 SEXP arg;
15 
 
16 
 int i;
17 
 int errorOccurred;
18 
 init_R(argc, argv);
19 
 
20 
    fun = Rf_findFun(Rf_install((char *)funcName),  R_GlobalEnv);
21 
    PROTECT(fun);
22 
    PROTECT(arg = NEW_INTEGER(10));
23 
    for(i = 0; i < GET_LENGTH(arg); i++)
24 
      INTEGER_DATA(arg)[i]  = i + 1;
25 
 
26 
    e = allocVector(LANGSXP, 2);
27 
    PROTECT(e);
28 
    SETCAR(e, fun);
29 
    SETCAR(CDR(e), arg);
30 
 
31 
      /* Evaluate the call to the R function.
32 
         Ignore the return value.
33 
       */
34 
    Test_tryEval(e, &errorOccurred);
35 
 
36 
    UNPROTECT(3);
37 
  return(0);
38 
}
39 
 
40 
extern int Rf_initEmbeddedR(int argc, char *argv[]);
41 
 
42 
void
43 
init_R(int argc, char **argv)
44 
{
45 
  int defaultArgc = 1;
46 
  char *defaultArgv[] = {"Rtest"};
47 
 
48 
  if(argc == 0 || argv == NULL) {
49 
      argc = defaultArgc;
50 
      argv = defaultArgv;
51 
  }
52 
  Rf_initEmbeddedR(argc, argv);
53 
}
54 
 
55 
 
56 
 
57 
typedef struct {
58 
    SEXP expression;
59 
    SEXP val;
60 
} R_ProtectedEvalData;
61 
 
62 
void
63 
protectedEval(void *d)
64 
{
65 
    R_ProtectedEvalData *data = (R_ProtectedEvalData *)d;
66 
 
67 
    data->val = eval(data->expression, R_GlobalEnv);
68 
    PROTECT(data->val);
69 
}
70 
 
71 
SEXP
72 
Test_tryEval(SEXP e, int *ErrorOccurred)
73 
{
74 
 Rboolean ok;
75 
 R_ProtectedEvalData data;
76 
 
77 
 data.expression = e;
78 
 data.val = NULL;
79 
 
80 
 ok = R_ToplevelExec(protectedEval, &data);
81 
 if(ErrorOccurred) {
82 
     *ErrorOccurred = (ok == FALSE);
83 
 }
84 
 if(ok == FALSE)
85 
     data.val = NULL;
86 
 else
87 
     UNPROTECT(1);
88 
 
89 
 return(data.val);
90 
}
91 
 
92 
 
93