contrib/gcc/f/bad.c

   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
   5 This file is part of GNU Fortran.
   6
   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.
  11
  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.
  16
  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.
  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
  48 bool 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
  62 struct _ffebad_message_
  63   {
  64     ffebadSeverity severity;
  65     const char *message;
  66   };
  67
  68 /* Static objects accessed by functions in this module.  */
  69
  70 static 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
  84 static struct
  85   {
  86     ffewhereLine line;
  87     ffewhereColumn col;
  88     ffebadIndex tag;
  89   }
  90
  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. */
 102
 103 /* Static functions (internal). */
 104
 105 static 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 \f
 116
 117 static int
 118 ffebad_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
 129 void
 130 ffebad_init_0 ()
 131 {
 132   assert (FFEBAD == ARRAY_SIZE (ffebad_messages_));
 133 }
 134
 135 ffebadSeverity
 136 ffebad_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
 162 bool
 163 ffebad_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
 248 void
 249 ffebad_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
 332 void
 333 ffebad_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
 350 void
 351 ffebad_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 }