The R Project SVN R

Rev

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

Rev 6191 Rev 6199
Line 24... Line 24...
24 
 
 24 
 
25 
#include "Defn.h"
 25 
#include "Defn.h"
26 
 
 26 
 
27 
static void jump_now();
 27 
static void jump_now();
28 
 
 28 
 
- 
 
 29 
/*
- 
 
 30 
Different values of inError are used to indicate different places
- 
 
 31 
in the error handling.
- 
 
 32 
*/
29 
static int inError = 0;
 33 
static int inError = 0;
30 
static int inWarning = 0;
 34 
static int inWarning = 0;
31 
 
 35 
 
32 
/* Interface / Calling Hierarchy :
 36 
/* Interface / Calling Hierarchy :
33 
 
 37 
 
34 
  R__stop()   -> do_error .    errorcall \-/->--->----------------\
 38 
  R__stop()   -> do_error ->   errorcall --> jump_to_toplevel --> jump_now
35 
			  \	          X                        \
 39 
			 /
36 
			   \-> error ->--/-\-->-- jump_to_toplevel --> jump_now
 40 
		    error
37 
 
 41 
 
38 
  R__warning()-> do_warning   -> warningcall -> if(warn >= 2) errorcall
 42 
  R__warning()-> do_warning   -> warningcall -> if(warn >= 2) errorcall
39 
			     /
 43 
			     /
40 
		    warning /
 44 
		    warning /
41 
 
 45 
 
Line 83... Line 87...
83 
        if( !isLanguage(s) &&  ! isExpression(s) )
 87 
        if( !isLanguage(s) &&  ! isExpression(s) )
84 
            error("invalid option \"warning.expression\"");
 88 
            error("invalid option \"warning.expression\"");
85 
        cptr = R_GlobalContext;
 89 
        cptr = R_GlobalContext;
86 
        while ( !(cptr->callflag & CTXT_FUNCTION) && cptr->callflag )
 90 
        while ( !(cptr->callflag & CTXT_FUNCTION) && cptr->callflag )
87 
            cptr = cptr->nextcontext;
 91 
            cptr = cptr->nextcontext;
88 
        eval(s, cptr->cloenv);
 92 
	eval(s, cptr->cloenv);
89 
        return;
 93 
        return;
90 
    }
 94 
    }
91 
 
 95 
 
92 
    w = asInteger(GetOption(install("warn"), R_NilValue));
 96 
    w = asInteger(GetOption(install("warn"), R_NilValue));
93 
 
 97 
 
Line 184... Line 188...
184 
}
 188 
}
185 
 
 189 
 
186 
 
 190 
 
187 
void errorcall(SEXP call, char *format,...)
 191 
void errorcall(SEXP call, char *format,...)
188 
{
 192 
{
189 
    char buf[BUFSIZE], *p;
 193 
    char buf[BUFSIZE], *p, *dcall;
- 
 
 194
190 
    va_list(ap);
 195 
    va_list(ap);
- 
 
 196 
 
191 
    char *dcall;
 197 
    if ( inError ) {
192 
    if (inError )
 198 
	if( inError == 3 )
- 
 
 199 
	    REprintf("Error during wrapup \n");
193 
	jump_now();
 200 
	jump_now();
194 
#ifdef FOO
 201 
    }
195 
    RCNTXT *cptr;
 - 
 
196 
    cptr = R_GlobalContext;
 - 
 
197 
    while ( !(cptr->callflag & CTXT_FUNCTION) && cptr->nextcontext != NULL)
 - 
 
198 
        cptr = cptr->nextcontext;
 - 
 
199 
    if( cptr->callflag & CTXT_FUNCTION )
 - 
 
200 
        do_browser(cptr->call, R_NilValue, R_NilValue, cptr->cloenv);
 - 
 
201 
#endif
 202 
 
202 
    if(call != R_NilValue ) {
 203 
    if(call != R_NilValue ) {
203 
        dcall = CHAR(STRING(deparse1(call, 0))[0]);
 204 
        dcall = CHAR(STRING(deparse1(call, 0))[0]);
204 
        sprintf(buf, "Error in %s : ", dcall);
 205 
        sprintf(buf, "Error in %s : ", dcall);
205 
    }
 206 
    }
206 
    else
 207 
    else
207 
	sprintf(buf, "Error: ");
 208 
	sprintf(buf, "Error: ");
- 
 
 209 
 
208 
    p = buf + strlen(buf);
 210 
    p = buf + strlen(buf);
209 
    va_start(ap, format);
 211 
    va_start(ap, format);
210 
    vsprintf(p, format, ap);
 212 
    vsprintf(p, format, ap);
211 
    va_end(ap);
 213 
    va_end(ap);
212 
    p = buf + strlen(buf) - 1;
 214 
    p = buf + strlen(buf) - 1;
Line 216... Line 218...
216 
}
 218 
}
217 
 
 219 
 
218 
void error(const char *format, ...)
 220 
void error(const char *format, ...)
219 
{
 221 
{
220 
    char buf[BUFSIZE], *p;
 222 
    char buf[BUFSIZE], *p;
221 
#ifdef NEWERROR
 - 
 
222 
    char *dcall;
 - 
 
223 
#endif
 223 
 
224 
    va_list(ap);
 224 
    va_list(ap);
225 
    if (inError)
 - 
 
226 
	jump_now();
 - 
 
227 
#ifdef NEWERROR
 - 
 
228 
/* This must be improved: otherwise gives
 - 
 
229 
   messages like
 - 
 
230 
   `` Error in stop("FOO and BAR") : FOO and BAR ''
 - 
 
231 
*/
 - 
 
