Commit 19d987e2 by Craig Burley Committed by Craig Burley

improve global/filewide semantic checking

From-SVN: r25319
parent fad22e3b
1999-02-19 Craig Burley <craig@jcb-sc.com>
* global.c (ffeglobal_ref_progunit_): Warn about a function
definition that disagrees with the type of a previous reference.
Improve commentary. Fix a couple of minor bugs. Clean up
some code.
* news.texi: Spread the joy.
1999-02-18 Craig Burley <craig@jcb-sc.com> 1999-02-18 Craig Burley <craig@jcb-sc.com>
* expr.c (ffeexpr_finished_): Disallow non-default INTEGER * expr.c (ffeexpr_finished_): Disallow non-default INTEGER
......
...@@ -181,6 +181,7 @@ ffeglobal_init_common (ffesymbol s, ffelexToken t) ...@@ -181,6 +181,7 @@ ffeglobal_init_common (ffesymbol s, ffelexToken t)
{ {
if (g->u.common.blank) if (g->u.common.blank)
{ {
/* Not supposed to initialize blank common, though it works. */
ffebad_start (FFEBAD_COMMON_BLANK_INIT); ffebad_start (FFEBAD_COMMON_BLANK_INIT);
ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t)); ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
ffebad_finish (); ffebad_finish ();
...@@ -229,10 +230,13 @@ ffeglobal_new_common (ffesymbol s, ffelexToken t, bool blank) ...@@ -229,10 +230,13 @@ ffeglobal_new_common (ffesymbol s, ffelexToken t, bool blank)
{ {
if (g->type == FFEGLOBAL_typeCOMMON) if (g->type == FFEGLOBAL_typeCOMMON)
{ {
/* The names match, so the "blankness" should match too! */
assert (g->u.common.blank == blank); assert (g->u.common.blank == blank);
} }
else else
{ {
/* This global name has already been established,
but as something other than a common block. */
if (ffe_is_globals () || ffe_is_warn_globals ()) if (ffe_is_globals () || ffe_is_warn_globals ())
{ {
ffebad_start (ffe_is_globals () ffebad_start (ffe_is_globals ()
...@@ -258,6 +262,10 @@ ffeglobal_new_common (ffesymbol s, ffelexToken t, bool blank) ...@@ -258,6 +262,10 @@ ffeglobal_new_common (ffesymbol s, ffelexToken t, bool blank)
&& !g->explicit_intrinsic && !g->explicit_intrinsic
&& ffe_is_warn_globals ()) && ffe_is_warn_globals ())
{ {
/* Common name previously used as intrinsic. Though it works,
warn, because the intrinsic reference might have been intended
as a ref to an external procedure, but g77's vast list of
intrinsics happened to snarf the name. */
ffebad_start (FFEBAD_INTRINSIC_GLOBAL); ffebad_start (FFEBAD_INTRINSIC_GLOBAL);
ffebad_string (ffelex_token_text (t)); ffebad_string (ffelex_token_text (t));
ffebad_string ("common block"); ffebad_string ("common block");
...@@ -308,6 +316,7 @@ ffeglobal_new_progunit_ (ffesymbol s, ffelexToken t, ffeglobalType type) ...@@ -308,6 +316,7 @@ ffeglobal_new_progunit_ (ffesymbol s, ffelexToken t, ffeglobalType type)
|| (g->type == FFEGLOBAL_typeBDATA)) || (g->type == FFEGLOBAL_typeBDATA))
&& g->u.proc.defined) && g->u.proc.defined)
{ {
/* This program unit has already been defined. */
if (ffe_is_globals () || ffe_is_warn_globals ()) if (ffe_is_globals () || ffe_is_warn_globals ())
{ {
ffebad_start (ffe_is_globals () ffebad_start (ffe_is_globals ()
...@@ -327,6 +336,13 @@ ffeglobal_new_progunit_ (ffesymbol s, ffelexToken t, ffeglobalType type) ...@@ -327,6 +336,13 @@ ffeglobal_new_progunit_ (ffesymbol s, ffelexToken t, ffeglobalType type)
&& (g->type != FFEGLOBAL_typeEXT) && (g->type != FFEGLOBAL_typeEXT)
&& (g->type != type)) && (g->type != type))
{ {
/* A reference to this program unit has been seen, but its
context disagrees about the new definition regarding
what kind of program unit it is. (E.g. `call foo' followed
by `function foo'.) But `external foo' alone doesn't mean
disagreement with either a function or subroutine, though
g77 normally interprets it as a request to force-load
a block data program unit by that name (to cope with libs). */
if (ffe_is_globals () || ffe_is_warn_globals ()) if (ffe_is_globals () || ffe_is_warn_globals ())
{ {
ffebad_start (ffe_is_globals () ffebad_start (ffe_is_globals ()
...@@ -353,11 +369,16 @@ ffeglobal_new_progunit_ (ffesymbol s, ffelexToken t, ffeglobalType type) ...@@ -353,11 +369,16 @@ ffeglobal_new_progunit_ (ffesymbol s, ffelexToken t, ffeglobalType type)
g->u.proc.other_t = NULL; g->u.proc.other_t = NULL;
} }
else if ((ffesymbol_basictype (s) != FFEINFO_basictypeNONE) else if ((ffesymbol_basictype (s) != FFEINFO_basictypeNONE)
&& (g->type == FFEGLOBAL_typeFUNC)
&& ((ffesymbol_basictype (s) != g->u.proc.bt) && ((ffesymbol_basictype (s) != g->u.proc.bt)
|| (ffesymbol_kindtype (s) != g->u.proc.kt) || (ffesymbol_kindtype (s) != g->u.proc.kt)
|| ((ffesymbol_size (s) != FFETARGET_charactersizeNONE) || ((ffesymbol_size (s) != FFETARGET_charactersizeNONE)
&& (ffesymbol_size (s) != g->u.proc.sz)))) && (ffesymbol_size (s) != g->u.proc.sz))))
{ {
/* The previous reference and this new function definition
disagree about the type of the function. I (Burley) think
this rarely occurs, because when this code is reached,
the type info doesn't appear to be filled in yet. */
if (ffe_is_globals () || ffe_is_warn_globals ()) if (ffe_is_globals () || ffe_is_warn_globals ())
{ {
ffebad_start (ffe_is_globals () ffebad_start (ffe_is_globals ()
...@@ -377,6 +398,10 @@ ffeglobal_new_progunit_ (ffesymbol s, ffelexToken t, ffeglobalType type) ...@@ -377,6 +398,10 @@ ffeglobal_new_progunit_ (ffesymbol s, ffelexToken t, ffeglobalType type)
&& !g->explicit_intrinsic && !g->explicit_intrinsic
&& ffe_is_warn_globals ()) && ffe_is_warn_globals ())
{ {
/* This name, previously used as an intrinsic, now is known
to also be a global procedure name. Warn, since the previous
use as an intrinsic might have been intended to refer to
this procedure. */
ffebad_start (FFEBAD_INTRINSIC_GLOBAL); ffebad_start (FFEBAD_INTRINSIC_GLOBAL);
ffebad_string (ffelex_token_text (t)); ffebad_string (ffelex_token_text (t));
ffebad_string ("global"); ffebad_string ("global");
...@@ -395,10 +420,12 @@ ffeglobal_new_progunit_ (ffesymbol s, ffelexToken t, ffeglobalType type) ...@@ -395,10 +420,12 @@ ffeglobal_new_progunit_ (ffesymbol s, ffelexToken t, ffeglobalType type)
g->u.proc.kt = ffesymbol_kindtype (s); g->u.proc.kt = ffesymbol_kindtype (s);
g->u.proc.sz = ffesymbol_size (s); g->u.proc.sz = ffesymbol_size (s);
} }
g->tick = ffe_count_2; /* If there's a known disagreement about the kind of program
unit, then don't even bother tracking arglist argreement. */
if ((g->tick != 0) if ((g->tick != 0)
&& (g->type != type)) && (g->type != type))
g->u.proc.n_args = -1; g->u.proc.n_args = -1;
g->tick = ffe_count_2;
g->type = type; g->type = type;
g->u.proc.defined = TRUE; g->u.proc.defined = TRUE;
} }
...@@ -1160,6 +1187,10 @@ ffeglobal_ref_intrinsic (ffesymbol s, ffelexToken t, bool explicit) ...@@ -1160,6 +1187,10 @@ ffeglobal_ref_intrinsic (ffesymbol s, ffelexToken t, bool explicit)
&& ! g->intrinsic && ! g->intrinsic
&& ffe_is_warn_globals ()) && ffe_is_warn_globals ())
{ {
/* This name, previously used as a global, now is used
for an intrinsic. Warn, since this new use as an
intrinsic might have been intended to refer to
the global procedure. */
ffebad_start (FFEBAD_INTRINSIC_GLOBAL); ffebad_start (FFEBAD_INTRINSIC_GLOBAL);
ffebad_string (ffelex_token_text (t)); ffebad_string (ffelex_token_text (t));
ffebad_string ("intrinsic"); ffebad_string ("intrinsic");
...@@ -1186,6 +1217,11 @@ ffeglobal_ref_intrinsic (ffesymbol s, ffelexToken t, bool explicit) ...@@ -1186,6 +1217,11 @@ ffeglobal_ref_intrinsic (ffesymbol s, ffelexToken t, bool explicit)
&& (g->tick != ffe_count_2) && (g->tick != ffe_count_2)
&& ffe_is_warn_globals ()) && ffe_is_warn_globals ())
{ {
/* An earlier reference to this intrinsic disagrees with
this reference vis-a-vis explicit `intrinsic foo',
which suggests that the one relying on implicit
intrinsicacity might have actually intended to refer
to a global of the same name. */
ffebad_start (FFEBAD_INTRINSIC_EXPIMP); ffebad_start (FFEBAD_INTRINSIC_EXPIMP);
ffebad_string (ffelex_token_text (t)); ffebad_string (ffelex_token_text (t));
ffebad_string (explicit ? "explicit" : "implicit"); ffebad_string (explicit ? "explicit" : "implicit");
...@@ -1235,10 +1271,13 @@ ffeglobal_ref_progunit_ (ffesymbol s, ffelexToken t, ffeglobalType type) ...@@ -1235,10 +1271,13 @@ ffeglobal_ref_progunit_ (ffesymbol s, ffelexToken t, ffeglobalType type)
if ((g != NULL) if ((g != NULL)
&& (g->type != FFEGLOBAL_typeNONE) && (g->type != FFEGLOBAL_typeNONE)
&& (g->type != type)
&& (g->type != FFEGLOBAL_typeEXT) && (g->type != FFEGLOBAL_typeEXT)
&& (g->type != type)
&& (type != FFEGLOBAL_typeEXT)) && (type != FFEGLOBAL_typeEXT))
{ {
/* Disagreement about (fully refined) class of program unit
(main, subroutine, function, block data). Treat EXTERNAL/
COMMON disagreements distinctly. */
if ((((type == FFEGLOBAL_typeBDATA) if ((((type == FFEGLOBAL_typeBDATA)
&& (g->type != FFEGLOBAL_typeCOMMON)) && (g->type != FFEGLOBAL_typeCOMMON))
|| ((g->type == FFEGLOBAL_typeBDATA) || ((g->type == FFEGLOBAL_typeBDATA)
...@@ -1248,6 +1287,7 @@ ffeglobal_ref_progunit_ (ffesymbol s, ffelexToken t, ffeglobalType type) ...@@ -1248,6 +1287,7 @@ ffeglobal_ref_progunit_ (ffesymbol s, ffelexToken t, ffeglobalType type)
#if 0 /* This is likely to just annoy people. */ #if 0 /* This is likely to just annoy people. */
if (ffe_is_warn_globals ()) if (ffe_is_warn_globals ())
{ {
/* Warn about EXTERNAL of a COMMON name, though it works. */
ffebad_start (FFEBAD_FILEWIDE_TIFF); ffebad_start (FFEBAD_FILEWIDE_TIFF);
ffebad_string (ffelex_token_text (t)); ffebad_string (ffelex_token_text (t));
ffebad_string (ffeglobal_type_string_[type]); ffebad_string (ffeglobal_type_string_[type]);
...@@ -1260,23 +1300,11 @@ ffeglobal_ref_progunit_ (ffesymbol s, ffelexToken t, ffeglobalType type) ...@@ -1260,23 +1300,11 @@ ffeglobal_ref_progunit_ (ffesymbol s, ffelexToken t, ffeglobalType type)
} }
#endif #endif
} }
else if (ffe_is_globals ()) else if (ffe_is_globals () || ffe_is_warn_globals ())
{ {
ffebad_start (FFEBAD_FILEWIDE_DISAGREEMENT); ffebad_start (ffe_is_globals ()
ffebad_string (ffelex_token_text (t)); ? FFEBAD_FILEWIDE_DISAGREEMENT
ffebad_string (ffeglobal_type_string_[type]); : FFEBAD_FILEWIDE_DISAGREEMENT_W);
ffebad_string (ffeglobal_type_string_[g->type]);
ffebad_here (0, ffelex_token_where_line (t),
ffelex_token_where_column (t));
ffebad_here (1, ffelex_token_where_line (g->t),
ffelex_token_where_column (g->t));
ffebad_finish ();
g->type = FFEGLOBAL_typeANY;
return FALSE;
}
else if (ffe_is_warn_globals ())
{
ffebad_start (FFEBAD_FILEWIDE_DISAGREEMENT_W);
ffebad_string (ffelex_token_text (t)); ffebad_string (ffelex_token_text (t));
ffebad_string (ffeglobal_type_string_[type]); ffebad_string (ffeglobal_type_string_[type]);
ffebad_string (ffeglobal_type_string_[g->type]); ffebad_string (ffeglobal_type_string_[g->type]);
...@@ -1286,7 +1314,7 @@ ffeglobal_ref_progunit_ (ffesymbol s, ffelexToken t, ffeglobalType type) ...@@ -1286,7 +1314,7 @@ ffeglobal_ref_progunit_ (ffesymbol s, ffelexToken t, ffeglobalType type)
ffelex_token_where_column (g->t)); ffelex_token_where_column (g->t));
ffebad_finish (); ffebad_finish ();
g->type = FFEGLOBAL_typeANY; g->type = FFEGLOBAL_typeANY;
return TRUE; return (! ffe_is_globals ());
} }
} }
...@@ -1302,39 +1330,65 @@ ffeglobal_ref_progunit_ (ffesymbol s, ffelexToken t, ffeglobalType type) ...@@ -1302,39 +1330,65 @@ ffeglobal_ref_progunit_ (ffesymbol s, ffelexToken t, ffeglobalType type)
g->u.proc.kt = ffesymbol_kindtype (s); g->u.proc.kt = ffesymbol_kindtype (s);
g->u.proc.sz = ffesymbol_size (s); g->u.proc.sz = ffesymbol_size (s);
} }
/* Else, make sure there is type agreement. */ /* Make sure there is type agreement. */
else if ((g->u.proc.bt != FFEINFO_basictypeNONE) if (g->type == FFEGLOBAL_typeFUNC
&& (ffesymbol_basictype (s) != FFEINFO_basictypeNONE) && g->u.proc.bt != FFEINFO_basictypeNONE
&& ((ffesymbol_basictype (s) != g->u.proc.bt) && ffesymbol_basictype (s) != FFEINFO_basictypeNONE
|| (ffesymbol_kindtype (s) != g->u.proc.kt) && (ffesymbol_basictype (s) != g->u.proc.bt
|| ((ffesymbol_size (s) != g->u.proc.sz) || ffesymbol_kindtype (s) != g->u.proc.kt
&& g->u.proc.defined /* CHARACTER*n disagreements matter only once a
&& (g->u.proc.sz != FFETARGET_charactersizeNONE)))) definition is involved, since the definition might
be CHARACTER*(*), which accepts all references. */
|| (g->u.proc.defined
&& ffesymbol_size (s) != g->u.proc.sz
&& ffesymbol_size (s) != FFETARGET_charactersizeNONE
&& g->u.proc.sz != FFETARGET_charactersizeNONE)))
{ {
if (ffe_is_globals ()) int error;
/* Type mismatch between function reference/definition and
this subsequent reference (which might just be the filling-in
of type info for the definition, but we can't reach here
if that's the case and there was a previous definition).
It's an error given a previous definition, since that
implies inlining can crash the compiler, unless the user
asked for no such inlining. */
error = (g->tick != ffe_count_2
&& g->u.proc.defined
&& ffe_is_globals ());
if (error || ffe_is_warn_globals ())
{ {
ffebad_start (FFEBAD_FILEWIDE_TYPE_MISMATCH); ffebad_start (error
? FFEBAD_FILEWIDE_TYPE_MISMATCH
: FFEBAD_FILEWIDE_TYPE_MISMATCH_W);
ffebad_string (ffelex_token_text (t)); ffebad_string (ffelex_token_text (t));
ffebad_here (0, ffelex_token_where_line (t), if (g->tick == ffe_count_2)
ffelex_token_where_column (t)); {
ffebad_here (1, ffelex_token_where_line (g->t), /* Current reference fills in type info for definition.
ffelex_token_where_column (g->t)); The current token doesn't necessarily point to the actual
definition of the function, so use the definition pointer
and the pointer to the pre-definition type info. */
ffebad_here (0, ffelex_token_where_line (g->t),
ffelex_token_where_column (g->t));
ffebad_here (1, ffelex_token_where_line (g->u.proc.other_t),
ffelex_token_where_column (g->u.proc.other_t));
}
else
{
/* Current reference is not a filling-in of a current
definition. The current token is fine, as is
the previous-mention token. */
ffebad_here (0, ffelex_token_where_line (t),
ffelex_token_where_column (t));
ffebad_here (1, ffelex_token_where_line (g->t),
ffelex_token_where_column (g->t));
}
ffebad_finish (); ffebad_finish ();
g->type = FFEGLOBAL_typeANY; if (error)
g->type = FFEGLOBAL_typeANY;
return FALSE; return FALSE;
} }
if (ffe_is_warn_globals ())
{
ffebad_start (FFEBAD_FILEWIDE_TYPE_MISMATCH_W);
ffebad_string (ffelex_token_text (t));
ffebad_here (0, ffelex_token_where_line (t),
ffelex_token_where_column (t));
ffebad_here (1, ffelex_token_where_line (g->t),
ffelex_token_where_column (g->t));
ffebad_finish ();
}
g->type = FFEGLOBAL_typeANY;
return TRUE;
} }
} }
...@@ -1357,6 +1411,9 @@ ffeglobal_ref_progunit_ (ffesymbol s, ffelexToken t, ffeglobalType type) ...@@ -1357,6 +1411,9 @@ ffeglobal_ref_progunit_ (ffesymbol s, ffelexToken t, ffeglobalType type)
&& (g->tick != ffe_count_2) && (g->tick != ffe_count_2)
&& ffe_is_warn_globals ()) && ffe_is_warn_globals ())
{ {
/* Now known as a global, this name previously was seen as an
intrinsic. Warn, in case the previous reference was intended
for the same global. */
ffebad_start (FFEBAD_INTRINSIC_GLOBAL); ffebad_start (FFEBAD_INTRINSIC_GLOBAL);
ffebad_string (ffelex_token_text (t)); ffebad_string (ffelex_token_text (t));
ffebad_string ("global"); ffebad_string ("global");
......
...@@ -73,6 +73,11 @@ now are recognized by @code{g77} ...@@ -73,6 +73,11 @@ now are recognized by @code{g77}
as if they ended in @samp{.for} and @samp{.fpp}, respectively. as if they ended in @samp{.for} and @samp{.fpp}, respectively.
@item @item
@code{g77} now warns about a reference to a function
when the corresponding @emph{subsequent} function program unit
disagrees with the reference concerning the type of the function.
@item
Improve documentation and indexing, Improve documentation and indexing,
including information on Year 2000 (Y2K) compliance. including information on Year 2000 (Y2K) compliance.
@end itemize @end itemize
......
char *ffe_version_string = "0.5.24-19990218"; char *ffe_version_string = "0.5.24-19990219";
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment