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



	errorcall(call, "(converted from warning) %s", buf);
    }
    else if(w==1) {	/* print as they happen */
	va_list(ap);
	if( call != R_NilValue ) {
	    dcall = CHAR(STRING_ELT(deparse1(call, 0), 0));
	    REprintf("Warning in %s : ", dcall);
	    if (strlen(dcall) > LONGCALL) REprintf("\n	 ");
	}
	else
	    REprintf("Warning: ");

	va_start(ap, format);
	if(!R_CollectWarnings)
	    setupwarnings();
	if( R_CollectWarnings > 49 )
	    return;
	SET_VECTOR_ELT(R_Warnings, R_CollectWarnings, call);
	slen = vsprintf(buf, format, ap);
	va_end(ap);
	names = CAR(ATTRIB(R_Warnings));
	SET_STRING_ELT(names, R_CollectWarnings++, mkChar(buf));
    }
    /* else:  w <= -1 */
    inWarning = 0;
}
 

 
    inWarning = 1;
    if( R_CollectWarnings == 1 ) {
	REprintf("Warning message: \n");
	names = CAR(ATTRIB(R_Warnings));
	if( VECTOR_ELT(R_Warnings, 0) == R_NilValue )
	   REprintf("%s \n", CHAR(STRING_ELT(names, 0)));
	else
	   REprintf("%s in: %s \n", CHAR(STRING_ELT(names, 0)),
		CHAR(STRING_ELT(deparse1(VECTOR_ELT(R_Warnings, 0),0), 0)));
    }
    else if( R_CollectWarnings <= 10 ) {
	REprintf("Warning messages: \n");
	names = CAR(ATTRIB(R_Warnings));
	for(i=0; i<R_CollectWarnings; i++) {
	    if( STRING_ELT(R_Warnings, i) == R_NilValue )
	       REprintf("%d: %s \n",i+1, CHAR(STRING_ELT(names, i)));
	    else
	       REprintf("%d: %s in: %s \n", i+1, CHAR(STRING_ELT(names, i)),
		   CHAR(STRING_ELT(deparse1(VECTOR_ELT(R_Warnings,i), 0), 0)));
	}
    }
    else {
	if (R_CollectWarnings < 50)
	    REprintf("There were %d warnings (use warnings() to see them)\n",

    /* now truncate and install last.warning */
    PROTECT(s = allocVector(VECSXP, R_CollectWarnings));
    PROTECT(t = allocVector(STRSXP, R_CollectWarnings));
    names = CAR(ATTRIB(R_Warnings));
    for(i=0; i<R_CollectWarnings; i++) {
	SET_VECTOR_ELT(s, i, VECTOR_ELT(R_Warnings, i));
	SET_VECTOR_ELT(t, i, VECTOR_ELT(names, i));
    }
    setAttrib(s, R_NamesSymbol, t);
    defineVar(install("last.warning"), s, R_GlobalEnv);
    UNPROTECT(2);
    inWarning = 0;

	jump_now();
    }
 
    if(call != R_NilValue) {
	inError = 1;
	dcall = CHAR(STRING_ELT(deparse1(call, 0), 0));
	sprintf(errbuf, "Error in %s : ", dcall);
	if (strlen(dcall) > LONGCALL) strcat(errbuf, "\n	");/* <- TAB */
    }
    else
	sprintf(errbuf, "Error: ");

{
    SEXP res;
 
    checkArity(op, args);
    PROTECT(res = allocVector(STRSXP, 1));
    SET_STRING_ELT(res, 0, mkChar(errbuf));
    UNPROTECT(1);
    return res;
}
 
void error(const char *format, ...)

		eval(s, c->cloenv);
	    else /* expression */
	    {
		int i, n = LENGTH(s);
		for (i = 0 ; i < n ; i++)
		    eval(VECTOR_ELT(s, i), c->cloenv);
	    }
	    inError = 1;
	}
    }
 

    else R_Outputfile = R_Consolefile;
    PROTECT(s = allocList(nback));
    t = s;
    for (c = R_GlobalContext ; c ; c = c->nextcontext)
	if (c->callflag & CTXT_FUNCTION ) {
	    SETCAR(t, deparse1(c->call, 0));
	    t = CDR(t);
	}
    setVar(install(".Traceback"), s, R_GlobalEnv);
    UNPROTECT(1);
    jump_now();

	c_call = R_NilValue;
 
    args = CDR(args);
 
    if (CAR(args) != R_NilValue) { /* message */
      SETCAR(args, coerceVector(CAR(args), STRSXP));
      if(!isValidString(CAR(args)))
	  errorcall(c_call, " [invalid string in stop(.)]");
      errorcall(c_call, "%s", CHAR(STRING_ELT(CAR(args), 0)));
    }
    else
      errorcall(c_call, "");
}
 

 
    cptr = R_GlobalContext->nextcontext;
    while ( !(cptr->callflag & CTXT_FUNCTION) && cptr->nextcontext != NULL)
	cptr = cptr->nextcontext;
    if (CAR(args) != R_NilValue) {
	SETCAR(args, coerceVector(CAR(args), STRSXP));
	if(!isValidString(CAR(args)))
	    warningcall(cptr->call, " [invalid string in warning(.)]");
	else
	    warningcall(cptr->call,"%s", CHAR(STRING_ELT(CAR(args), 0)));
    }
    else
	warningcall(cptr->call,"");
    return CAR(args);
}

    va_list(ap);
    char *dcall;
    if (inError)
	jump_now();
    if (call != R_NilValue) {
	dcall = CHAR(STRING_ELT(deparse1(call, 0), 0));
	REprintf("Error in %s : ", dcall);
	if (strlen(dcall) > LONGCALL) REprintf("\n   ");
    }
    else
	REprintf("Error: ");	/* -- dcall = ??? */

    va_list(ap);
    char *dcall;
    if (inError)
	jump_now();
    if (call != R_NilValue) {
	dcall = CHAR(STRING_ELT(deparse1(call, 0), 0));
	REprintf("Warning in %s : ", dcall);
    }
    else
	REprintf("Warning: ");	/* -- dcall = ??? */
    i = 0;

