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 extern int inhibit_warnings
; /* From toplev.c. */
189 switch (ffebad_severity_
)
190 { /* Tell toplev.c about this message. */
191 case FFEBAD_severityINFORMATIONAL
:
192 case FFEBAD_severityTRIVIAL
:
193 if (inhibit_warnings
)
194 { /* User wants no warnings. */
195 ffebad_is_temp_inhibited_
= TRUE
;
199 case FFEBAD_severityWARNING
:
200 case FFEBAD_severityPECULIAR
:
201 case FFEBAD_severityPEDANTIC
:
202 if ((ffebad_severity_
!= FFEBAD_severityPEDANTIC
)
203 || !flag_pedantic_errors
)
205 if (count_error (1) == 0)
206 { /* User wants no warnings. */
207 ffebad_is_temp_inhibited_
= TRUE
;
212 /* Fall through (PEDANTIC && flag_pedantic_errors). */
213 case FFEBAD_severityFATAL
:
214 case FFEBAD_severityWEIRD
:
215 case FFEBAD_severitySEVERE
:
216 case FFEBAD_severityDISASTER
:
224 #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
226 ffebad_is_temp_inhibited_
= FALSE
;
227 ffebad_errnum_
= errnum
;
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 ();
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). */
249 ffebad_here (ffebadIndex index
, ffewhereLine line
, ffewhereColumn col
)
251 ffewhereLineNumber line_num
;
252 ffewhereLineNumber ln
;
253 ffewhereColumnNumber col_num
;
254 ffewhereColumnNumber cn
;
258 if (ffebad_is_temp_inhibited_
)
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_
;
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
);
290 ffebad_here_
[index
].tag
= i
;
291 return; /* Shouldn't go in, has equivalent. */
293 else if (col_num
< cn
)
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
;
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. */
333 ffebad_string (const char *string
)
335 if (ffebad_is_temp_inhibited_
)
338 assert (ffebad_index_
!= FFEBAD_MAX_
);
339 ffebad_string_
[ffebad_index_
++] = string
;
342 /* ffebad_finish -- Display error message with where & run-time info
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). */
353 #define MAX_SPACES 132
354 static const char *spaces
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
;
376 unsigned const char *s
;
378 static char buf
[1024];
382 if (ffebad_is_temp_inhibited_
)
385 switch (ffebad_severity_
)
387 case FFEBAD_severityINFORMATIONAL
:
391 case FFEBAD_severityWARNING
:
395 case FFEBAD_severitySEVERE
:
404 /* Display the annoying source references. */
409 for (bi
= 0; bi
< ffebad_places_
; ++bi
)
411 if (ffebad_places_
== 1)
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
)
424 fputc ('\n', stderr
);
425 #if FFECOM_targetCURRENT == FFECOM_targetGCC
426 report_error_function (fn
);
427 #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
430 "Line %" ffewhereLineNumber_f
"u of %s:\n %s\n %s%c",
433 /* the trailing space on the <file>:<line>: line
434 fools emacs19 compilation mode into finding the
436 "%s:%" ffewhereLineNumber_f
"u: %s\n %s\n %s%c",
440 ffewhere_line_content (l
),
441 &spaces
[cn
> MAX_SPACES
? 0 : MAX_SPACES
- cn
+ 4],
449 cnt
= cn
- last_col_num
;
451 "%s%c", &spaces
[cnt
> MAX_SPACES
452 ? 0 : MAX_SPACES
- cnt
+ 4],
457 if (ffebad_places_
== 0)
459 /* Didn't output "warning:" string, capitalize it for message. */
460 if ((s
[0] != '\0') && ISALPHA (s
[0]) && ISLOWER (s
[0]))
465 fprintf (stderr
, "%c%s ", c
, &s
[1]);
467 else if (s
[0] != '\0')
468 fprintf (stderr
, "%s ", s
);
471 fputc ('\n', stderr
);
473 /* Release the ffewhere info. */
475 for (bi
= 0; bi
< FFEBAD_MAX_
; ++bi
)
477 ffewhere_line_kill (ffebad_here_
[bi
].line
);
478 ffewhere_column_kill (ffebad_here_
[bi
].col
);
481 /* Now display the message. */
484 for (i
= 0; (c
= ffebad_message_
[i
]) != '\0'; ++i
)
488 c
= ffebad_message_
[++i
];
489 if (ISALPHA (c
) && ISUPPER (c
))
493 if ((index
< 0) || (index
>= FFEBAD_MAX_
))
495 bufi
= ffebad_bufputs_ (buf
, bufi
, "[REPORT BUG!!] %");
496 bufi
= ffebad_bufputc_ (buf
, bufi
, c
);
500 s
= ffebad_string_
[index
];
502 bufi
= ffebad_bufputs_ (buf
, bufi
, "[REPORT BUG!!]");
504 bufi
= ffebad_bufputs_ (buf
, bufi
, s
);
507 else if (ISDIGIT (c
))
511 if ((index
< 0) || (index
>= FFEBAD_MAX_
))
513 bufi
= ffebad_bufputs_ (buf
, bufi
, "[REPORT BUG!!] %");
514 bufi
= ffebad_bufputc_ (buf
, bufi
, c
);
518 pointer
= ffebad_here_
[index
].tag
+ '1';
519 if (pointer
== FFEBAD_MAX_
+ '1')
521 else if (ffebad_places_
== 1)
523 bufi
= ffebad_bufputc_ (buf
, bufi
, '(');
524 bufi
= ffebad_bufputc_ (buf
, bufi
, pointer
);
525 bufi
= ffebad_bufputc_ (buf
, bufi
, ')');
531 bufi
= ffebad_bufputc_ (buf
, bufi
, '%');
534 bufi
= ffebad_bufputs_ (buf
, bufi
, "[REPORT BUG!!]");
535 bufi
= ffebad_bufputc_ (buf
, bufi
, '%');
536 bufi
= ffebad_bufputc_ (buf
, bufi
, c
);
540 bufi
= ffebad_bufputc_ (buf
, bufi
, c
);
542 bufi
= ffebad_bufputc_ (buf
, bufi
, '\n');
543 bufi
= ffebad_bufflush_ (buf
, bufi
);