Skip to content

Commit

Permalink
Fix default type bugs in gfortran [PR99139, PR99368]
Browse files Browse the repository at this point in the history
The attached patch incorporates two of Steve's "Orphaned Patches" -
https://gcc.gnu.org/pipermail/fortran/2023-June/059423.html

They have in common that they both involve faults in use of default
type and that I was the ultimate cause of the bugs.

The patch regtests with the attached testcases.

I will commit in the next 24 hours unless there are any objections.

Paul

Fortran: Fix default type bugs in gfortran [PR99139, PR99368]

2023-07-08  Steve Kargl  <sgk@troutmask.apl.washington.edu>

gcc/fortran
PR fortran/99139
PR fortran/99368
* match.cc (gfc_match_namelist): Check for host associated or
defined types before applying default type.
(gfc_match_select_rank): Apply default type to selector of
unlnown type if possible.
* resolve.cc (resolve_fl_variable): Do not apply local default
initialization to assumed rank entities.

gcc/testsuite/
PR fortran/999139
* gfortran.dg/pr99139.f90 : New test

PR fortran/99368
* gfortran.dg/pr99368.f90 : New test

Fortran: Fix default type bugs in gfortran [PR99139, PR99368]

2023-07-08  Steve Kargl  <sgk@troutmask.apl.washington.edu>

gcc/fortran
PR fortran/99139
PR fortran/99368
* match.cc (gfc_match_namelist): Check for host associated or
defined types before applying default type.
(gfc_match_select_rank): Apply default type to selector of
unlnown type if possible.
* resolve.cc (resolve_fl_variable): Do not apply local default
initialization to assumed rank entities.

gcc/testsuite/
PR fortran/999139
* gfortran.dg/pr99139.f90 : New test

PR fortran/99368
* gfortran.dg/pr99368.f90 : New test
  • Loading branch information
PaulThomas1000 authored and ouuleilei-bot committed Jul 8, 2023
1 parent c2d62cd commit b6d8417
Show file tree
Hide file tree
Showing 2 changed files with 40 additions and 5 deletions.
42 changes: 38 additions & 4 deletions gcc/fortran/match.cc
Original file line number Diff line number Diff line change
Expand Up @@ -5617,10 +5617,32 @@ gfc_match_namelist (void)
gfc_error_check ();
}
else
/* If the type is not set already, we set it here to the
implicit default type. It is not allowed to set it
later to any other type. */
gfc_set_default_type (sym, 0, gfc_current_ns);
{
/* Before the symbol is given an implicit type, check to
see if the symbol is already available in the namespace,
possibly through host association. Importantly, the
symbol may be a user defined type. */

gfc_symbol *tmp;

gfc_find_symbol (sym->name, NULL, 1, &tmp);
if (tmp
&& tmp->attr.generic
&& (tmp = gfc_find_dt_in_generic (tmp)))
{
if (tmp->attr.flavor == FL_DERIVED)
{
gfc_error ("Derived type %qs at %L conflicts with "
"namelist object %qs at %C",
tmp->name, &tmp->declared_at, sym->name);
goto error;
}
}

/* Set type of the symbol to its implicit default type. It is
not allowed to set it later to any other type. */
gfc_set_default_type (sym, 0, gfc_current_ns);
}
}
if (sym->attr.in_namelist == 0
&& !gfc_add_in_namelist (&sym->attr, sym->name, NULL))
Expand Down Expand Up @@ -6770,8 +6792,20 @@ gfc_match_select_rank (void)

gfc_current_ns = gfc_build_block_ns (ns);
m = gfc_match (" %n => %e", name, &expr2);

if (m == MATCH_YES)
{
/* If expr2 corresponds to an implicitly typed variable, then the
actual type of the variable may not have been set. Set it here. */
if (!gfc_current_ns->seen_implicit_none
&& expr2->expr_type == EXPR_VARIABLE
&& expr2->ts.type == BT_UNKNOWN
&& expr2->symtree && expr2->symtree->n.sym)
{
gfc_set_default_type (expr2->symtree->n.sym, 0, gfc_current_ns);
expr2->ts.type = expr2->symtree->n.sym->ts.type;
}

expr1 = gfc_get_expr ();
expr1->expr_type = EXPR_VARIABLE;
expr1->where = expr2->where;
Expand Down
3 changes: 2 additions & 1 deletion gcc/fortran/resolve.cc
Original file line number Diff line number Diff line change
Expand Up @@ -13484,7 +13484,8 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag)
}
}

if (sym->value == NULL && sym->attr.referenced)
if (sym->value == NULL && sym->attr.referenced
&& !(sym->as && sym->as->type == AS_ASSUMED_RANK))
apply_default_init_local (sym); /* Try to apply a default initialization. */

/* Determine if the symbol may not have an initializer. */
Expand Down

0 comments on commit b6d8417

Please sign in to comment.