The R Project SVN R

Rev

Rev 38671 | Rev 38839 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 38671 Rev 38673
Line 2... Line 2...
2 
 Tests the R error handling in an application
 2 
 Tests the R error handling in an application
3 
 which embeds R. Here, we generate the error by calling stop().
 3 
 which embeds R. Here, we generate the error by calling stop().
4 
 We also provide an on.exit() also.
 4 
 We also provide an on.exit() also.
5 
 */
 5 
 */
6 
 
 6 
 
7 
#include <R.h>
 - 
 
8 
#include <Rdefines.h>
 - 
 
9 
 
 - 
 
10 
#include "Startup.h"
 - 
 
11 
 
 - 
 
12 
#include "embeddedRCall.h"
 7 
#include "embeddedRCall.h"
- 
 
 8 
#include "Startup.h"
13 
 
 9 
 
14 
 
 10 
 
15 
int
 11 
int
16 
main(int argc, char *argv[])
 12 
main(int argc, char *argv[])
17 
{
 13 
{
18 
  SEXP fun, e, arg;
 14 
    SEXP e;
19 
  int errorOccurred;
 15 
    int errorOccurred;
20 
  char *localArgs[] = {"R", "--silent"};
 16 
    char *localArgs[] = {"R", "--silent"};
21 
  init_R(sizeof(localArgs)/sizeof(localArgs[0]), localArgs);
 17 
    init_R(sizeof(localArgs)/sizeof(localArgs[0]), localArgs);
22 
 
 18 
 
23 
  /*
 19 
    /*
24 
     Evaluates the two expressions:
 20 
      Evaluates the two expressions:
25 
       source("error.R")
 21 
      source("error.R")
26 
     and then calls foo()  twice
 22 
      and then calls foo()  twice
27 
     where foo is defined in the file error.R
 23 
      where foo is defined in the file error.R
28 
   */
 24 
    */
29 
  PROTECT(fun = Rf_findFun(Rf_install("source"),  R_GlobalEnv));
25 
    PROTECT(e = lang2(install("source"), mkString("error.R")));
30 
  PROTECT(e = allocVector(LANGSXP, 2));
 - 
 
31 
  PROTECT(arg = NEW_CHARACTER(1));
 - 
 
32 
  SET_STRING_ELT(arg, 0, COPY_TO_USER_STRING("error.R"));
 - 
 
33 
  SETCAR(e, fun);
 - 
 
34 
  SETCAR(CDR(e), arg);
 - 
 
35
- 
 
36 
  R_tryEval(e, R_GlobalEnv, &errorOccurred);
 - 
 
37 
 
 - 
 
38 
  UNPROTECT(2);
 - 
 
39 
 
 - 
 
40 
    fun = Rf_findFun(Rf_install("foo"),  R_GlobalEnv);
 - 
 
41 
    PROTECT(fun);
 - 
 
42 
    PROTECT(arg = NEW_INTEGER(10));
 - 
 
43 
    e = allocVector(LANGSXP, 1);
 - 
 
44 
    PROTECT(e);
 - 
 
45 
    SETCAR(e, fun);
 - 
 
46 
 
 - 
 
47 
    R_tryEval(e, R_GlobalEnv, &errorOccurred);
 26 
    R_tryEval(e, R_GlobalEnv, &errorOccurred);
- 
 
 27 
    UNPROTECT(1);
48 
 
 28 
 
- 
 
 29 
    PROTECT(e = lang1(install("foo")));
- 
 
 30 
    R_tryEval(e, R_GlobalEnv, &errorOccurred);
49 
    fprintf(stderr, "Trying again (yes it will fail also!)\n");fflush(stderr);
 31 
    fprintf(stderr, "Trying again (yes it will fail also!)\n");fflush(stderr);
50 
 
 - 
 
51 
    R_tryEval(e, R_GlobalEnv, &errorOccurred);
 32 
    R_tryEval(e, R_GlobalEnv, &errorOccurred);
52 
    UNPROTECT(2);
 33 
    UNPROTECT(1);
53 
 
 34 
 
54 
    R_CleanUp(SA_NOSAVE, 0, FALSE);
 35 
    R_CleanUp(SA_NOSAVE, 0, FALSE);
55 
 
 36 
 
56 
  return(0);
 37 
    return(0);
57 
}
 38 
}
58 
 
 -