Rev 9615	Rev 9642
Line 179...	Line 179...
179	`errorcall(call, "(converted from warning) %s", buf);`	179	`errorcall(call, "(converted from warning) %s", buf);`
180	`}`	180	`}`
181	`else if(w==1) { /* print as they happen */`	181	`else if(w==1) { /* print as they happen */`
182	`va_list(ap);`	182	`va_list(ap);`
183	`if( call != R_NilValue ) {`	183	`if( call != R_NilValue ) {`
184	`dcall = CHAR(STRING(deparse1(call, 0))[0]);`	184	`dcall = CHAR(STRING_ELT(deparse1(call, 0), 0));`
185	`REprintf("Warning in %s : ", dcall);`	185	`REprintf("Warning in %s : ", dcall);`
186	`if (strlen(dcall) > LONGCALL) REprintf("\n ");`	186	`if (strlen(dcall) > LONGCALL) REprintf("\n ");`
187	`}`	187	`}`
188	`else`	188	`else`
189	`REprintf("Warning: ");`	189	`REprintf("Warning: ");`
Line 197...	Line 197...
197	`va_start(ap, format);`	197	`va_start(ap, format);`
198	`if(!R_CollectWarnings)`	198	`if(!R_CollectWarnings)`
199	`setupwarnings();`	199	`setupwarnings();`
200	`if( R_CollectWarnings > 49 )`	200	`if( R_CollectWarnings > 49 )`
201	`return;`	201	`return;`
202	`VECTOR(R_Warnings)[R_CollectWarnings] = call;`	202	`SET_VECTOR_ELT(R_Warnings, R_CollectWarnings, call);`
203	`slen = vsprintf(buf, format, ap);`	203	`slen = vsprintf(buf, format, ap);`
204	`va_end(ap);`	204	`va_end(ap);`
205	`names = CAR(ATTRIB(R_Warnings));`	205	`names = CAR(ATTRIB(R_Warnings));`
206	`STRING(names)[R_CollectWarnings++] = mkChar(buf);`	206	`SET_STRING_ELT(names, R_CollectWarnings++, mkChar(buf));`
207	`}`	207	`}`
208	`/* else: w <= -1 */`	208	`/* else: w <= -1 */`
209	`inWarning = 0;`	209	`inWarning = 0;`
210	`}`	210	`}`
211		211
Line 216...	Line 216...
216		216
217	`inWarning = 1;`	217	`inWarning = 1;`
218	`if( R_CollectWarnings == 1 ) {`	218	`if( R_CollectWarnings == 1 ) {`
219	`REprintf("Warning message: \n");`	219	`REprintf("Warning message: \n");`
220	`names = CAR(ATTRIB(R_Warnings));`	220	`names = CAR(ATTRIB(R_Warnings));`
221	`if( VECTOR(R_Warnings)[0] == R_NilValue )`	221	`if( VECTOR_ELT(R_Warnings, 0) == R_NilValue )`
222	`REprintf("%s \n", CHAR(STRING(names)[0]));`	222	`REprintf("%s \n", CHAR(STRING_ELT(names, 0)));`
223	`else`	223	`else`
224	`REprintf("%s in: %s \n", CHAR(STRING(names)[0]),`	224	`REprintf("%s in: %s \n", CHAR(STRING_ELT(names, 0)),`
225	`CHAR(STRING(deparse1(VECTOR(R_Warnings)[0],0))[0]));`	225	`CHAR(STRING_ELT(deparse1(VECTOR_ELT(R_Warnings, 0),0), 0)));`
226	`}`	226	`}`
227	`else if( R_CollectWarnings <= 10 ) {`	227	`else if( R_CollectWarnings <= 10 ) {`
228	`REprintf("Warning messages: \n");`	228	`REprintf("Warning messages: \n");`
229	`names = CAR(ATTRIB(R_Warnings));`	229	`names = CAR(ATTRIB(R_Warnings));`
230	`for(i=0; i<R_CollectWarnings; i++) {`	230	`for(i=0; i<R_CollectWarnings; i++) {`
231	`if( STRING(R_Warnings)[i] == R_NilValue )`	231	`if( STRING_ELT(R_Warnings, i) == R_NilValue )`
232	`REprintf("%d: %s \n",i+1, CHAR(STRING(names)[i]));`	232	`REprintf("%d: %s \n",i+1, CHAR(STRING_ELT(names, i)));`
233	`else`	233	`else`
234	`REprintf("%d: %s in: %s \n", i+1, CHAR(STRING(names)[i]),`	234	`REprintf("%d: %s in: %s \n", i+1, CHAR(STRING_ELT(names, i)),`
235	`CHAR(STRING(deparse1(VECTOR(R_Warnings)[i], 0))[0]));`	235	`CHAR(STRING_ELT(deparse1(VECTOR_ELT(R_Warnings,i), 0), 0)));`
236	`}`	236	`}`
237	`}`	237	`}`
238	`else {`	238	`else {`
239	`if (R_CollectWarnings < 50)`	239	`if (R_CollectWarnings < 50)`
240	`REprintf("There were %d warnings (use warnings() to see them)\n",`	240	`REprintf("There were %d warnings (use warnings() to see them)\n",`
Line 245...	Line 245...
245	`/* now truncate and install last.warning */`	245	`/* now truncate and install last.warning */`
246	`PROTECT(s = allocVector(VECSXP, R_CollectWarnings));`	246	`PROTECT(s = allocVector(VECSXP, R_CollectWarnings));`
247	`PROTECT(t = allocVector(STRSXP, R_CollectWarnings));`	247	`PROTECT(t = allocVector(STRSXP, R_CollectWarnings));`
248	`names = CAR(ATTRIB(R_Warnings));`	248	`names = CAR(ATTRIB(R_Warnings));`
249	`for(i=0; i<R_CollectWarnings; i++) {`	249	`for(i=0; i<R_CollectWarnings; i++) {`
250	`VECTOR(s)[i] = VECTOR(R_Warnings)[i];`	250	`SET_VECTOR_ELT(s, i, VECTOR_ELT(R_Warnings, i));`
251	`VECTOR(t)[i] = VECTOR(names)[i];`	251	`SET_VECTOR_ELT(t, i, VECTOR_ELT(names, i));`
252	`}`	252	`}`
253	`setAttrib(s, R_NamesSymbol, t);`	253	`setAttrib(s, R_NamesSymbol, t);`
254	`defineVar(install("last.warning"), s, R_GlobalEnv);`	254	`defineVar(install("last.warning"), s, R_GlobalEnv);`
255	`UNPROTECT(2);`	255	`UNPROTECT(2);`
256	`inWarning = 0;`	256	`inWarning = 0;`
Line 273...	Line 273...
273	`jump_now();`	273	`jump_now();`
274	`}`	274	`}`
275		275
276	`if(call != R_NilValue) {`	276	`if(call != R_NilValue) {`
277	`inError = 1;`	277	`inError = 1;`
278	`dcall = CHAR(STRING(deparse1(call, 0))[0]);`	278	`dcall = CHAR(STRING_ELT(deparse1(call, 0), 0));`
279	`sprintf(errbuf, "Error in %s : ", dcall);`	279	`sprintf(errbuf, "Error in %s : ", dcall);`
280	`if (strlen(dcall) > LONGCALL) strcat(errbuf, "\n ");/* <- TAB */`	280	`if (strlen(dcall) > LONGCALL) strcat(errbuf, "\n ");/* <- TAB */`
281	`}`	281	`}`
282	`else`	282	`else`
283	`sprintf(errbuf, "Error: ");`	283	`sprintf(errbuf, "Error: ");`
Line 296...	Line 296...
296	`{`	296	`{`
297	`SEXP res;`	297	`SEXP res;`
298		298
299	`checkArity(op, args);`	299	`checkArity(op, args);`
300	`PROTECT(res = allocVector(STRSXP, 1));`	300	`PROTECT(res = allocVector(STRSXP, 1));`
301	`STRING(res)[0] = mkChar(errbuf);`	301	`SET_STRING_ELT(res, 0, mkChar(errbuf));`
302	`UNPROTECT(1);`	302	`UNPROTECT(1);`
303	`return res;`	303	`return res;`
304	`}`	304	`}`
305		305
306	`void error(const char *format, ...)`	306	`void error(const char *format, ...)`
Line 351...	Line 351...
351	`eval(s, c->cloenv);`	351	`eval(s, c->cloenv);`
352	`else /* expression */`	352	`else /* expression */`
353	`{`	353	`{`
354	`int i, n = LENGTH(s);`	354	`int i, n = LENGTH(s);`
355	`for (i = 0 ; i < n ; i++)`	355	`for (i = 0 ; i < n ; i++)`
356	`eval(VECTOR(s)[i], c->cloenv);`	356	`eval(VECTOR_ELT(s, i), c->cloenv);`
357	`}`	357	`}`
358	`inError = 1;`	358	`inError = 1;`
359	`}`	359	`}`
360	`}`	360	`}`
361		361
Line 386...	Line 386...
386	`else R_Outputfile = R_Consolefile;`	386	`else R_Outputfile = R_Consolefile;`
387	`PROTECT(s = allocList(nback));`	387	`PROTECT(s = allocList(nback));`
388	`t = s;`	388	`t = s;`
389	`for (c = R_GlobalContext ; c ; c = c->nextcontext)`	389	`for (c = R_GlobalContext ; c ; c = c->nextcontext)`
390	`if (c->callflag & CTXT_FUNCTION ) {`	390	`if (c->callflag & CTXT_FUNCTION ) {`
391	`CAR(t) = deparse1(c->call, 0);`	391	`SETCAR(t, deparse1(c->call, 0));`
392	`t = CDR(t);`	392	`t = CDR(t);`
393	`}`	393	`}`
394	`setVar(install(".Traceback"), s, R_GlobalEnv);`	394	`setVar(install(".Traceback"), s, R_GlobalEnv);`
395	`UNPROTECT(1);`	395	`UNPROTECT(1);`
396	`jump_now();`	396	`jump_now();`
Line 449...	Line 449...
449	`c_call = R_NilValue;`	449	`c_call = R_NilValue;`
450		450
451	`args = CDR(args);`	451	`args = CDR(args);`
452		452
453	`if (CAR(args) != R_NilValue) { /* message */`	453	`if (CAR(args) != R_NilValue) { /* message */`
454	`CAR(args) = coerceVector(CAR(args), STRSXP);`	454	`SETCAR(args, coerceVector(CAR(args), STRSXP));`
455	`if(!isValidString(CAR(args)))`	455	`if(!isValidString(CAR(args)))`
456	`errorcall(c_call, " [invalid string in stop(.)]");`	456	`errorcall(c_call, " [invalid string in stop(.)]");`
457	`errorcall(c_call, "%s", CHAR(STRING(CAR(args))[0]));`	457	`errorcall(c_call, "%s", CHAR(STRING_ELT(CAR(args), 0)));`
458	`}`	458	`}`
459	`else`	459	`else`
460	`errorcall(c_call, "");`	460	`errorcall(c_call, "");`
461	`}`	461	`}`
462		462
Line 466...	Line 466...
466		466
467	`cptr = R_GlobalContext->nextcontext;`	467	`cptr = R_GlobalContext->nextcontext;`
468	`while ( !(cptr->callflag & CTXT_FUNCTION) && cptr->nextcontext != NULL)`	468	`while ( !(cptr->callflag & CTXT_FUNCTION) && cptr->nextcontext != NULL)`
469	`cptr = cptr->nextcontext;`	469	`cptr = cptr->nextcontext;`
470	`if (CAR(args) != R_NilValue) {`	470	`if (CAR(args) != R_NilValue) {`
471	`CAR(args) = coerceVector(CAR(args), STRSXP);`	471	`SETCAR(args, coerceVector(CAR(args), STRSXP));`
472	`if(!isValidString(CAR(args)))`	472	`if(!isValidString(CAR(args)))`
473	`warningcall(cptr->call, " [invalid string in warning(.)]");`	473	`warningcall(cptr->call, " [invalid string in warning(.)]");`
474	`else`	474	`else`
475	`warningcall(cptr->call,"%s", CHAR(STRING(CAR(args))[0]));`	475	`warningcall(cptr->call,"%s", CHAR(STRING_ELT(CAR(args), 0)));`
476	`}`	476	`}`
477	`else`	477	`else`
478	`warningcall(cptr->call,"");`	478	`warningcall(cptr->call,"");`
479	`return CAR(args);`	479	`return CAR(args);`
480	`}`	480	`}`
Line 512...	Line 512...
512	`va_list(ap);`	512	`va_list(ap);`
513	`char *dcall;`	513	`char *dcall;`
514	`if (inError)`	514	`if (inError)`
515	`jump_now();`	515	`jump_now();`
516	`if (call != R_NilValue) {`	516	`if (call != R_NilValue) {`
517	`dcall = CHAR(STRING(deparse1(call, 0))[0]);`	517	`dcall = CHAR(STRING_ELT(deparse1(call, 0), 0));`
518	`REprintf("Error in %s : ", dcall);`	518	`REprintf("Error in %s : ", dcall);`
519	`if (strlen(dcall) > LONGCALL) REprintf("\n ");`	519	`if (strlen(dcall) > LONGCALL) REprintf("\n ");`
520	`}`	520	`}`
521	`else`	521	`else`
522	`REprintf("Error: "); /* -- dcall = ??? */`	522	`REprintf("Error: "); /* -- dcall = ??? */`
Line 546...	Line 546...
546	`va_list(ap);`	546	`va_list(ap);`
547	`char *dcall;`	547	`char *dcall;`
548	`if (inError)`	548	`if (inError)`
549	`jump_now();`	549	`jump_now();`
550	`if (call != R_NilValue) {`	550	`if (call != R_NilValue) {`
551	`dcall = CHAR(STRING(deparse1(call, 0))[0]);`	551	`dcall = CHAR(STRING_ELT(deparse1(call, 0), 0));`
552	`REprintf("Warning in %s : ", dcall);`	552	`REprintf("Warning in %s : ", dcall);`
553	`}`	553	`}`
554	`else`	554	`else`
555	`REprintf("Warning: "); /* -- dcall = ??? */`	555	`REprintf("Warning: "); /* -- dcall = ??? */`
556	`i = 0;`	556	`i = 0;`

The R Project SVN R

(root)/branches/R-GenGC/src/main/errors.c @ 28362 – Rev 9615 → 9642