232 
    if (R_GlobalContext->call == R_NilValue)
 - 
 
233 
	dcall = CHAR(STRING(deparse1(R_CurrentExpr, 0))[0]);
 - 
 
234 
    else
 - 
 
235 
	dcall = CHAR(STRING(deparse1(R_GlobalContext->call, 0))[0]);
 - 
 
236 
    sprintf(buf, "Error in %s : ", dcall);
 - 
 
237 
#else
 - 
 
238 
    sprintf(buf, "Error: ");
 - 
 
239 
#endif
 - 
 
240 
    p = buf + strlen(buf);
 - 
 
241 
    va_start(ap, format);
 225 
    va_start(ap, format);
242 
    vsprintf(p, format, ap);
 226 
    vsprintf(buf, format, ap);
243 
    va_end(ap);
 227 
    va_end(ap);
244 
    p = buf + strlen(buf) - 1;
 228 
    p = buf + strlen(buf) - 1;
245 
    if(*p != '\n') strcat(buf, "\n");
 229 
    if(*p != '\n') strcat(buf, "\n");
246 
    REprintf("%s", buf);
 230 
    errorcall(R_GlobalContext->call, buf);
247 
    jump_to_toplevel();
 - 
 
248 
}
 231 
}
249 
 
 232 
 
250 
/* Unwind the call stack in an orderly fashion */
 233 
/* Unwind the call stack in an orderly fashion */
251 
/* calling the code installed by on.exit along the way */
 234 
/* calling the code installed by on.exit along the way */
252 
/* and finally longjmping to the top repl loop */
 235 
/* and finally longjmping to the top repl loop */
Line 265... Line 248...
265 
	inError = 2;
 248 
	inError = 2;
266 
	REprintf("In addition: ");
 249 
	REprintf("In addition: ");
267 
	PrintWarnings();
 250 
	PrintWarnings();
268 
	inError = 1;
 251 
	inError = 1;
269 
    }
 252 
    }
- 
 
 253 
 
- 
 
 254 
    /*now see if options("error") is set */
- 
 
 255 
    s = GetOption(install("error"), R_NilValue);
