1 /* $Id: message.c,v 1.12 2004/11/14 16:29:47 moniot Exp $
2
3 Error and warning routines
4 */
5
6 /*
7
8
9 Copyright (c) 2001 by Robert K. Moniot.
10
11 Permission is hereby granted, free of charge, to any person
12 obtaining a copy of this software and associated documentation
13 files (the "Software"), to deal in the Software without
14 restriction, including without limitation the rights to use,
15 copy, modify, merge, publish, distribute, sublicense, and/or
16 sell copies of the Software, and to permit persons to whom the
17 Software is furnished to do so, subject to the following
18 conditions:
19
20 The above copyright notice and this permission notice shall be
21 included in all copies or substantial portions of the
22 Software.
23
24 THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY
25 KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE
26 WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
27 PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
28 COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
29 LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR
30 OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
31 SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
32
33 Acknowledgement: the above permission notice is what is known
34 as the "MIT License."
35 */
36
37 #include <stdio.h>
38 #include <ctype.h>
39 #include <string.h>
40 #include "ftnchek.h"
41
42 PROTO(PRIVATE void error_message,( const char *filename, LINENO_t lineno,
43 COLNO_t colno, const char *s, const char *tag ));
44 PROTO(PRIVATE void lintstyle_error_message,( const char *filename, LINENO_t lineno,
45 COLNO_t colno, const char *s, const char *tag ));
46 PROTO(PRIVATE void oldstyle_error_message,( const char *filename, LINENO_t lineno,
47 COLNO_t colno, const char *s, const char *tag ));
48
49 void
50 #if HAVE_STDC
lex_error(const char * s)51 lex_error(const char *s)
52 #else /* K&R style */
53 lex_error(s)
54 char *s;
55 #endif /* HAVE_STDC */
56 {
57 syntax_error(line_num,col_num,s);
58 }
59
60
61 void
62 #if HAVE_STDC
yyerror(const char * s)63 yyerror(const char *s)
64 #else /* K&R style */
65 yyerror(s)
66 char *s;
67 #endif /* HAVE_STDC */
68 {
69 static int parserror_explanation_given = FALSE;
70 syntax_error(line_num,col_num,s);
71
72 /* Novices are often thrown by terminology, so
73 we give them a little help. This message is
74 only given once per run.
75 Nov 2004: bison has reverted from "parse error"
76 to "syntax error" but we'll keep the explanatory
77 code in case it changes back in future.
78 */
79 if( novice_help && ! parserror_explanation_given &&
80 strncmp(s,"parse error",sizeof("parse error")-1) == 0 ) {
81 error_message((char *)NULL, NO_LINE_NUM, NO_COL_NUM,
82 "(A parse error means that I am not able to make sense of this statement,",
83 (char *)NULL );
84 msg_tail("because your program has broken some rule of Fortran syntax.)");
85 parserror_explanation_given = TRUE;
86 }
87 }
88
89
90 void
91 #if HAVE_STDC
syntax_error(LINENO_t lineno,COLNO_t colno,const char * s)92 syntax_error(LINENO_t lineno, COLNO_t colno, const char *s) /* Syntax error message */
93 #else /* K&R style */
94 syntax_error(lineno,colno,s) /* Syntax error message */
95 LINENO_t lineno;
96 COLNO_t colno;
97 char *s;
98 #endif /* HAVE_STDC */
99 {
100 ++error_count;
101 error_message(current_filename,lineno,colno,s,"Error");
102 }
103
104 void
105 #if HAVE_STDC
warning(LINENO_t lineno,COLNO_t colno,const char * s)106 warning(LINENO_t lineno, COLNO_t colno, const char *s) /* Print warning message */
107 #else /* K&R style */
108 warning(lineno,colno,s)
109 LINENO_t lineno;
110 COLNO_t colno;
111 char *s;
112 #endif /* HAVE_STDC */
113 {
114 ++warning_count;
115
116 error_message(current_filename,lineno,colno,s,"Warning");
117 }
118
119 void
120 #if HAVE_STDC
ugly_code(LINENO_t lineno,COLNO_t colno,const char * s)121 ugly_code(LINENO_t lineno, COLNO_t colno, const char *s) /* -pretty message */
122 #else /* K&R style */
123 ugly_code(lineno,colno,s)
124 LINENO_t lineno;
125 COLNO_t colno;
126 char *s;
127 #endif /* HAVE_STDC */
128 {
129 ++warning_count;
130
131 error_message(current_filename,lineno,colno,s,"Possibly misleading appearance");
132 }
133
134 void
135 #if HAVE_STDC
nonstandard(LINENO_t lineno,COLNO_t colno,int f90,int f95)136 nonstandard(LINENO_t lineno, COLNO_t colno, int f90, int f95)
137 #else /* K&R style */
138 nonstandard(lineno,colno, f90, f95)
139 LINENO_t lineno;
140 COLNO_t colno;
141 int f90, f95;
142 #endif /* HAVE_STDC */
143 {
144 ++warning_count;
145 if( f95 ) {
146 error_message(current_filename,lineno,colno,"Syntax deleted in Fortran 95","Warning");
147 }
148 else {
149 error_message(current_filename,lineno,colno,"Nonstandard syntax","Warning");
150 if( f90 )
151 msg_tail("(not adopted in Fortran 90)");
152 }
153 }
154
155 void
156 #if HAVE_STDC
nonportable(LINENO_t lineno,COLNO_t colno,const char * s)157 nonportable(LINENO_t lineno, COLNO_t colno, const char *s) /* Print warning about nonportable construction */
158 #else /* K&R style */
159 nonportable(lineno,colno,s) /* Print warning about nonportable construction */
160 LINENO_t lineno;
161 COLNO_t colno;
162 char *s;
163 #endif /* HAVE_STDC */
164 {
165 ++warning_count;
166 error_message(current_filename,lineno,colno,s,"Nonportable usage");
167 }
168
169 /* Routine to print messages from local symtab checking
170 routines. */
171
172 void
173 #if HAVE_STDC
local_message(const char * filename,LINENO_t lineno,const char * s,const char * tag)174 local_message(const char *filename, LINENO_t lineno, const char *s, const char *tag)
175 #else /* K&R style */
176 local_message(filename, lineno, s, tag)
177 char *filename;
178 LINENO_t lineno;
179 char *s;
180 char *tag;
181 #endif /* HAVE_STDC */
182 {
183 error_message(filename,lineno,GLOBAL_NO_COL_NUM,s,tag);
184 }
185
186 /* Routine to print messages from global checking
187 routines. Here the filename is given as an
188 argument since it varies with each call. */
189
190 void
191 #if HAVE_STDC
global_warning(const char * filename,LINENO_t lineno,const char * s)192 global_warning(const char *filename, LINENO_t lineno, const char *s)
193 #else /* K&R style */
194 global_warning(filename,lineno,s)
195 char *filename;
196 LINENO_t lineno;
197 char *s;
198 #endif /* HAVE_STDC */
199 {
200 ++warning_count;
201 error_message(filename,lineno,GLOBAL_NO_COL_NUM,s,"Warning");
202 }
203
204 void
205 #if HAVE_STDC
global_message(const char * filename,LINENO_t lineno,const char * s)206 global_message(const char *filename, LINENO_t lineno, const char *s)
207 #else /* K&R style */
208 global_message(filename,lineno,s)
209 char *filename;
210 LINENO_t lineno;
211 char *s;
212 #endif /* HAVE_STDC */
213 {
214 ++warning_count;
215 error_message(filename,lineno,GLOBAL_NO_COL_NUM,s,NULL);
216 }
217
218 /* error_message prints out error messages and warnings. It
219 now comes in two flavors. If using lintstyle_error_message(),
220 messages are produced in style like UNIX lint:
221
222 "main.f", line nn, col nn: Error: your message here
223
224 Otherwise messages by oldstyle_error_message in old ftnchek style:
225
226 Error near line nn col nn file main.f: your message here
227
228 At this time, oldstyle_error_message is used when -novice is
229 in effect, lintstyle_error_message otherwise.
230 */
231
232 PRIVATE int errmsg_col;
233 /* Crude macro to give number of digits in line and column numbers.
234 Used by line wrap computation. */
235 #define NUM_DIGITS(n) ((n)<10?1:((n)<100?2:((n)<1000?3:(n)<10000?4:5)))
236
237 PRIVATE void
238 #if HAVE_STDC
error_message(const char * filename,LINENO_t lineno,COLNO_t colno,const char * s,const char * tag)239 error_message(const char *filename,LINENO_t lineno, COLNO_t colno, const char *s, const char *tag)
240 #else /* K&R style */
241 error_message(filename,lineno,colno,s,tag)
242 char *filename;
243 LINENO_t lineno;
244 COLNO_t colno;
245 char *s,*tag;
246 #endif /* HAVE_STDC */
247 {
248 if(novice_help)
249 oldstyle_error_message(filename,lineno,colno,s,tag);
250 else
251 lintstyle_error_message(filename,lineno,colno,s,tag);
252 }
253
254 PRIVATE void
255 #if HAVE_STDC
lintstyle_error_message(const char * filename,LINENO_t lineno,COLNO_t colno,const char * s,const char * tag)256 lintstyle_error_message(const char *filename,LINENO_t lineno, COLNO_t colno, const char *s, const char *tag)
257 #else /* K&R style */
258 lintstyle_error_message(filename,lineno,colno,s,tag)
259 char *filename;
260 LINENO_t lineno;
261 COLNO_t colno;
262 char *s,*tag;
263 #endif /* HAVE_STDC */
264 {
265 COLNO_t icol;
266 extern LINENO_t prev_stmt_line_num; /* shared with advance.c */
267
268 errmsg_col=1; /* Keep track of line length */
269
270 /* Print the character ^ under the column number.
271 But if colno == 0, error occurred in prior line.
272 If colno is NO_COL_NUM, then print message
273 without any column number given. N.B. colno ==
274 GLOBAL_COL_NUM means this is from local or global
275 message routines, don't flush line out.
276 */
277
278 if(lineno != NO_LINE_NUM && colno != GLOBAL_NO_COL_NUM) {
279 if(colno == NO_COL_NUM) {
280 /* colno == NO_COL_NUM means don't give column number.*/
281 (void)flush_line_out(lineno);/* print line if not printed yet */
282 }
283 else if(colno != 0) {
284 /* print line if not printed yet */
285 if( flush_line_out(lineno) ) {
286 /* If it was printed, put ^ under the col */
287 (void)fprintf(list_fd,"\n%8s","");
288
289 for(icol=1; icol<colno; icol++)
290 (void)fprintf(list_fd," ");
291 (void)fprintf(list_fd,"^");
292 }
293 }
294 else { /* colno == 0 */
295 /* print line if not printed yet */
296 (void)flush_line_out(prev_stmt_line_num);
297 }
298 }
299
300 if( filename != (char *)NULL ) {
301 (void)fprintf(list_fd,"\n\"%s\"",filename);
302 errmsg_col += 2+(int)strlen(filename);
303 }
304
305 if(lineno != NO_LINE_NUM) { /* nonlocal error-- don't flush */
306 if(colno == NO_COL_NUM) {
307 (void)fprintf(list_fd,
308 ", near line %u",lineno);
309 errmsg_col += 12+NUM_DIGITS(lineno);
310 }
311 else if(colno == GLOBAL_NO_COL_NUM) {
312 (void)fprintf(list_fd,
313 ", line %u",lineno);
314 errmsg_col += 7+NUM_DIGITS(lineno);
315 }
316 else if(colno != 0) {
317 (void)fprintf(list_fd,
318 ", line %u col %u",lineno,colno);
319 errmsg_col += 12+NUM_DIGITS(lineno);
320 }
321 else { /* colno == 0 */
322 (void)fprintf(list_fd,
323 ", near line %u",prev_stmt_line_num);
324 errmsg_col += 12+NUM_DIGITS(lineno);
325 }
326 }
327
328 if( tag != (char *)NULL ) {
329 msg_tail(":");
330 msg_tail(tag); /* "Warning", "Error", etc. */
331 }
332 if( s != (char *)NULL ) {
333 msg_tail(":");
334 msg_tail(s); /* now append the message string */
335 }
336 }
337
338 /* Our own style messages */
339 PRIVATE void
340 #if HAVE_STDC
oldstyle_error_message(const char * filename,LINENO_t lineno,COLNO_t colno,const char * s,const char * tag)341 oldstyle_error_message(const char *filename,LINENO_t lineno, COLNO_t colno, const char *s, const char *tag)
342 #else /* K&R style */
343 oldstyle_error_message(filename,lineno,colno,s,tag)
344 char *filename;
345 LINENO_t lineno;
346 COLNO_t colno;
347 char *s,*tag;
348 #endif /* HAVE_STDC */
349 {
350 COLNO_t icol;
351 extern LINENO_t prev_stmt_line_num; /* shared with advance.c */
352
353 errmsg_col=1; /* Keep track of line length */
354
355 /* Print the character ^ under the column number.
356 But if colno == 0, error occurred in prior line.
357 If colno is NO_COL_NUM, then print message
358 without any column number given. If tag is NULL,
359 this is an error_report from global checks, so
360 no location information is printed.
361 */
362
363 if( tag == (char *)NULL ) {
364 (void)fprintf(list_fd,"\n");
365 }
366 else {
367 if(lineno == NO_LINE_NUM) { /* nonlocal error-- don't flush */
368 (void)fprintf(list_fd,"\n%s",tag);
369 errmsg_col += strlen(tag);
370 }
371 else {
372 if(colno == NO_COL_NUM) {
373 /* colno == NO_COL_NUM means don't give column number.*/
374 (void)flush_line_out(lineno);/* print line if not printed yet */
375
376 (void)fprintf(list_fd,"\n%s near line %u",tag,lineno);
377 errmsg_col += 11+NUM_DIGITS(lineno)+(unsigned)strlen(tag);
378 }
379 /* global warnings don't have column numbers
380 but line number is exact.
381 */
382 else if(colno == GLOBAL_NO_COL_NUM) {
383 (void)fprintf(list_fd,
384 "\n%s at line %u",tag,lineno);
385 errmsg_col += 9+NUM_DIGITS(lineno)+(unsigned)strlen(tag);
386 }
387 else if(colno != 0) {
388 /* print line if not printed yet */
389 if( flush_line_out(lineno) ) {
390 /* If it was printed, put ^ under the col */
391 (void)fprintf(list_fd,"\n%8s","");
392
393 for(icol=1; icol<colno; icol++)
394 (void)fprintf(list_fd," ");
395 (void)fprintf(list_fd,"^");
396 }
397 (void)fprintf(list_fd,
398 "\n%s near line %u col %u",tag,lineno,colno);
399 errmsg_col += 16+NUM_DIGITS(lineno)+NUM_DIGITS(colno)
400 +(unsigned)strlen(tag);
401 }
402 else { /* colno == 0 */
403 /* print line if not printed yet */
404 (void)flush_line_out(prev_stmt_line_num);
405 (void)fprintf(list_fd,
406 "\n%s near line %u",tag,prev_stmt_line_num);
407 errmsg_col += 11+NUM_DIGITS(lineno)+(unsigned)strlen(tag);
408 }
409 }
410
411
412 if((!full_output /* Append file name if not listing */
413 || doing_wrapup /* or if this is a global error message */
414 || (doing_end_proc /* or a local message referring to inc file */
415 && filename != top_filename)
416 || incdepth > 0) /* Append include-file name if we are in one */
417 && filename != (char *)NULL ) { /* skip if multi-file message */
418 if(lineno == NO_LINE_NUM) { /* if no line no, preposition needed */
419 (void)fprintf(list_fd," in");
420 errmsg_col += 3;
421 }
422 (void)fprintf(list_fd," file %s",filename);
423 errmsg_col += 6+(unsigned)strlen(filename);
424 }
425 }/*end if(tag != NULL)*/
426
427 if( s != (char *)NULL ) {
428 if( tag != (char *)NULL ) {
429 msg_tail(":");
430 }
431 msg_tail(s); /* now append the message string */
432 }
433 }
434
435 /* msg_tail appends string s to current error message.
436 It prints one word at a time, starting a new line
437 when the message gets to be too long for one line.
438 */
439 void
440 #if HAVE_STDC
msg_tail(const char * s)441 msg_tail(const char *s)
442 #else /* K&R style */
443 msg_tail(s)
444 char *s;
445 #endif /* HAVE_STDC */
446 {
447 if( s[0] != '\0' ) {
448
449 int wordstart,wordend,leading_skip,wordchars;
450
451
452 /* Insert blanks between items. Exceptions:
453 colon, semicolon, closing paren
454 are used at start of some items and should
455 not be separated from preceding item.
456 */
457 if( s[0] != ':' && s[0] != ')' && s[0] != ';' ) {
458 (void)fprintf(list_fd," ");
459 errmsg_col++;
460 }
461
462 /* Each iteration of loop prints leading space and the
463 nonspace characters of a word. Loop invariant: wordstart
464 is index of leading space at start of word, wordend is
465 index of space char following word. */
466 wordstart=0;
467 while(s[wordstart] != '\0') {
468 leading_skip = TRUE;
469 for(wordend=wordstart; s[wordend] != '\0'; wordend++) {
470 if(leading_skip) { /* If skipping leading space chars */
471 if(!isspace(s[wordend]))
472 leading_skip = FALSE; /* go out of skip mode at nonspace */
473 }
474 else { /* If scanning word chars */
475 if(isspace(s[wordend]))
476 break; /* quit loop when space char found */
477 }
478 }
479 wordchars = wordend-wordstart;
480 /* If word doesn't fit, wrap to next line */
481 if( wrap_column > 0 && (errmsg_col += wordchars) > wrap_column) {
482 /* At start of line, replace zero or more
483 blanks by one blank. */
484 (void)fprintf(list_fd,"\n ");
485 while(isspace(s[wordstart])) {
486 ++wordstart;
487 --wordchars;
488 }
489 errmsg_col = wordchars+1;
490 }
491 /* Print the word */
492 while(wordstart < wordend) {
493 (void)putc(s[wordstart++],list_fd);
494 }
495 }
496 }
497 }
498
499
500 void
501 #if HAVE_STDC
oops_message(int severity,LINENO_t lineno,COLNO_t colno,const char * s)502 oops_message(int severity, LINENO_t lineno, COLNO_t colno, const char *s)
503 #else /* K&R style */
504 oops_message(severity,lineno,colno,s)
505 int severity;
506 LINENO_t lineno;
507 COLNO_t colno;
508 char *s;
509 #endif /* HAVE_STDC */
510 {
511 (void)fflush(list_fd);
512 (void)fprintf(stderr,"\nOops");
513 if(lineno != NO_LINE_NUM) {
514 (void)fprintf(stderr," at line %u",lineno);
515 if(colno != NO_COL_NUM)
516 (void)fprintf(stderr," at col %u",colno);
517 }
518 (void)fprintf(stderr," in file %s",current_filename);
519 (void)fprintf(stderr," -- %s",s);
520 if(severity == OOPS_FATAL) {
521 (void)fprintf(stderr,"\nFtnchek aborted\n");
522 exit(1);
523 }
524 }
525
526 void
527 #if HAVE_STDC
oops_tail(const char * s)528 oops_tail(const char *s)
529 #else /* K&R style */
530 oops_tail(s)
531 char *s;
532 #endif /* HAVE_STDC */
533 {
534 (void)fprintf(stderr," %s",s);
535 }
536
537
538 /* Routine to convert a long unsigned int to a string.
539 This uses a static array, so only one call can be
540 in action at a time. Intended for use when msg_tail
541 must print an integer.
542 */
543 char *
544 #if HAVE_STDC
ulongtostr(unsigned long num)545 ulongtostr(unsigned long num)
546 #else /* K&R style */
547 ulongtostr(num)
548 unsigned long num;
549 #endif /* HAVE_STDC */
550 {
551 static char str[MAX_ULONGTOSTR];
552 (void)sprintf(str,"%lu",num);
553 return str;
554 }
555