The R Project SVN R

/*

 Tests the R error handling in an application

 which embeds R. Here, we generate the error by calling stop().

 We also provide an on.exit() also.

 */

#include <R.h>

#include <Rdefines.h>

#include "Startup.h"

#include "embeddedRCall.h"

int

main(int argc, char *argv[])

{

  SEXP fun, e, arg;

  int i;

  int errorOccurred;

  char *localArgs[] = {"R", "--gui=none", "--silent"};

  init_R(sizeof(localArgs)/sizeof(localArgs[0]), localArgs);

  /*

     Evaluates the two expressions:

       source("error.R")

     and then calls foo()  twice

     where foo is defined in the file error.R

   */

  PROTECT(fun = Rf_findFun(Rf_install("source"),  R_GlobalEnv));  

  PROTECT(e = allocVector(LANGSXP, 2));

  PROTECT(arg = NEW_CHARACTER(1));

  SET_STRING_ELT(arg, 0, COPY_TO_USER_STRING("error.R"));

  SETCAR(e, fun);

  SETCAR(CDR(e), arg);

  Test_tryEval(e, &errorOccurred);

  UNPROTECT(2);

    fun = Rf_findFun(Rf_install("foo"),  R_GlobalEnv);

    PROTECT(fun);

    PROTECT(arg = NEW_INTEGER(10));

    e = allocVector(LANGSXP, 1);

    PROTECT(e);

    SETCAR(e, fun);

    Test_tryEval(e, &errorOccurred);

    fprintf(stderr, "Trying again (yes it will fail also!)\n");fflush(stderr);

    Test_tryEval(e, &errorOccurred);

    UNPROTECT(2);

    R_CleanUp(SA_NOSAVE, 0, FALSE);

  return(0);

}