Mention KTR_IFQ and KTR_IF_START
[dragonfly.git] / contrib / gcc-3.4 / gcc / f / bad.c
blobbed9734ecc78a24e2429d611ca2af72832d08ce8
1 /* bad.c -- Implementation File (module.c template V1.0)
2 Copyright (C) 1995, 2002, 2003 Free Software Foundation, Inc.
3 Contributed by James Craig Burley.
5 This file is part of GNU Fortran.
7 GNU Fortran is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
10 any later version.
12 GNU Fortran is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Fortran; see the file COPYING. If not, write to
19 the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
20 02111-1307, USA.
22 Related Modules:
23 None
25 Description:
26 Handles the displaying of diagnostic messages regarding the user's source
27 files.
29 Modifications:
32 /* If there's a %E or %4 in the messages, set this to at least 5,
33 for example. */
35 #define FFEBAD_MAX_ 6
37 /* Include files. */
39 #include "proj.h"
40 #include "bad.h"
41 #include "flags.h"
42 #include "com.h"
43 #include "toplev.h"
44 #include "where.h"
45 #include "intl.h"
46 #include "diagnostic.h"
48 /* Externals defined here. */
50 bool ffebad_is_inhibited_ = FALSE;
52 /* Simple definitions and enumerations. */
54 #define FFEBAD_LONG_MSGS_ 1 /* 0 to use short (or same) messages. */
56 /* Internal typedefs. */
59 /* Private include files. */
62 /* Internal structure definitions. */
64 struct _ffebad_message_
66 const ffebadSeverity severity;
67 const char *const message;
70 /* Static objects accessed by functions in this module. */
72 static const struct _ffebad_message_ ffebad_messages_[]
75 #define FFEBAD_MSG(kwd,sev,msgid) { sev, msgid },
76 #if FFEBAD_LONG_MSGS_ == 0
77 #define LONG(m)
78 #define SHORT(m) m
79 #else
80 #define LONG(m) m
81 #define SHORT(m)
82 #endif
83 #include "bad.def"
84 #undef FFEBAD_MSG
85 #undef LONG
86 #undef SHORT
89 static struct
91 ffewhereLine line;
92 ffewhereColumn col;
93 ffebadIndex tag;
96 ffebad_here_[FFEBAD_MAX_];
97 static const char *ffebad_string_[FFEBAD_MAX_];
98 static ffebadIndex ffebad_order_[FFEBAD_MAX_];
99 static ffebad ffebad_errnum_;
100 static ffebadSeverity ffebad_severity_;
101 static const char *ffebad_message_;
102 static unsigned char ffebad_index_;
103 static ffebadIndex ffebad_places_;
104 static bool ffebad_is_temp_inhibited_; /* Effective setting of
105 _is_inhibited_ for this
106 _start/_finish invocation. */
108 /* Static functions (internal). */
110 static int ffebad_bufputs_ (char buf[], int bufi, const char *s);
112 /* Internal macros. */
114 #define ffebad_bufflush_(buf, bufi) \
115 (((buf)[bufi] = '\0'), fputs ((buf), stderr), 0)
116 #define ffebad_bufputc_(buf, bufi, c) \
117 (((bufi) == ARRAY_SIZE (buf)) \
118 ? (ffebad_bufflush_ ((buf), (bufi)), ((buf)[0] = (c)), 1) \
119 : (((buf)[bufi] = (c)), (bufi) + 1))
122 static int
123 ffebad_bufputs_ (char buf[], int bufi, const char *s)
125 for (; *s != '\0'; ++s)
126 bufi = ffebad_bufputc_ (buf, bufi, *s);
127 return bufi;
130 /* ffebad_init_0 -- Initialize
132 ffebad_init_0(); */
134 void
135 ffebad_init_0 (void)
137 assert (FFEBAD == ARRAY_SIZE (ffebad_messages_));
140 ffebadSeverity
141 ffebad_severity (ffebad errnum)
143 return ffebad_messages_[errnum].severity;
146 /* ffebad_start_ -- Start displaying an error message
148 ffebad_start(FFEBAD_SOME_ERROR_CODE);
150 Call ffebad_start to establish the message, ffebad_here and ffebad_string
151 to send run-time data to it as necessary, then ffebad_finish when through
152 to actually get it to print (to stderr).
154 Note: ffebad_start(errnum) turns into ffebad_start_(FALSE,errnum). No
155 outside caller should call ffebad_start_ directly (as indicated by the
156 trailing underscore).
158 Call ffebad_start to start a normal message, one that might be inhibited
159 by the current state of statement guessing. Call ffebad_start_lex
160 instead to start a message that is global to all statement guesses and
161 happens only once for all guesses (i.e. the lexer).
163 sev and message are overrides for the severity and messages when errnum
164 is FFEBAD, meaning the caller didn't want to have to put a message in
165 bad.def to produce a diagnostic. */
167 bool
168 ffebad_start_ (bool lex_override, ffebad errnum, ffebadSeverity sev,
169 const char *msgid)
171 unsigned char i;
173 if (ffebad_is_inhibited_ && !lex_override)
175 ffebad_is_temp_inhibited_ = TRUE;
176 return FALSE;
179 if (errnum != FFEBAD)
181 ffebad_severity_ = ffebad_messages_[errnum].severity;
182 ffebad_message_ = gettext (ffebad_messages_[errnum].message);
184 else
186 ffebad_severity_ = sev;
187 ffebad_message_ = gettext (msgid);
190 switch (ffebad_severity_)
191 { /* Tell toplev.c about this message. */
192 case FFEBAD_severityINFORMATIONAL:
193 case FFEBAD_severityTRIVIAL:
194 if (inhibit_warnings)
195 { /* User wants no warnings. */
196 ffebad_is_temp_inhibited_ = TRUE;
197 return FALSE;
199 /* Fall through. */
200 case FFEBAD_severityWARNING:
201 case FFEBAD_severityPECULIAR:
202 case FFEBAD_severityPEDANTIC:
203 if ((ffebad_severity_ != FFEBAD_severityPEDANTIC)
204 || !flag_pedantic_errors)
206 if (!diagnostic_report_warnings_p ())
207 { /* User wants no warnings. */
208 ffebad_is_temp_inhibited_ = TRUE;
209 return FALSE;
211 diagnostic_kind_count (global_dc, DK_WARNING)++;
212 break;
214 /* Fall through (PEDANTIC && flag_pedantic_errors). */
215 case FFEBAD_severityFATAL:
216 case FFEBAD_severityWEIRD:
217 case FFEBAD_severitySEVERE:
218 case FFEBAD_severityDISASTER:
219 diagnostic_kind_count (global_dc, DK_ERROR)++;
220 break;
222 default:
223 break;
226 ffebad_is_temp_inhibited_ = FALSE;
227 ffebad_errnum_ = errnum;
228 ffebad_index_ = 0;
229 ffebad_places_ = 0;
230 for (i = 0; i < FFEBAD_MAX_; ++i)
232 ffebad_string_[i] = NULL;
233 ffebad_here_[i].line = ffewhere_line_unknown ();
234 ffebad_here_[i].col = ffewhere_column_unknown ();
237 return TRUE;
240 /* ffebad_here -- Establish source location of some diagnostic concern
242 ffebad_here(ffebadIndex i,ffewhereLine line,ffewhereColumn col);
244 Call ffebad_start to establish the message, ffebad_here and ffebad_string
245 to send run-time data to it as necessary, then ffebad_finish when through
246 to actually get it to print (to stderr). */
248 void
249 ffebad_here (ffebadIndex index, ffewhereLine line, ffewhereColumn col)
251 ffewhereLineNumber line_num;
252 ffewhereLineNumber ln;
253 ffewhereColumnNumber col_num;
254 ffewhereColumnNumber cn;
255 ffebadIndex i;
256 ffebadIndex j;
258 if (ffebad_is_temp_inhibited_)
259 return;
261 assert (index < FFEBAD_MAX_);
262 ffebad_here_[index].line = ffewhere_line_use (line);
263 ffebad_here_[index].col = ffewhere_column_use (col);
264 if (ffewhere_line_is_unknown (line)
265 || ffewhere_column_is_unknown (col))
267 ffebad_here_[index].tag = FFEBAD_MAX_;
268 return;
270 ffebad_here_[index].tag = 0; /* For now, though it shouldn't matter. */
272 /* Sort the source line/col points into the order they occur in the source
273 file. Deal with duplicates appropriately. */
275 line_num = ffewhere_line_number (line);
276 col_num = ffewhere_column_number (col);
278 /* Determine where in the ffebad_order_ array this new place should go. */
280 for (i = 0; i < ffebad_places_; ++i)
282 ln = ffewhere_line_number (ffebad_here_[ffebad_order_[i]].line);
283 cn = ffewhere_column_number (ffebad_here_[ffebad_order_[i]].col);
284 if (line_num < ln)
285 break;
286 if (line_num == ln)
288 if (col_num == cn)
290 ffebad_here_[index].tag = i;
291 return; /* Shouldn't go in, has equivalent. */
293 else if (col_num < cn)
294 break;
298 /* Before putting new place in ffebad_order_[i], first increment all tags
299 that are i or greater. */
301 if (i != ffebad_places_)
303 for (j = 0; j < FFEBAD_MAX_; ++j)
305 if (ffebad_here_[j].tag >= i)
306 ++ffebad_here_[j].tag;
310 /* Then slide all ffebad_order_[] entries at and above i up one entry. */
312 for (j = ffebad_places_; j > i; --j)
313 ffebad_order_[j] = ffebad_order_[j - 1];
315 /* Finally can put new info in ffebad_order_[i]. */
317 ffebad_order_[i] = index;
318 ffebad_here_[index].tag = i;
319 ++ffebad_places_;
322 /* Establish string for next index (always in order) of message
324 ffebad_string(const char *string);
326 Call ffebad_start to establish the message, ffebad_here and ffebad_string
327 to send run-time data to it as necessary, then ffebad_finish when through
328 to actually get it to print (to stderr). Note: don't trash the string
329 until after calling ffebad_finish, since we just maintain a pointer to
330 the argument passed in until then. */
332 void
333 ffebad_string (const char *string)
335 if (ffebad_is_temp_inhibited_)
336 return;
338 assert (ffebad_index_ != FFEBAD_MAX_);
339 ffebad_string_[ffebad_index_++] = string;
342 /* ffebad_finish -- Display error message with where & run-time info
344 ffebad_finish();
346 Call ffebad_start to establish the message, ffebad_here and ffebad_string
347 to send run-time data to it as necessary, then ffebad_finish when through
348 to actually get it to print (to stderr). */
350 void
351 ffebad_finish (void)
353 #define MAX_SPACES 132
354 static const char *const spaces
355 = "...>\
356 \040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\
357 \040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\
358 \040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\
359 \040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\
360 \040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\
361 \040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\
362 \040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\
363 \040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\
364 \040\040\040"; /* MAX_SPACES - 1 spaces. */
365 ffewhereLineNumber last_line_num;
366 ffewhereLineNumber ln;
367 ffewhereLineNumber rn;
368 ffewhereColumnNumber last_col_num;
369 ffewhereColumnNumber cn;
370 ffewhereColumnNumber cnt;
371 ffewhereLine l;
372 ffebadIndex bi;
373 unsigned short i;
374 char pointer;
375 unsigned char c;
376 unsigned const char *s;
377 const char *fn;
378 static char buf[1024];
379 int bufi;
380 int index;
382 if (ffebad_is_temp_inhibited_)
383 return;
385 switch (ffebad_severity_)
387 case FFEBAD_severityINFORMATIONAL:
388 s = _("note:");
389 break;
391 case FFEBAD_severityWARNING:
392 s = _("warning:");
393 break;
395 case FFEBAD_severitySEVERE:
396 s = _("fatal:");
397 break;
399 default:
400 s = "";
401 break;
404 /* Display the annoying source references. */
406 last_line_num = 0;
407 last_col_num = 0;
409 for (bi = 0; bi < ffebad_places_; ++bi)
411 if (ffebad_places_ == 1)
412 pointer = '^';
413 else
414 pointer = '1' + bi;
416 l = ffebad_here_[ffebad_order_[bi]].line;
417 ln = ffewhere_line_number (l);
418 rn = ffewhere_line_filelinenum (l);
419 cn = ffewhere_column_number (ffebad_here_[ffebad_order_[bi]].col);
420 fn = ffewhere_line_filename (l);
421 if (ln != last_line_num)
423 if (bi != 0)
424 fputc ('\n', stderr);
425 diagnostic_report_current_function (global_dc);
426 fprintf (stderr,
427 /* the trailing space on the <file>:<line>: line
428 fools emacs19 compilation mode into finding the
429 report */
430 "%s:%" ffewhereLineNumber_f "u: %s\n %s\n %s%c",
431 fn, rn,
433 ffewhere_line_content (l),
434 &spaces[cn > MAX_SPACES ? 0 : MAX_SPACES - cn + 4],
435 pointer);
436 last_line_num = ln;
437 last_col_num = cn;
438 s = _("(continued):");
440 else
442 cnt = cn - last_col_num;
443 fprintf (stderr,
444 "%s%c", &spaces[cnt > MAX_SPACES
445 ? 0 : MAX_SPACES - cnt + 4],
446 pointer);
447 last_col_num = cn;
450 if (ffebad_places_ == 0)
452 /* Didn't output "warning:" string, capitalize it for message. */
453 if (s[0] != '\0')
455 char c;
457 c = TOUPPER (s[0]);
458 fprintf (stderr, "%c%s ", c, &s[1]);
460 else if (s[0] != '\0')
461 fprintf (stderr, "%s ", s);
463 else
464 fputc ('\n', stderr);
466 /* Release the ffewhere info. */
468 for (bi = 0; bi < FFEBAD_MAX_; ++bi)
470 ffewhere_line_kill (ffebad_here_[bi].line);
471 ffewhere_column_kill (ffebad_here_[bi].col);
474 /* Now display the message. */
476 bufi = 0;
477 for (i = 0; (c = ffebad_message_[i]) != '\0'; ++i)
479 if (c == '%')
481 c = ffebad_message_[++i];
482 if (ISUPPER (c))
484 index = c - 'A';
486 if ((index < 0) || (index >= FFEBAD_MAX_))
488 bufi = ffebad_bufputs_ (buf, bufi, _("[REPORT BUG!!] %"));
489 bufi = ffebad_bufputc_ (buf, bufi, c);
491 else
493 s = ffebad_string_[index];
494 if (s == NULL)
495 bufi = ffebad_bufputs_ (buf, bufi, _("[REPORT BUG!!]"));
496 else
497 bufi = ffebad_bufputs_ (buf, bufi, s);
500 else if (ISDIGIT (c))
502 index = c - '0';
504 if ((index < 0) || (index >= FFEBAD_MAX_))
506 bufi = ffebad_bufputs_ (buf, bufi, _("[REPORT BUG!!] %"));
507 bufi = ffebad_bufputc_ (buf, bufi, c);
509 else
511 pointer = ffebad_here_[index].tag + '1';
512 if (pointer == FFEBAD_MAX_ + '1')
513 pointer = '?';
514 else if (ffebad_places_ == 1)
515 pointer = '^';
516 bufi = ffebad_bufputc_ (buf, bufi, '(');
517 bufi = ffebad_bufputc_ (buf, bufi, pointer);
518 bufi = ffebad_bufputc_ (buf, bufi, ')');
521 else if (c == '\0')
522 break;
523 else if (c == '%')
524 bufi = ffebad_bufputc_ (buf, bufi, '%');
525 else
527 bufi = ffebad_bufputs_ (buf, bufi, _("[REPORT BUG!!]"));
528 bufi = ffebad_bufputc_ (buf, bufi, '%');
529 bufi = ffebad_bufputc_ (buf, bufi, c);
532 else
533 bufi = ffebad_bufputc_ (buf, bufi, c);
535 bufi = ffebad_bufputc_ (buf, bufi, '\n');
536 bufi = ffebad_bufflush_ (buf, bufi);