1/* bad.c -- Implementation File (module.c template V1.0)
2   Copyright (C) 1995 Free Software Foundation, Inc.
3   Contributed by James Craig Burley.
4
5This file is part of GNU Fortran.
6
7GNU Fortran is free software; you can redistribute it and/or modify
8it under the terms of the GNU General Public License as published by
9the Free Software Foundation; either version 2, or (at your option)
10any later version.
11
12GNU Fortran is distributed in the hope that it will be useful,
13but WITHOUT ANY WARRANTY; without even the implied warranty of
14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15GNU General Public License for more details.
16
17You should have received a copy of the GNU General Public License
18along with GNU Fortran; see the file COPYING.  If not, write to
19the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
2002111-1307, USA.
21
22   Related Modules:
23      None
24
25   Description:
26      Handles the displaying of diagnostic messages regarding the user's source
27      files.
28
29   Modifications:
30*/
31
32/* If there's a %E or %4 in the messages, set this to at least 5,
33   for example.  */
34
35#define FFEBAD_MAX_ 6
36
37/* Include files. */
38
39#include "proj.h"
40#include "bad.h"
41#include "flags.j"
42#include "com.h"
43#include "toplev.j"
44#include "where.h"
45
46/* Externals defined here. */
47
48bool ffebad_is_inhibited_ = FALSE;
49
50/* Simple definitions and enumerations. */
51
52#define FFEBAD_LONG_MSGS_ 1	/* 0 to use short (or same) messages. */
53
54/* Internal typedefs. */
55
56
57/* Private include files. */
58
59
60/* Internal structure definitions. */
61
62struct _ffebad_message_
63  {
64    ffebadSeverity severity;
65    const char *message;
66  };
67
68/* Static objects accessed by functions in this module.	 */
69
70static struct _ffebad_message_ ffebad_messages_[]
71=
72{
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 },
76#else
77#define FFEBAD_MSGS2(KWD,SEV,LMSG,SMSG) { SEV, LMSG },
78#endif
79#include "bad.def"
80#undef FFEBAD_MSGS1
81#undef FFEBAD_MSGS2
82};
83
84static struct
85  {
86    ffewhereLine line;
87    ffewhereColumn col;
88    ffebadIndex tag;
89  }
90
91ffebad_here_[FFEBAD_MAX_];
92static const char *ffebad_string_[FFEBAD_MAX_];
93static ffebadIndex ffebad_order_[FFEBAD_MAX_];
94static ffebad ffebad_errnum_;
95static ffebadSeverity ffebad_severity_;
96static const char *ffebad_message_;
97static unsigned char ffebad_index_;
98static ffebadIndex ffebad_places_;
99static bool ffebad_is_temp_inhibited_;	/* Effective setting of
100					   _is_inhibited_ for this
101					   _start/_finish invocation. */
102
103/* Static functions (internal). */
104
105static int ffebad_bufputs_ (char buf[], int bufi, const char *s);
106
107/* Internal macros. */
108
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))
115
116
117static int
118ffebad_bufputs_ (char buf[], int bufi, const char *s)
119{
120  for (; *s != '\0'; ++s)
121    bufi = ffebad_bufputc_ (buf, bufi, *s);
122  return bufi;
123}
124
125/* ffebad_init_0 -- Initialize
126
127   ffebad_init_0();  */
128
129void
130ffebad_init_0 ()
131{
132  assert (FFEBAD == ARRAY_SIZE (ffebad_messages_));
133}
134
135ffebadSeverity
136ffebad_severity (ffebad errnum)
137{
138  return ffebad_messages_[errnum].severity;
139}
140
141/* ffebad_start_ -- Start displaying an error message
142
143   ffebad_start(FFEBAD_SOME_ERROR_CODE);
144
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).
148
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).
152
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).
157
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.  */
161
162bool
163ffebad_start_ (bool lex_override, ffebad errnum, ffebadSeverity sev,
164	       const char *message)
165{
166  unsigned char i;
167
168  if (ffebad_is_inhibited_ && !lex_override)
169    {
170      ffebad_is_temp_inhibited_ = TRUE;
171      return FALSE;
172    }
173
174  if (errnum != FFEBAD)
175    {
176      ffebad_severity_ = ffebad_messages_[errnum].severity;
177      ffebad_message_ = ffebad_messages_[errnum].message;
178    }
179  else
180    {
181      ffebad_severity_ = sev;
182      ffebad_message_ = message;
183    }
184
185#if FFECOM_targetCURRENT == FFECOM_targetGCC
186  {
187    extern int inhibit_warnings;	/* From toplev.c. */
188
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;
196	    return FALSE;
197	  }
198	/* Fall through.  */
199      case FFEBAD_severityWARNING:
200      case FFEBAD_severityPECULIAR:
201      case FFEBAD_severityPEDANTIC:
202	if ((ffebad_severity_ != FFEBAD_severityPEDANTIC)
203	    || !flag_pedantic_errors)
204	  {
205	    if (count_error (1) == 0)
206	      {			/* User wants no warnings. */
207		ffebad_is_temp_inhibited_ = TRUE;
208		return FALSE;
209	      }
210	    break;
211	  }
212	/* Fall through (PEDANTIC && flag_pedantic_errors).  */
213      case FFEBAD_severityFATAL:
214      case FFEBAD_severityWEIRD:
215      case FFEBAD_severitySEVERE:
216      case FFEBAD_severityDISASTER:
217	count_error (0);
218	break;
219
220      default:
221	break;
222      }
223  }
224#endif	/* FFECOM_targetCURRENT == FFECOM_targetGCC */
225
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)
231    {
232      ffebad_string_[i] = NULL;
233      ffebad_here_[i].line = ffewhere_line_unknown ();
234      ffebad_here_[i].col = ffewhere_column_unknown ();
235    }
236
237  return TRUE;
238}
239
240/* ffebad_here -- Establish source location of some diagnostic concern
241
242   ffebad_here(ffebadIndex i,ffewhereLine line,ffewhereColumn col);
243
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).  */
247
248void
249ffebad_here (ffebadIndex index, ffewhereLine line, ffewhereColumn col)
250{
251  ffewhereLineNumber line_num;
252  ffewhereLineNumber ln;
253  ffewhereColumnNumber col_num;
254  ffewhereColumnNumber cn;
255  ffebadIndex i;
256  ffebadIndex j;
257
258  if (ffebad_is_temp_inhibited_)
259    return;
260
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))
266    {
267      ffebad_here_[index].tag = FFEBAD_MAX_;
268      return;
269    }
270  ffebad_here_[index].tag = 0;	/* For now, though it shouldn't matter. */
271
272  /* Sort the source line/col points into the order they occur in the source
273     file.  Deal with duplicates appropriately. */
274
275  line_num = ffewhere_line_number (line);
276  col_num = ffewhere_column_number (col);
277
278  /* Determine where in the ffebad_order_ array this new place should go. */
279
280  for (i = 0; i < ffebad_places_; ++i)
281    {
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)
287	{
288	  if (col_num == cn)
289	    {
290	      ffebad_here_[index].tag = i;
291	      return;		/* Shouldn't go in, has equivalent. */
292	    }
293	  else if (col_num < cn)
294	    break;
295	}
296    }
297
298  /* Before putting new place in ffebad_order_[i], first increment all tags
299     that are i or greater. */
300
301  if (i != ffebad_places_)
302    {
303      for (j = 0; j < FFEBAD_MAX_; ++j)
304	{
305	  if (ffebad_here_[j].tag >= i)
306	    ++ffebad_here_[j].tag;
307	}
308    }
309
310  /* Then slide all ffebad_order_[] entries at and above i up one entry. */
311
312  for (j = ffebad_places_; j > i; --j)
313    ffebad_order_[j] = ffebad_order_[j - 1];
314
315  /* Finally can put new info in ffebad_order_[i]. */
316
317  ffebad_order_[i] = index;
318  ffebad_here_[index].tag = i;
319  ++ffebad_places_;
320}
321
322/* Establish string for next index (always in order) of message
323
324   ffebad_string(const char *string);
325
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.  */
331
332void
333ffebad_string (const char *string)
334{
335  if (ffebad_is_temp_inhibited_)
336    return;
337
338  assert (ffebad_index_ != FFEBAD_MAX_);
339  ffebad_string_[ffebad_index_++] = string;
340}
341
342/* ffebad_finish -- Display error message with where & run-time info
343
344   ffebad_finish();
345
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).  */
349
350void
351ffebad_finish ()
352{
353#define MAX_SPACES 132
354  static const char *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;
381
382  if (ffebad_is_temp_inhibited_)
383    return;
384
385  switch (ffebad_severity_)
386    {
387    case FFEBAD_severityINFORMATIONAL:
388      s = "note:";
389      break;
390
391    case FFEBAD_severityWARNING:
392      s = "warning:";
393      break;
394
395    case FFEBAD_severitySEVERE:
396      s = "fatal:";
397      break;
398
399    default:
400      s = "";
401      break;
402    }
403
404  /* Display the annoying source references. */
405
406  last_line_num = 0;
407  last_col_num = 0;
408
409  for (bi = 0; bi < ffebad_places_; ++bi)
410    {
411      if (ffebad_places_ == 1)
412	pointer = '^';
413      else
414	pointer = '1' + bi;
415
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)
422	{
423	  if (bi != 0)
424	    fputc ('\n', stderr);
425#if FFECOM_targetCURRENT == FFECOM_targetGCC
426	  report_error_function (fn);
427#endif	/* FFECOM_targetCURRENT == FFECOM_targetGCC */
428	  fprintf (stderr,
429#if 0
430		   "Line %" ffewhereLineNumber_f "u of %s:\n   %s\n   %s%c",
431		   rn, fn,
432#else
433		   /* the trailing space on the <file>:<line>: line
434		      fools emacs19 compilation mode into finding the
435		      report */
436		   "%s:%" ffewhereLineNumber_f "u: %s\n   %s\n   %s%c",
437		   fn, rn,
438#endif
439		   s,
440		   ffewhere_line_content (l),
441		   &spaces[cn > MAX_SPACES ? 0 : MAX_SPACES - cn + 4],
442		   pointer);
443	  last_line_num = ln;
444	  last_col_num = cn;
445	  s = "(continued):";
446	}
447      else
448	{
449	  cnt = cn - last_col_num;
450	  fprintf (stderr,
451		   "%s%c", &spaces[cnt > MAX_SPACES
452				   ? 0 : MAX_SPACES - cnt + 4],
453		   pointer);
454	  last_col_num = cn;
455	}
456    }
457  if (ffebad_places_ == 0)
458    {
459      /* Didn't output "warning:" string, capitalize it for message.  */
460      if ((s[0] != '\0') && ISALPHA (s[0]) && ISLOWER (s[0]))
461	{
462	  char c;
463
464	  c = toupper (s[0]);
465	  fprintf (stderr, "%c%s ", c, &s[1]);
466	}
467      else if (s[0] != '\0')
468	fprintf (stderr, "%s ", s);
469    }
470  else
471    fputc ('\n', stderr);
472
473  /* Release the ffewhere info. */
474
475  for (bi = 0; bi < FFEBAD_MAX_; ++bi)
476    {
477      ffewhere_line_kill (ffebad_here_[bi].line);
478      ffewhere_column_kill (ffebad_here_[bi].col);
479    }
480
481  /* Now display the message. */
482
483  bufi = 0;
484  for (i = 0; (c = ffebad_message_[i]) != '\0'; ++i)
485    {
486      if (c == '%')
487	{
488	  c = ffebad_message_[++i];
489	  if (ISALPHA (c) && ISUPPER (c))
490	    {
491	      index = c - 'A';
492
493	      if ((index < 0) || (index >= FFEBAD_MAX_))
494		{
495		  bufi = ffebad_bufputs_ (buf, bufi, "[REPORT BUG!!] %");
496		  bufi = ffebad_bufputc_ (buf, bufi, c);
497		}
498	      else
499		{
500		  s = ffebad_string_[index];
501		  if (s == NULL)
502		    bufi = ffebad_bufputs_ (buf, bufi, "[REPORT BUG!!]");
503		  else
504		    bufi = ffebad_bufputs_ (buf, bufi, s);
505		}
506	    }
507	  else if (ISDIGIT (c))
508	    {
509	      index = c - '0';
510
511	      if ((index < 0) || (index >= FFEBAD_MAX_))
512		{
513		  bufi = ffebad_bufputs_ (buf, bufi, "[REPORT BUG!!] %");
514		  bufi = ffebad_bufputc_ (buf, bufi, c);
515		}
516	      else
517		{
518		  pointer = ffebad_here_[index].tag + '1';
519		  if (pointer == FFEBAD_MAX_ + '1')
520		    pointer = '?';
521		  else if (ffebad_places_ == 1)
522		    pointer = '^';
523		  bufi = ffebad_bufputc_ (buf, bufi, '(');
524		  bufi = ffebad_bufputc_ (buf, bufi, pointer);
525		  bufi = ffebad_bufputc_ (buf, bufi, ')');
526		}
527	    }
528	  else if (c == '\0')
529	    break;
530	  else if (c == '%')
531	    bufi = ffebad_bufputc_ (buf, bufi, '%');
532	  else
533	    {
534	      bufi = ffebad_bufputs_ (buf, bufi, "[REPORT BUG!!]");
535	      bufi = ffebad_bufputc_ (buf, bufi, '%');
536	      bufi = ffebad_bufputc_ (buf, bufi, c);
537	    }
538	}
539      else
540	bufi = ffebad_bufputc_ (buf, bufi, c);
541    }
542  bufi = ffebad_bufputc_ (buf, bufi, '\n');
543  bufi = ffebad_bufflush_ (buf, bufi);
544}
545