moids-diagnostics.c

     
   1  //! @file moids-diagnostic.c
   2  //! @author J. Marcel van der Veer
   3  //!
   4  //! @section Copyright
   5  //!
   6  //! This file is part of Algol68G - an Algol 68 compiler-interpreter.
   7  //! Copyright 2001-2023 J. Marcel van der Veer [algol68g@xs4all.nl].
   8  //!
   9  //! @section License
  10  //!
  11  //! This program is free software; you can redistribute it and/or modify it 
  12  //! under the terms of the GNU General Public License as published by the 
  13  //! Free Software Foundation; either version 3 of the License, or 
  14  //! (at your option) any later version.
  15  //!
  16  //! This program is distributed in the hope that it will be useful, but 
  17  //! WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY 
  18  //! or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for 
  19  //! more details. You should have received a copy of the GNU General Public 
  20  //! License along with this program. If not, see [http://www.gnu.org/licenses/].
  21  
  22  //! @section Synopsis
  23  //!
  24  //! MOID diagnostics routines.
  25  
  26  #include "a68g.h"
  27  #include "a68g-parser.h"
  28  #include "a68g-prelude.h"
  29  #include "a68g-moids.h"
  30  
  31  //! @brief Give accurate error message.
  32  
  33  char *mode_error_text (NODE_T * n, MOID_T * p, MOID_T * q, int context, int deflex, int depth)
  34  {
  35  #define TAIL(z) (&(z)[strlen (z)])
  36    static BUFFER txt;
  37    if (depth == 1) {
  38      txt[0] = NULL_CHAR;
  39    }
  40    if (IS (p, SERIES_MODE)) {
  41      PACK_T *u = PACK (p);
  42      int N = 0;
  43      if (u == NO_PACK) {
  44        ASSERT (snprintf (txt, SNPRINTF_SIZE, "empty mode-list") >= 0);
  45        N++;
  46      } else {
  47        for (; u != NO_PACK; FORWARD (u)) {
  48          if (MOID (u) != NO_MOID) {
  49            if (IS (MOID (u), SERIES_MODE)) {
  50              (void) mode_error_text (n, MOID (u), q, context, deflex, depth + 1);
  51            } else if (!is_coercible (MOID (u), q, context, deflex)) {
  52              int len = (int) strlen (txt);
  53              if (len > BUFFER_SIZE / 2) {
  54                ASSERT (snprintf (TAIL (txt), SNPRINTF_SIZE, " etcetera") >= 0);
  55                N++;
  56              } else {
  57                if (strlen (txt) > 0) {
  58                  ASSERT (snprintf (TAIL (txt), SNPRINTF_SIZE, " and ") >= 0);
  59                  N++;
  60                }
  61                ASSERT (snprintf (TAIL (txt), SNPRINTF_SIZE, "%s", moid_to_string (MOID (u), MOID_ERROR_WIDTH, n)) >= 0);
  62                N++;
  63              }
  64            }
  65          }
  66        }
  67      }
  68      if (depth == 1) {
  69        if (N == 0) {
  70          ASSERT (snprintf (TAIL (txt), SNPRINTF_SIZE, "mode") >= 0);
  71        }
  72        ASSERT (snprintf (TAIL (txt), SNPRINTF_SIZE, " cannot be coerced to %s", moid_to_string (q, MOID_ERROR_WIDTH, n)) >= 0);
  73      }
  74    } else if (IS (p, STOWED_MODE) && IS_FLEX (q)) {
  75      PACK_T *u = PACK (p);
  76      if (u == NO_PACK) {
  77        ASSERT (snprintf (txt, SNPRINTF_SIZE, "empty mode-list") >= 0);
  78      } else {
  79        for (; u != NO_PACK; FORWARD (u)) {
  80          if (!is_coercible (MOID (u), SLICE (SUB (q)), context, deflex)) {
  81            int len = (int) strlen (txt);
  82            if (len > BUFFER_SIZE / 2) {
  83              ASSERT (snprintf (TAIL (txt), SNPRINTF_SIZE, " etcetera") >= 0);
  84            } else {
  85              if (strlen (txt) > 0) {
  86                ASSERT (snprintf (TAIL (txt), SNPRINTF_SIZE, " and ") >= 0);
  87              }
  88              ASSERT (snprintf (TAIL (txt), SNPRINTF_SIZE, "%s", moid_to_string (MOID (u), MOID_ERROR_WIDTH, n)) >= 0);
  89            }
  90          }
  91        }
  92        ASSERT (snprintf (TAIL (txt), SNPRINTF_SIZE, " cannot be coerced to %s", moid_to_string (SLICE (SUB (q)), MOID_ERROR_WIDTH, n)) >= 0);
  93      }
  94    } else if (IS (p, STOWED_MODE) && IS (q, ROW_SYMBOL)) {
  95      PACK_T *u = PACK (p);
  96      if (u == NO_PACK) {
  97        ASSERT (snprintf (txt, SNPRINTF_SIZE, "empty mode-list") >= 0);
  98      } else {
  99        for (; u != NO_PACK; FORWARD (u)) {
 100          if (!is_coercible (MOID (u), SLICE (q), context, deflex)) {
 101            int len = (int) strlen (txt);
 102            if (len > BUFFER_SIZE / 2) {
 103              ASSERT (snprintf (TAIL (txt), SNPRINTF_SIZE, " etcetera") >= 0);
 104            } else {
 105              if (strlen (txt) > 0) {
 106                ASSERT (snprintf (TAIL (txt), SNPRINTF_SIZE, " and ") >= 0);
 107              }
 108              ASSERT (snprintf (TAIL (txt), SNPRINTF_SIZE, "%s", moid_to_string (MOID (u), MOID_ERROR_WIDTH, n)) >= 0);
 109            }
 110          }
 111        }
 112        ASSERT (snprintf (TAIL (txt), SNPRINTF_SIZE, " cannot be coerced to %s", moid_to_string (SLICE (q), MOID_ERROR_WIDTH, n)) >= 0);
 113      }
 114    } else if (IS (p, STOWED_MODE) && (IS (q, PROC_SYMBOL) || IS (q, STRUCT_SYMBOL))) {
 115      PACK_T *u = PACK (p), *v = PACK (q);
 116      if (u == NO_PACK) {
 117        ASSERT (snprintf (txt, SNPRINTF_SIZE, "empty mode-list") >= 0);
 118      } else {
 119        for (; u != NO_PACK && v != NO_PACK; FORWARD (u), FORWARD (v)) {
 120          if (!is_coercible (MOID (u), MOID (v), context, deflex)) {
 121            int len = (int) strlen (txt);
 122            if (len > BUFFER_SIZE / 2) {
 123              ASSERT (snprintf (TAIL (txt), SNPRINTF_SIZE, " etcetera") >= 0);
 124            } else {
 125              if (strlen (txt) > 0) {
 126                ASSERT (snprintf (TAIL (txt), SNPRINTF_SIZE, " and ") >= 0);
 127              }
 128              ASSERT (snprintf (TAIL (txt), SNPRINTF_SIZE, "%s cannot be coerced to %s", moid_to_string (MOID (u), MOID_ERROR_WIDTH, n), moid_to_string (MOID (v), MOID_ERROR_WIDTH, n)) >= 0);
 129            }
 130          }
 131        }
 132      }
 133    }
 134    return txt;
 135  #undef TAIL
 136  }
 137  
 138  //! @brief Cannot coerce error.
 139  
 140  void cannot_coerce (NODE_T * p, MOID_T * from, MOID_T * to, int context, int deflex, int att)
 141  {
 142    char *txt = mode_error_text (p, from, to, context, deflex, 1);
 143    if (att == STOP) {
 144      if (strlen (txt) == 0) {
 145        diagnostic (A68_ERROR, p, "M cannot be coerced to M in C context", from, to, context);
 146      } else {
 147        diagnostic (A68_ERROR, p, "Y in C context", txt, context);
 148      }
 149    } else {
 150      if (strlen (txt) == 0) {
 151        diagnostic (A68_ERROR, p, "M cannot be coerced to M in C-A", from, to, context, att);
 152      } else {
 153        diagnostic (A68_ERROR, p, "Y in C-A", txt, context, att);
 154      }
 155    }
 156  }
 157  
 158  //! @brief Give a warning when a value is silently discarded.
 159  
 160  void warn_for_voiding (NODE_T * p, SOID_T * x, SOID_T * y, int c)
 161  {
 162    (void) c;
 163    if (CAST (x) == A68_FALSE) {
 164      if (MOID (x) == M_VOID && MOID (y) != M_ERROR && !(MOID (y) == M_VOID || !is_nonproc (MOID (y)))) {
 165        if (IS (p, FORMULA)) {
 166          diagnostic (A68_WARNING | A68_FORCE_DIAGNOSTICS, p, WARNING_VOIDED, MOID (y));
 167        } else {
 168          diagnostic (A68_WARNING, p, WARNING_VOIDED, MOID (y));
 169        }
 170      }
 171    }
 172  }
 173  
 174  //! @brief Warn for things that are likely unintended.
 175  
 176  void semantic_pitfall (NODE_T * p, MOID_T * m, int c, int u)
 177  {
 178  // semantic_pitfall: warn for things that are likely unintended, for instance
 179  //                   REF INT i := LOC INT := 0, which should probably be
 180  //                   REF INT i = LOC INT := 0.
 181    if (IS (p, u)) {
 182      diagnostic (A68_WARNING, p, WARNING_UNINTENDED, MOID (p), u, m, c);
 183    } else if (is_one_of (p, UNIT, TERTIARY, SECONDARY, PRIMARY, STOP)) {
 184      semantic_pitfall (SUB (p), m, c, u);
 185    }
 186  }
 187