1 /* bad.c -- Implementation File (module.c template V1.0)
2 Copyright (C) 1995 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)
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
26 Handles the displaying of diagnostic messages regarding the user's source
32 /* If there's a %E or %4 in the messages, set this to at least 5,
46 /* Externals defined here. */
48 bool ffebad_is_inhibited_
= FALSE
;
50 /* Simple definitions and enumerations. */
52 #define FFEBAD_LONG_MSGS_ 1 /* 0 to use short (or same) messages. */
54 /* Internal typedefs. */
57 /* Private include files. */
60 /* Internal structure definitions. */
62 struct _ffebad_message_
64 ffebadSeverity severity
;
68 /* Static objects accessed by functions in this module. */
70 static struct _ffebad_message_ ffebad_messages_
[]
73 #define FFEBAD_MSGS1(KWD,SEV,MSG) { SEV, MSG },
74 #if FFEBAD_LONG_MSGS_ == 0
75 #define FFEBAD_MSGS2(KWD,SEV,LMSG,SMSG) { SEV, SMSG },
77 #define FFEBAD_MSGS2(KWD,SEV,LMSG,SMSG) { SEV, LMSG },
91 ffebad_here_
[FFEBAD_MAX_
];
92 static const char *ffebad_string_
[FFEBAD_MAX_
];
93 static ffebadIndex ffebad_order_
[FFEBAD_MAX_
];
94 static ffebad ffebad_errnum_
;
95 static ffebadSeverity ffebad_severity_
;
96 static const char *ffebad_message_
;
97 static unsigned char ffebad_index_
;
98 static ffebadIndex ffebad_places_
;
99 static bool ffebad_is_temp_inhibited_
; /* Effective setting of
100 _is_inhibited_ for this
101 _start/_finish invocation. */
103 /* Static functions (internal). */
105 static int ffebad_bufputs_ (char buf
[], int bufi
, const char *s
);
107 /* Internal macros. */
109 #define ffebad_bufflush_(buf, bufi) \
110 (((buf)[bufi] = '\0'), fputs ((buf), stderr), 0)
111 #define ffebad_bufputc_(buf, bufi, c) \
112 (((bufi) == ARRAY_SIZE (buf)) \
113 ? (ffebad_bufflush_ ((buf), (bufi)), ((buf)[0] = (c)), 1) \
114 : (((buf)[bufi] = (c)), (bufi) + 1))
118 ffebad_bufputs_ (char buf
[], int bufi
, const char *s
)
120 for (; *s
!= '\0'; ++s
)
121 bufi
= ffebad_bufputc_ (buf
, bufi
, *s
);
125 /* ffebad_init_0 -- Initialize
132 assert (FFEBAD
== ARRAY_SIZE (ffebad_messages_
));
136 ffebad_severity (ffebad errnum
)
138 return ffebad_messages_
[errnum
].severity
;
141 /* ffebad_start_ -- Start displaying an error message
143 ffebad_start(FFEBAD_SOME_ERROR_CODE);
145 Call ffebad_start to establish the message, ffebad_here and ffebad_string
146 to send run-time data to it as necessary, then ffebad_finish when through
147 to actually get it to print (to stderr).
149 Note: ffebad_start(errnum) turns into ffebad_start_(FALSE,errnum). No
150 outside caller should call ffebad_start_ directly (as indicated by the
151 trailing underscore).
153 Call ffebad_start to start a normal message, one that might be inhibited
154 by the current state of statement guessing. Call ffebad_start_lex
155 instead to start a message that is global to all statement guesses and
156 happens only once for all guesses (i.e. the lexer).
158 sev and message are overrides for the severity and messages when errnum
159 is FFEBAD, meaning the caller didn't want to have to put a message in
160 bad.def to produce a diagnostic. */
163 ffebad_start_ (bool lex_override
, ffebad errnum
, ffebadSeverity sev
,
168 if (ffebad_is_inhibited_
&& !lex_override
)
170 ffebad_is_temp_inhibited_
= TRUE
;
174 if (errnum
!= FFEBAD
)
176 ffebad_severity_
= ffebad_messages_
[errnum
].severity
;
177 ffebad_message_
= ffebad_messages_
[errnum
].message
;
181 ffebad_severity_
= sev
;
182 ffebad_message_
= message
;
185 #if FFECOM_targetCURRENT == FFECOM_targetGCC
187 switch (ffebad_severity_
)
188 { /* Tell toplev.c about this message. */
189 case FFEBAD_severityINFORMATIONAL
:
190 case FFEBAD_severityTRIVIAL
:
191 if (inhibit_warnings
)
192 { /* User wants no warnings. */
193 ffebad_is_temp_inhibited_
= TRUE
;
197 case FFEBAD_severityWARNING
:
198 case FFEBAD_severityPECULIAR
:
199 case FFEBAD_severityPEDANTIC
:
200 if ((ffebad_severity_
!= FFEBAD_severityPEDANTIC
)
201 || !flag_pedantic_errors
)
203 if (count_error (1) == 0)
204 { /* User wants no warnings. */
205 ffebad_is_temp_inhibited_
= TRUE
;
210 /* Fall through (PEDANTIC && flag_pedantic_errors). */
211 case FFEBAD_severityFATAL
:
212 case FFEBAD_severityWEIRD
:
213 case FFEBAD_severitySEVERE
:
214 case FFEBAD_severityDISASTER
:
222 #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
224 ffebad_is_temp_inhibited_
= FALSE
;
225 ffebad_errnum_
= errnum
;
228 for (i
= 0; i
< FFEBAD_MAX_
; ++i
)
230 ffebad_string_
[i
] = NULL
;
231 ffebad_here_
[i
].line
= ffewhere_line_unknown ();
232 ffebad_here_
[i
].col
= ffewhere_column_unknown ();
238 /* ffebad_here -- Establish source location of some diagnostic concern
240 ffebad_here(ffebadIndex i,ffewhereLine line,ffewhereColumn col);
242 Call ffebad_start to establish the message, ffebad_here and ffebad_string
243 to send run-time data to it as necessary, then ffebad_finish when through
244 to actually get it to print (to stderr). */
247 ffebad_here (ffebadIndex index
, ffewhereLine line
, ffewhereColumn col
)
249 ffewhereLineNumber line_num
;
250 ffewhereLineNumber ln
;
251 ffewhereColumnNumber col_num
;
252 ffewhereColumnNumber cn
;
256 if (ffebad_is_temp_inhibited_
)
259 assert (index
< FFEBAD_MAX_
);
260 ffebad_here_
[index
].line
= ffewhere_line_use (line
);
261 ffebad_here_
[index
].col
= ffewhere_column_use (col
);
262 if (ffewhere_line_is_unknown (line
)
263 || ffewhere_column_is_unknown (col
))
265 ffebad_here_
[index
].tag
= FFEBAD_MAX_
;
268 ffebad_here_
[index
].tag
= 0; /* For now, though it shouldn't matter. */
270 /* Sort the source line/col points into the order they occur in the source
271 file. Deal with duplicates appropriately. */
273 line_num
= ffewhere_line_number (line
);
274 col_num
= ffewhere_column_number (col
);
276 /* Determine where in the ffebad_order_ array this new place should go. */
278 for (i
= 0; i
< ffebad_places_
; ++i
)
280 ln
= ffewhere_line_number (ffebad_here_
[ffebad_order_
[i
]].line
);
281 cn
= ffewhere_column_number (ffebad_here_
[ffebad_order_
[i
]].col
);
288 ffebad_here_
[index
].tag
= i
;
289 return; /* Shouldn't go in, has equivalent. */
291 else if (col_num
< cn
)
296 /* Before putting new place in ffebad_order_[i], first increment all tags
297 that are i or greater. */
299 if (i
!= ffebad_places_
)
301 for (j
= 0; j
< FFEBAD_MAX_
; ++j
)
303 if (ffebad_here_
[j
].tag
>= i
)
304 ++ffebad_here_
[j
].tag
;
308 /* Then slide all ffebad_order_[] entries at and above i up one entry. */
310 for (j
= ffebad_places_
; j
> i
; --j
)
311 ffebad_order_
[j
] = ffebad_order_
[j
- 1];
313 /* Finally can put new info in ffebad_order_[i]. */
315 ffebad_order_
[i
] = index
;
316 ffebad_here_
[index
].tag
= i
;
320 /* Establish string for next index (always in order) of message
322 ffebad_string(const char *string);
324 Call ffebad_start to establish the message, ffebad_here and ffebad_string
325 to send run-time data to it as necessary, then ffebad_finish when through
326 to actually get it to print (to stderr). Note: don't trash the string
327 until after calling ffebad_finish, since we just maintain a pointer to
328 the argument passed in until then. */
331 ffebad_string (const char *string
)
333 if (ffebad_is_temp_inhibited_
)
336 assert (ffebad_index_
!= FFEBAD_MAX_
);
337 ffebad_string_
[ffebad_index_
++] = string
;
340 /* ffebad_finish -- Display error message with where & run-time info
344 Call ffebad_start to establish the message, ffebad_here and ffebad_string
345 to send run-time data to it as necessary, then ffebad_finish when through
346 to actually get it to print (to stderr). */
351 #define MAX_SPACES 132
352 static const char *spaces
354 \040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\
355 \040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\
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"; /* MAX_SPACES - 1 spaces. */
363 ffewhereLineNumber last_line_num
;
364 ffewhereLineNumber ln
;
365 ffewhereLineNumber rn
;
366 ffewhereColumnNumber last_col_num
;
367 ffewhereColumnNumber cn
;
368 ffewhereColumnNumber cnt
;
374 unsigned const char *s
;
376 static char buf
[1024];
380 if (ffebad_is_temp_inhibited_
)
383 switch (ffebad_severity_
)
385 case FFEBAD_severityINFORMATIONAL
:
389 case FFEBAD_severityWARNING
:
393 case FFEBAD_severitySEVERE
:
402 /* Display the annoying source references. */
407 for (bi
= 0; bi
< ffebad_places_
; ++bi
)
409 if (ffebad_places_
== 1)
414 l
= ffebad_here_
[ffebad_order_
[bi
]].line
;
415 ln
= ffewhere_line_number (l
);
416 rn
= ffewhere_line_filelinenum (l
);
417 cn
= ffewhere_column_number (ffebad_here_
[ffebad_order_
[bi
]].col
);
418 fn
= ffewhere_line_filename (l
);
419 if (ln
!= last_line_num
)
422 fputc ('\n', stderr
);
423 #if FFECOM_targetCURRENT == FFECOM_targetGCC
424 report_error_function (fn
);
425 #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
428 "Line %" ffewhereLineNumber_f
"u of %s:\n %s\n %s%c",
431 /* the trailing space on the <file>:<line>: line
432 fools emacs19 compilation mode into finding the
434 "%s:%" ffewhereLineNumber_f
"u: %s\n %s\n %s%c",
438 ffewhere_line_content (l
),
439 &spaces
[cn
> MAX_SPACES
? 0 : MAX_SPACES
- cn
+ 4],
447 cnt
= cn
- last_col_num
;
449 "%s%c", &spaces
[cnt
> MAX_SPACES
450 ? 0 : MAX_SPACES
- cnt
+ 4],
455 if (ffebad_places_
== 0)
457 /* Didn't output "warning:" string, capitalize it for message. */
463 fprintf (stderr
, "%c%s ", c
, &s
[1]);
465 else if (s
[0] != '\0')
466 fprintf (stderr
, "%s ", s
);
469 fputc ('\n', stderr
);
471 /* Release the ffewhere info. */
473 for (bi
= 0; bi
< FFEBAD_MAX_
; ++bi
)
475 ffewhere_line_kill (ffebad_here_
[bi
].line
);
476 ffewhere_column_kill (ffebad_here_
[bi
].col
);
479 /* Now display the message. */
482 for (i
= 0; (c
= ffebad_message_
[i
]) != '\0'; ++i
)
486 c
= ffebad_message_
[++i
];
487 if (ISALPHA (c
) && ISUPPER (c
))
491 if ((index
< 0) || (index
>= FFEBAD_MAX_
))
493 bufi
= ffebad_bufputs_ (buf
, bufi
, "[REPORT BUG!!] %");
494 bufi
= ffebad_bufputc_ (buf
, bufi
, c
);
498 s
= ffebad_string_
[index
];
500 bufi
= ffebad_bufputs_ (buf
, bufi
, "[REPORT BUG!!]");
502 bufi
= ffebad_bufputs_ (buf
, bufi
, s
);
505 else if (ISDIGIT (c
))
509 if ((index
< 0) || (index
>= FFEBAD_MAX_
))
511 bufi
= ffebad_bufputs_ (buf
, bufi
, "[REPORT BUG!!] %");
512 bufi
= ffebad_bufputc_ (buf
, bufi
, c
);
516 pointer
= ffebad_here_
[index
].tag
+ '1';
517 if (pointer
== FFEBAD_MAX_
+ '1')
519 else if (ffebad_places_
== 1)
521 bufi
= ffebad_bufputc_ (buf
, bufi
, '(');
522 bufi
= ffebad_bufputc_ (buf
, bufi
, pointer
);
523 bufi
= ffebad_bufputc_ (buf
, bufi
, ')');
529 bufi
= ffebad_bufputc_ (buf
, bufi
, '%');
532 bufi
= ffebad_bufputs_ (buf
, bufi
, "[REPORT BUG!!]");
533 bufi
= ffebad_bufputc_ (buf
, bufi
, '%');
534 bufi
= ffebad_bufputc_ (buf
, bufi
, c
);
538 bufi
= ffebad_bufputc_ (buf
, bufi
, c
);
540 bufi
= ffebad_bufputc_ (buf
, bufi
, '\n');
541 bufi
= ffebad_bufflush_ (buf
, bufi
);