- 
 
 256 
    if( s != R_NilValue ) {
- 
 
 257 
	if( !isLanguage(s) &&  ! isExpression(s) )  /* shouldn't happen */
- 
 
 258 
	    REprintf("invalid option \"error\"\n");
- 
 
 259 
	else {
- 
 
 260 
	    c = R_GlobalContext;
- 
 
 261 
	    while ( !(c->callflag & CTXT_FUNCTION) && c->callflag )
- 
 
 262 
		c = c->nextcontext;
- 
 
 263 
	    inError = 3;
- 
 
 264 
	    eval(s, c->cloenv);
- 
 
 265 
	    inError = 1;
- 
 
 266 
	}
- 
 
 267 
    }
- 
 
 268 
 
270 
    if (R_Inputfile != NULL)
 269 
    if (R_Inputfile != NULL)
271 
	fclose(R_Inputfile);
 270 
	fclose(R_Inputfile);
272 
    R_ResetConsole();
 271 
    R_ResetConsole();
273 
    R_FlushConsole();
 272 
    R_FlushConsole();
274 
    R_ClearerrConsole();
 273 
    R_ClearerrConsole();
Line 342... Line 341...
342 
}
 341 
}
343 
#endif
 342 
#endif
344 
 
 343 
 
345 
void do_stop(SEXP call, SEXP op, SEXP args, SEXP rho)
 344 
void do_stop(SEXP call, SEXP op, SEXP args, SEXP rho)
346 
{
 345 
{
- 
 
 346 
    RCNTXT *cptr;
- 
 
 347 
 
347 
/*=== SHOULD call errorcall() in the same way
 348 
    cptr = R_GlobalContext->nextcontext;
- 
 
 349 
    while ( !(cptr->callflag & CTXT_FUNCTION) && cptr->nextcontext != NULL)
348 
 *===  that  do_warning uses warningcall()
 350 
        cptr = cptr->nextcontext;
349 
*/
 351 
 
- 
 
 352 
    if (CAR(args) != R_NilValue) {
350 
    CAR(args) = coerceVector(CAR(args), STRSXP);
 353 
      CAR(args) = coerceVector(CAR(args), STRSXP);
351 
    if (length(CAR(args)) <= 0)
 354 
      errorcall(cptr->call, "%s", CHAR(STRING(CAR(args))[0]));
352 
	error("");
 355 
    }
353 
    else
 356 
    else
354 
	error("%s", CHAR(STRING(CAR(args))[0]));
 357 
      errorcall(cptr->call, "");
355 
    /*NOTREACHED*/
 358 
    /*NOTREACHED*/
356 
}
 359 
}
357 
 
 360 
 
358 
SEXP do_warning(SEXP call, SEXP op, SEXP args, SEXP rho)
 361 
SEXP do_warning(SEXP call, SEXP op, SEXP args, SEXP rho)
359 
{
 362 
{
Line 365... Line 368...
365 
    if (CAR(args) != R_NilValue) {
 368 
    if (CAR(args) != R_NilValue) {
366 
	CAR(args) = coerceVector(CAR(args), STRSXP);
 369 
	CAR(args) = coerceVector(CAR(args), STRSXP);
367 
	warningcall(cptr->call,"%s", CHAR(STRING(CAR(args))[0]));
 370 
	warningcall(cptr->call,"%s", CHAR(STRING(CAR(args))[0]));
368 
    }
 371 
    }
369 
    else
 372 
    else
370 
	warningcall(cptr->call,"%s", "");
 373 
	warningcall(cptr->call,"");
371 
    return CAR(args);
 374 
    return CAR(args);
372 
}
 375 
}
373 
 
 376 
 
374 
/* Error recovery for incorrect argument count error. */
 377 
/* Error recovery for incorrect argument count error. */
375 
void WrongArgCount(char *s)
 378 
void WrongArgCount(char *s)