[COMMITTED] algol68: simplify buffer diagnostics in the front-end
Jose E. Marchesi
jemarch@gnu.org
Tue Jul 1 23:13:11 GMT 2025
This patch simplifies the handling of diagnostics in the front-end by
not buffering them and emitting them as they get issued. It also adds
support for notes (inform) diagnostics and turn a couple of existing
diagnostics to use them.
---
gcc/algol68/a68-diagnostics.cc | 164 +++++++-----------------------
gcc/algol68/a68-lang.cc | 18 +---
gcc/algol68/a68-low.cc | 5 +-
gcc/algol68/a68-parser-scanner.cc | 6 +-
gcc/algol68/a68-parser-taxes.cc | 50 +++++++--
gcc/algol68/a68-parser.cc | 5 +-
gcc/algol68/a68-types.h | 42 --------
gcc/algol68/a68.h | 4 +-
8 files changed, 86 insertions(+), 208 deletions(-)
diff --git a/gcc/algol68/a68-diagnostics.cc b/gcc/algol68/a68-diagnostics.cc
index 3b5d0dae795..f1b0513dc38 100644
--- a/gcc/algol68/a68-diagnostics.cc
+++ b/gcc/algol68/a68-diagnostics.cc
@@ -39,87 +39,18 @@
#define A68_WARNING 1
#define A68_FATAL 2
#define A68_SCAN_ERROR 3
-
-/* Position in line where diagnostic points at. */
-
-char *diag_pos (LINE_T * p, DIAGNOSTIC_T * d)
-{
- char *pos;
- if (WHERE (d) != NO_NODE && p == LINE (INFO (WHERE (d)))) {
- pos = CHAR_IN_LINE (INFO (WHERE (d)));
- } else {
- pos = STRING (p);
- }
- if (pos == NO_TEXT) {
- pos = STRING (p);
- }
- for (; ISSPACE (pos[0]) && pos[0] != '\0'; pos++) {
- ;
- }
- if (pos[0] == '\0') {
- pos = STRING (p);
- }
- return pos;
-}
-
-/* Add diagnostic to source line. */
-
-static void
-add_diagnostic (LINE_T *line, int opt, char *pos, NODE_T *p, int sev, char *b)
-{
- /* Add diagnostic and choose GNU style or non-GNU style. */
- DIAGNOSTIC_T *msg = (DIAGNOSTIC_T *) xmalloc (sizeof (struct DIAGNOSTIC_T));
- DIAGNOSTIC_T **ref_msg;
- BUFFER a, nst;
- int k = 1;
-
- if (line == NO_LINE && p == NO_NODE)
- return;
-
- a[0] = '\0';
- nst[0] = '\0';
-
- if (line == NO_LINE && p != NO_NODE)
- line = LINE (INFO (p));
-
- while (line != NO_LINE && NUMBER (line) == 0)
- FORWARD (line);
- if (line == NO_LINE)
- return;
-
- ref_msg = &(DIAGNOSTICS (line));
- while (*ref_msg != NO_DIAGNOSTIC)
- {
- ref_msg = &(NEXT (*ref_msg));
- k++;
- }
-
- /* Now add the error message proper. */
- if (snprintf (nst, SNPRINTF_SIZE, "%s", b) < 0)
- gcc_unreachable ();
-
- *ref_msg = msg;
- SEVERITY (msg) = sev;
- if (nst[0] != '\0')
- a68_bufcat (a, nst, BUFFER_SIZE);
- TEXT (msg) = a68_new_string (a, NO_TEXT);
- WHERE (msg) = p;
- LINE (msg) = line;
- SYMBOL (msg) = pos;
- NUMBER (msg) = k;
- NEXT (msg) = NO_DIAGNOSTIC;
- OPT (msg) = opt;
-}
+#define A68_INFORM 4
/* Give a diagnostic message. */
-static void
+static int
diagnostic (int sev, int opt,
NODE_T *p,
LINE_T *line,
char *pos,
const char *loc_str, va_list args)
{
+ int res = 0;
MOID_T *moid = NO_MOID;
const char *t = loc_str;
char b[BUFFER_SIZE];
@@ -351,40 +282,30 @@ diagnostic (int sev, int opt,
else
ERROR_COUNT (&A68_JOB)++;
- /* Fatal errors and scanner errors are always delivered immediately. */
- if (sev == A68_FATAL || sev == A68_SCAN_ERROR)
+ /* Emit the corresponding GCC diagnostic at the proper location. */
+ location_t loc = UNKNOWN_LOCATION;
+
+ if (p != NO_NODE)
+ loc = a68_get_node_location (p);
+ else if (line != NO_LINE)
{
- location_t loc;
- if (p != NO_NODE)
- loc = a68_get_node_location (p);
- else if (line != NO_LINE)
- loc = a68_get_line_location (line, pos);
- else
- loc = UNKNOWN_LOCATION;
-
- if (sev == A68_SCAN_ERROR)
- {
- error_at (loc, "%s", b);
- exit (FATAL_EXIT_CODE);
- }
- else
- fatal_error (loc, "%s", b);
+ if (pos == NO_TEXT)
+ pos = STRING (line);
+ loc = a68_get_line_location (line, pos);
}
- if (p == NO_NODE)
+ switch (sev)
{
- if (line == NO_LINE)
- {
- if (sev == A68_ERROR)
- error_at (UNKNOWN_LOCATION, "%s", b);
- else /* A68_WARNING */
- warning_at (UNKNOWN_LOCATION, opt, "%s", b);
- }
- else
- add_diagnostic (line, opt, pos, NO_NODE, sev, b);
+ case A68_SCAN_ERROR: error_at (loc, "%s", b); exit (FATAL_EXIT_CODE);
+ case A68_FATAL: fatal_error (loc, "%s", b); break;
+ case A68_INFORM: inform (loc, b); break;
+ case A68_WARNING: res = warning_at (loc, opt, "%s", b); break;
+ case A68_ERROR: error_at (loc, "%s", b); break;
+ default:
+ gcc_unreachable ();
}
- else
- add_diagnostic (NO_LINE, opt, NO_TEXT, p, sev, b);
+
+ return res;
}
/* Give an intelligible error and exit. A line is provided rather than a
@@ -408,49 +329,32 @@ a68_error (NODE_T *p, const char *loc_str, ...)
va_list args;
va_start (args, loc_str);
- diagnostic (A68_ERROR, 0, p,
- NO_LINE, NO_TEXT, loc_str, args);
- va_end (args);
+ diagnostic (A68_ERROR, 0, p, NO_LINE, NO_TEXT, loc_str, args); va_end (args);
}
/* Report a compilation warning. */
-void
+int
a68_warning (NODE_T *p, int opt,
const char *loc_str, ...)
{
+ int res;
va_list args;
va_start (args, loc_str);
- diagnostic (A68_WARNING, opt,
- p,
- NO_LINE, NO_TEXT, loc_str, args);
+ res = diagnostic (A68_WARNING, opt, p, NO_LINE, NO_TEXT, loc_str, args);
va_end (args);
+ return res;
}
-/* Emit diagnostics. */
+/* Report a compilation note. */
void
-a68_emit_diagnostics (LINE_T *line)
+a68_inform (NODE_T *p, const char *loc_str, ...)
{
- for (; line != NO_LINE; FORWARD (line))
- {
- for (DIAGNOSTIC_T *d = DIAGNOSTICS (line); d != NO_DIAGNOSTIC; FORWARD (d))
- {
- location_t loc;
-
- if (WHERE (d) != NO_NODE && line == LINE (INFO (WHERE (d))))
- loc = a68_get_node_location (WHERE (d));
- else
- loc = a68_get_line_location (line, STRING (line));
-
- if (SEVERITY (d) == A68_WARNING)
- warning_at (loc, OPT (d), "%s", TEXT (d));
- else if (SEVERITY (d) == A68_ERROR)
- error_at (loc, "%s", TEXT (d));
- else
- /* Fatal errors are emitted immediately. */
- gcc_unreachable ();
- }
- }
+ va_list args;
+
+ va_start (args, loc_str);
+ diagnostic (A68_INFORM, 0, p, NO_LINE, NO_TEXT, loc_str, args);
+ va_end (args);
}
diff --git a/gcc/algol68/a68-lang.cc b/gcc/algol68/a68-lang.cc
index a307f0ee77c..28957a615de 100644
--- a/gcc/algol68/a68-lang.cc
+++ b/gcc/algol68/a68-lang.cc
@@ -565,14 +565,8 @@ a68_parse_file (void)
/* Run the Mailloux parser. */
a68_parser (in_fnames[0]);
- if (ERROR_COUNT (&A68_JOB) > 0 || WARNING_COUNT (&A68_JOB) > 0)
- {
- if (ERROR_COUNT (&A68_JOB) > 0)
- {
- a68_emit_diagnostics (TOP_LINE (&A68_JOB));
- goto had_errors;
- }
- }
+ if (ERROR_COUNT (&A68_JOB) > 0)
+ goto had_errors;
/* Generate dumps if so requested. */
if (flag_dump_algol68_modes)
@@ -585,12 +579,8 @@ a68_parse_file (void)
/* Lower the particular program. */
a68_lower_top_tree (TOP_NODE (&A68_JOB));
- if (ERROR_COUNT (&A68_JOB) > 0 || WARNING_COUNT (&A68_JOB) > 0)
- {
- a68_emit_diagnostics (TOP_LINE (&A68_JOB));
- if (ERROR_COUNT (&A68_JOB) > 0)
- goto had_errors;
- }
+ if (ERROR_COUNT (&A68_JOB) > 0)
+ goto had_errors;
/* Process all file scopes in this compilation, and the external_scope,
through wrapup_global_declarations. */
diff --git a/gcc/algol68/a68-low.cc b/gcc/algol68/a68-low.cc
index 047ba7fae36..6be4cc0dd5a 100644
--- a/gcc/algol68/a68-low.cc
+++ b/gcc/algol68/a68-low.cc
@@ -690,8 +690,9 @@ a68_low_assignation (NODE_T *p,
if (SUB (mode_lhs) == M_STRING || IS_FLEX (SUB (mode_lhs)))
{
/* Assigning to a flexible name updates descriptor with new bounds
- and also sets the elements to the dup of the rhs. No bounds check
- is performed. */
+ and also sets the elements to the dup of the rhs. No boundscheck
+ is peformed. XXX but bound checking in contained values may be
+ necessary, ghost elements. */
if (POINTER_TYPE_P (TREE_TYPE (lhs))
&& TREE_TYPE (TREE_TYPE (lhs)) == TREE_TYPE (rhs))
{
diff --git a/gcc/algol68/a68-parser-scanner.cc b/gcc/algol68/a68-parser-scanner.cc
index 88be8250ecf..d3f7a93abe3 100644
--- a/gcc/algol68/a68-parser-scanner.cc
+++ b/gcc/algol68/a68-parser-scanner.cc
@@ -51,7 +51,7 @@ static const char *
upper_postlude[] = {
" END;",
" stop: SKIP",
- "END;",
+ "END",
NO_TEXT
};
@@ -66,7 +66,7 @@ static const char *
supper_postlude[] = {
" end;",
" stop: skip",
- "end;",
+ "end",
NO_TEXT
};
@@ -193,7 +193,6 @@ new_source_line (void)
MARKER (z)[0] = '\0';
STRING (z) = NO_TEXT;
FILENAME (z) = NO_TEXT;
- DIAGNOSTICS (z) = NO_DIAGNOSTIC;
NUMBER (z) = 0;
NEXT (z) = NO_LINE;
PREVIOUS (z) = NO_LINE;
@@ -212,7 +211,6 @@ append_source_line (const char *str, LINE_T **ref_l, int *line_num,
STRING (z) = xstrdup (str);
FILENAME (z) = filename;
NUMBER (z) = (*line_num)++;
- DIAGNOSTICS (z) = NO_DIAGNOSTIC;
NEXT (z) = NO_LINE;
PREVIOUS (z) = *ref_l;
if (TOP_LINE (&A68_JOB) == NO_LINE)
diff --git a/gcc/algol68/a68-parser-taxes.cc b/gcc/algol68/a68-parser-taxes.cc
index a02033f5ae6..9d285ea8012 100644
--- a/gcc/algol68/a68-parser-taxes.cc
+++ b/gcc/algol68/a68-parser-taxes.cc
@@ -608,10 +608,31 @@ test_firmly_related_ops_local (NODE_T *p, TAG_T *s)
NO_TAG /* self */);
if (t != NO_TAG)
{
- a68_warning (p, OPT_Whidden_declarations,
- "M Z hides firmly related M Z with larger reach",
- MOID (s), NSYMBOL (NODE (s)),
- MOID (t), NSYMBOL (NODE (t)));
+ if (TAG_TABLE (t) == A68_STANDENV)
+ {
+ if (a68_warning (p, OPT_Whidden_declarations,
+ "'M Z' hides a firmly related operator in a larger reach",
+ MOID (s), NSYMBOL (NODE (s))))
+ {
+ a68_inform (NO_NODE,
+ "operator 'M Z' defined in the standard prelude",
+ MOID (t), NSYMBOL (NODE (t)));
+ }
+ }
+ else
+ {
+ if (a68_warning (p, OPT_Whidden_declarations,
+ "'M Z' hides a firmly related operator in a larger reach",
+ MOID (s), NSYMBOL (NODE (s))))
+ {
+ a68_inform (NODE (t),
+ "previous hidden declaration of S declared here",
+ NSYMBOL (NODE (s)));
+ }
+ }
+
+ /* Report only one level of hidding or it gets messy. */
+ break;
}
}
}
@@ -678,13 +699,22 @@ already_declared_hidden (NODE_T *n, int a)
if (s != NO_TAG)
{
if (TAG_TABLE (s) == A68_STANDENV)
- a68_warning (n, OPT_Whidden_declarations,
- "declaration hides prelude declaration of M S",
- MOID (s), NSYMBOL (n));
+ {
+ a68_warning (n, OPT_Whidden_declarations,
+ "declaration hides prelude declaration of M S",
+ MOID (s), NSYMBOL (n));
+ }
else
- a68_warning (n, OPT_Whidden_declarations,
- "declaration hides a declaration of S with larger reach",
- NSYMBOL (n));
+ {
+ if (a68_warning (n, OPT_Whidden_declarations,
+ "declaration hides a declaration of S with larger reach",
+ NSYMBOL (n)))
+ {
+ a68_inform (NO_NODE,
+ "previous hidden declaration of S declared here",
+ NSYMBOL (n));
+ }
+ }
}
}
diff --git a/gcc/algol68/a68-parser.cc b/gcc/algol68/a68-parser.cc
index 29aaf2589f4..83e79a8d101 100644
--- a/gcc/algol68/a68-parser.cc
+++ b/gcc/algol68/a68-parser.cc
@@ -449,10 +449,7 @@ a68_parser (const char *filename)
bool ok = a68_lexical_analyser (filename);
if (!ok)
- {
- a68_emit_diagnostics (TOP_LINE (&A68_JOB));
- return;
- }
+ return;
/* An empty file is not a valid program. */
if (TOP_NODE (&A68_JOB) == NO_NODE)
diff --git a/gcc/algol68/a68-types.h b/gcc/algol68/a68-types.h
index 90851380a2f..9878e2ee57c 100644
--- a/gcc/algol68/a68-types.h
+++ b/gcc/algol68/a68-types.h
@@ -51,7 +51,6 @@ typedef struct MODES_T MODES_T;
typedef struct NODE_T NODE_T;
typedef struct MODE_CACHE_T MODE_CACHE_T;
typedef struct MOID_T MOID_T;
-typedef struct DIAGNOSTIC_T DIAGNOSTIC_T;
typedef struct GINFO_T GINFO_T;
typedef struct KEYWORD_T KEYWORD_T;
typedef struct LINE_T LINE_T;
@@ -75,7 +74,6 @@ typedef struct A68_T A68_T;
#define NO_BYTE ((BYTE_T *) 0)
#define NO_CONSTANT ((void *) 0)
#define NO_DEC ((DEC_T *) 0)
-#define NO_DIAGNOSTIC ((DIAGNOSTIC_T *) 0)
#define NO_EDLIN ((EDLIN_T *) 0)
#define NO_FILE ((FILE *) 0)
#define NO_FORMAT ((A68_FORMAT *) 0)
@@ -143,44 +141,6 @@ typedef tree (*LOWERER_T) (struct NODE_T *, struct LOW_CTX_T);
#define NO_LOWERER a68_lower_unimplemented
-/* A DIAGNOSTIC_T represents some diagnostic that will be likely eventually be
- notified somehow to the user.
-
- ATTRIBUTE is the severity of the diagnostic. One of A68_WARNING, A68_ERROR
- or A68_FATAL.
-
- NUMBER is the zero-based ordinal of this diagnostic in its containing line.
- If, for example, this is the third diagnostic issud for the same line, then
- this field will be 2.
-
- OPT is a GCC option code for the compiler option associated with the
- diagnostic, or 0 for no option.
-
- WHERE is either NO_NODE or the parse tree node associated with this
- diagnostic.
-
- LINE is the internal source line associated with this diagnostic. Only set
- when there is no node.
-
- SYMBOL is a string that identifies the position of the diagnostic. Only set
- when there is no node.
-
- TEXT is the message to print when this diagnostic is emitted.
-
- NEXT is the next diagnostic in a chain of diagnostics. */
-
-struct DIAGNOSTIC_T
-{
- int severity;
- int number;
- int opt;
- NODE_T *where;
- LINE_T *line;
- char *symbol;
- char *text;
- DIAGNOSTIC_T *next;
-};
-
struct KEYWORD_T
{
enum a68_attribute attribute;
@@ -544,7 +504,6 @@ struct LINE_T
{
char marker[6], *string;
const char *filename;
- DIAGNOSTIC_T *diagnostics;
int number;
LINE_T *next, *previous;
};
@@ -817,7 +776,6 @@ struct A68_T
#define DEFLEXED(p) ((p)->deflexed_mode)
#define DEREFO(p) ((p).derefo)
#define DERIVATE(p) ((p)->derivate)
-#define DIAGNOSTICS(p) ((p)->diagnostics)
#define DIM(p) ((p)->dim)
#define DYNAMIC_STACK_ALLOCS(p) ((p)->dynamic_stack_allocs)
#define EQUIVALENT(p) ((p)->equivalent_mode)
diff --git a/gcc/algol68/a68.h b/gcc/algol68/a68.h
index 77dab227059..298b4044dfa 100644
--- a/gcc/algol68/a68.h
+++ b/gcc/algol68/a68.h
@@ -237,9 +237,9 @@ MOID_T *a68_type_moid (tree type);
/* a68-diagnostics.cc */
void a68_error (NODE_T *p, const char *loc_str, ...);
-void a68_warning (NODE_T *p, int opt, const char *loc_str, ...);
+int a68_warning (NODE_T *p, int opt, const char *loc_str, ...);
+void a68_inform (NODE_T *p, const char *loc_str, ...);
void a68_fatal (NODE_T *p, const char *loc_str, ...);
-void a68_emit_diagnostics (LINE_T *p);
void a68_scan_error (LINE_T *u, char *v, const char *txt, ...);
/* a68-parser-scanner.cc */
--
2.30.2
More information about the Algol68
mailing list