The R Project SVN – R – Diff – /branches/R-NaString/src/main/errors.c

     R_ClearerrConsole();
     R_ParseError = 0;
     /* find the jump target; do the jump if target is a CTXT_RESTART */
     for (c = R_GlobalContext; c; c = c->nextcontext) {
-	if (c->callflag == CTXT_RETURN || c->callflag == CTXT_GENERIC )
+	if (c->callflag & CTXT_FUNCTION )
 	    nback++;
 	if (IS_RESTART_BIT_SET(c->callflag)) {
 	    inError=0;
 	    findcontext(CTXT_RESTART, c->cloenv, R_DollarSymbol);
+	}
 	R_CleanUp(SA_NOSAVE, 1, 0); /* quit, no save, no .Last, status=1 */
+    }
     PROTECT(s = allocList(nback));
     t = s;
-    for (c = R_GlobalContext ; c ; c = c->nextcontext)
+    for (c = R_GlobalContext ;
+	 c != NULL && c->callflag != CTXT_TOPLEVEL;
+	 c = c->nextcontext)
 	if (c->callflag & CTXT_FUNCTION ) {
 	    SETCAR(t, deparse1(c->call, 0));
 	    t = CDR(t);
+	}
     setVar(install(".Traceback"), s, R_GlobalEnv);
+{
     int nback = 0, ns;
     RCNTXT *c;
     SEXP s, t;
-    for (c = R_GlobalContext, ns = skip; c; c = c->nextcontext)
+    for (c = R_GlobalContext, ns = skip;
+	 c != NULL && c->callflag != CTXT_TOPLEVEL;
+	 c = c->nextcontext)
-        if (c->callflag == CTXT_RETURN || c->callflag == CTXT_GENERIC ) {
+	if (c->callflag & CTXT_FUNCTION ) {
 	    if (ns > 0)
 		ns--;
 	    else
 		nback++;
+	}
     PROTECT(s = allocList(nback));
     t = s;
-    for (c = R_GlobalContext ; c ; c = c->nextcontext)
+    for (c = R_GlobalContext ;
+	 c != NULL && c->callflag != CTXT_TOPLEVEL;
+	 c = c->nextcontext)
 	if (c->callflag & CTXT_FUNCTION ) {
 	    if (skip > 0)
 		skip--;
 	    else {
 		SETCAR(t, deparse1(c->call, 0));

The R Project SVN R

(root)/branches/R-NaString/src/main/errors.c @ 77458 – Rev 14631 → 14723