{
if (g->u.common.blank)
{
+ /* Not supposed to initialize blank common, though it works. */
ffebad_start (FFEBAD_COMMON_BLANK_INIT);
ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
ffebad_finish ();
{
if (g->type == FFEGLOBAL_typeCOMMON)
{
+ /* The names match, so the "blankness" should match too! */
assert (g->u.common.blank == blank);
}
else
{
+ /* This global name has already been established,
+ but as something other than a common block. */
if (ffe_is_globals () || ffe_is_warn_globals ())
{
ffebad_start (ffe_is_globals ()
&& !g->explicit_intrinsic
&& 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_string (ffelex_token_text (t));
ffebad_string ("common block");
|| (g->type == FFEGLOBAL_typeBDATA))
&& g->u.proc.defined)
{
+ /* This program unit has already been defined. */
if (ffe_is_globals () || ffe_is_warn_globals ())
{
ffebad_start (ffe_is_globals ()
&& (g->type != FFEGLOBAL_typeEXT)
&& (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 ())
{
ffebad_start (ffe_is_globals ()
g->u.proc.other_t = NULL;
}
else if ((ffesymbol_basictype (s) != FFEINFO_basictypeNONE)
+ && (g->type == FFEGLOBAL_typeFUNC)
&& ((ffesymbol_basictype (s) != g->u.proc.bt)
|| (ffesymbol_kindtype (s) != g->u.proc.kt)
|| ((ffesymbol_size (s) != FFETARGET_charactersizeNONE)
&& (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 ())
{
ffebad_start (ffe_is_globals ()
&& !g->explicit_intrinsic
&& 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_string (ffelex_token_text (t));
ffebad_string ("global");
g->u.proc.kt = ffesymbol_kindtype (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)
&& (g->type != type))
g->u.proc.n_args = -1;
+ g->tick = ffe_count_2;
g->type = type;
g->u.proc.defined = TRUE;
}
&& ! g->intrinsic
&& 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_string (ffelex_token_text (t));
ffebad_string ("intrinsic");
&& (g->tick != ffe_count_2)
&& 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_string (ffelex_token_text (t));
ffebad_string (explicit ? "explicit" : "implicit");
if ((g != NULL)
&& (g->type != FFEGLOBAL_typeNONE)
- && (g->type != type)
&& (g->type != FFEGLOBAL_typeEXT)
+ && (g->type != type)
&& (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)
&& (g->type != FFEGLOBAL_typeCOMMON))
|| ((g->type == FFEGLOBAL_typeBDATA)
#if 0 /* This is likely to just annoy people. */
if (ffe_is_warn_globals ())
{
+ /* Warn about EXTERNAL of a COMMON name, though it works. */
ffebad_start (FFEBAD_FILEWIDE_TIFF);
ffebad_string (ffelex_token_text (t));
ffebad_string (ffeglobal_type_string_[type]);
}
#endif
}
- else if (ffe_is_globals ())
+ else if (ffe_is_globals () || ffe_is_warn_globals ())
{
- ffebad_start (FFEBAD_FILEWIDE_DISAGREEMENT);
- ffebad_string (ffelex_token_text (t));
- ffebad_string (ffeglobal_type_string_[type]);
- 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_start (ffe_is_globals ()
+ ? FFEBAD_FILEWIDE_DISAGREEMENT
+ : FFEBAD_FILEWIDE_DISAGREEMENT_W);
ffebad_string (ffelex_token_text (t));
ffebad_string (ffeglobal_type_string_[type]);
ffebad_string (ffeglobal_type_string_[g->type]);
ffelex_token_where_column (g->t));
ffebad_finish ();
g->type = FFEGLOBAL_typeANY;
- return TRUE;
+ return (! ffe_is_globals ());
}
}
g->u.proc.kt = ffesymbol_kindtype (s);
g->u.proc.sz = ffesymbol_size (s);
}
- /* Else, make sure there is type agreement. */
- else if ((g->u.proc.bt != FFEINFO_basictypeNONE)
- && (ffesymbol_basictype (s) != FFEINFO_basictypeNONE)
- && ((ffesymbol_basictype (s) != g->u.proc.bt)
- || (ffesymbol_kindtype (s) != g->u.proc.kt)
- || ((ffesymbol_size (s) != g->u.proc.sz)
- && g->u.proc.defined
- && (g->u.proc.sz != FFETARGET_charactersizeNONE))))
+ /* Make sure there is type agreement. */
+ if (g->type == FFEGLOBAL_typeFUNC
+ && g->u.proc.bt != FFEINFO_basictypeNONE
+ && ffesymbol_basictype (s) != FFEINFO_basictypeNONE
+ && (ffesymbol_basictype (s) != g->u.proc.bt
+ || ffesymbol_kindtype (s) != g->u.proc.kt
+ /* CHARACTER*n disagreements matter only once a
+ 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_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));
+ if (g->tick == ffe_count_2)
+ {
+ /* Current reference fills in type info for definition.
+ 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 ();
- g->type = FFEGLOBAL_typeANY;
+ if (error)
+ g->type = FFEGLOBAL_typeANY;
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;
}
}
&& (g->tick != ffe_count_2)
&& 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_string (ffelex_token_text (t));
ffebad_string ("global");
projects / gcc.git / commitdiff