Fortran - reject function entries with mismatched characteristics
gcc/fortran/ChangeLog: PR fortran/87737 * resolve.c (resolve_entries): For functions of type CHARACTER tighten the checks for matching characteristics. gcc/testsuite/ChangeLog: PR fortran/87737 * gfortran.dg/entry_24.f90: New test.
This commit is contained in:
parent
754fca77e8
commit
f9809ef570
2 changed files with 29 additions and 0 deletions
|
@ -804,6 +804,15 @@ resolve_entries (gfc_namespace *ns)
|
||||||
the same string length, i.e. both len=*, or both len=4.
|
the same string length, i.e. both len=*, or both len=4.
|
||||||
Having both len=<variable> is also possible, but difficult to
|
Having both len=<variable> is also possible, but difficult to
|
||||||
check at compile time. */
|
check at compile time. */
|
||||||
|
else if (ts->type == BT_CHARACTER
|
||||||
|
&& (el->sym->result->attr.allocatable
|
||||||
|
!= ns->entries->sym->result->attr.allocatable))
|
||||||
|
{
|
||||||
|
gfc_error ("Function %s at %L has entry %s with mismatched "
|
||||||
|
"characteristics", ns->entries->sym->name,
|
||||||
|
&ns->entries->sym->declared_at, el->sym->name);
|
||||||
|
return;
|
||||||
|
}
|
||||||
else if (ts->type == BT_CHARACTER && ts->u.cl && fts->u.cl
|
else if (ts->type == BT_CHARACTER && ts->u.cl && fts->u.cl
|
||||||
&& (((ts->u.cl->length && !fts->u.cl->length)
|
&& (((ts->u.cl->length && !fts->u.cl->length)
|
||||||
||(!ts->u.cl->length && fts->u.cl->length))
|
||(!ts->u.cl->length && fts->u.cl->length))
|
||||||
|
|
20
gcc/testsuite/gfortran.dg/entry_24.f90
Normal file
20
gcc/testsuite/gfortran.dg/entry_24.f90
Normal file
|
@ -0,0 +1,20 @@
|
||||||
|
! { dg-do compile }
|
||||||
|
! PR fortran/87737 - improve check on function entry characteristics
|
||||||
|
|
||||||
|
function f() ! { dg-error "mismatched characteristics" }
|
||||||
|
character(:), allocatable :: f
|
||||||
|
character(1) :: g
|
||||||
|
f = 'f'
|
||||||
|
return
|
||||||
|
entry g()
|
||||||
|
g = 'g'
|
||||||
|
end
|
||||||
|
|
||||||
|
function f2() ! { dg-error "mismatched characteristics" }
|
||||||
|
character(1) :: f2
|
||||||
|
character(1), allocatable :: g2
|
||||||
|
f2 = 'f'
|
||||||
|
return
|
||||||
|
entry g2()
|
||||||
|
g2 = 'g'
|
||||||
|
end
|
Loading…
Add table
Reference in a new issue