PR fortran/98661 - valgrind issues with error recovery

During error recovery after an invalid derived type specification it was
possible to try to resolve an invalid array specification.  We now skip
this if the component has the ALLOCATABLE or POINTER attribute and the
shape is not deferred.

gcc/fortran/ChangeLog:

	PR fortran/98661
	* resolve.c (resolve_component): Derived type components with
	ALLOCATABLE or POINTER attribute shall have a deferred shape.

gcc/testsuite/ChangeLog:

	PR fortran/98661
	* gfortran.dg/pr98661.f90: New test.
This commit is contained in:
Harald Anlauf 2021-01-14 19:13:16 +01:00
parent 9ac3e2feb3
commit d0d2becf2d
2 changed files with 42 additions and 7 deletions

View File

@ -5068,8 +5068,8 @@ resolve_array_ref (gfc_array_ref *ar)
}
static bool
resolve_substring (gfc_ref *ref, bool *equal_length)
bool
gfc_resolve_substring (gfc_ref *ref, bool *equal_length)
{
int k = gfc_validate_kind (BT_INTEGER, gfc_charlen_int_kind, false);
@ -5277,7 +5277,7 @@ gfc_resolve_ref (gfc_expr *expr)
case REF_SUBSTRING:
equal_length = false;
if (!resolve_substring (*prev, &equal_length))
if (!gfc_resolve_substring (*prev, &equal_length))
return false;
if (expr->expr_type != EXPR_SUBSTRING && equal_length)
@ -5563,6 +5563,10 @@ resolve_variable (gfc_expr *e)
if (e->symtree == NULL)
return false;
sym = e->symtree->n.sym;
if (sym == NULL)
return false;
// if (e->ts.type == BT_UNKNOWN)
// return false;
/* Use same check as for TYPE(*) below; this check has to be before TYPE(*)
as ts.type is set to BT_ASSUMED in resolve_symbol. */
@ -7038,7 +7042,8 @@ fixup_unique_dummy (gfc_expr *e)
gfc_symtree *st = NULL;
gfc_symbol *s = NULL;
if (e->symtree->n.sym->ns->proc_name
if (e->symtree->n.sym->ns
&& e->symtree->n.sym->ns->proc_name
&& e->symtree->n.sym->ns->proc_name->formal)
s = e->symtree->n.sym->ns->proc_name->formal->sym;
@ -7076,8 +7081,8 @@ gfc_resolve_expr (gfc_expr *e)
first_actual_arg = false;
}
else if (e->symtree != NULL
&& *e->symtree->name == '@'
&& e->symtree->n.sym->attr.dummy)
&& e->symtree->name && *e->symtree->name == '@'
&& e->symtree->n.sym && e->symtree->n.sym->attr.dummy)
{
/* Deal with submodule specification expressions that are not
found to be referenced in module.c(read_cleanup). */
@ -7174,6 +7179,7 @@ gfc_resolve_expr (gfc_expr *e)
/* For some reason, resolving these expressions a second time mangles
the typespec of the expression itself. */
if (t && e->expr_type == EXPR_VARIABLE
&& e->symtree && e->symtree->n.sym
&& e->symtree->n.sym->attr.select_rank_temporary
&& UNLIMITED_POLY (e->symtree->n.sym))
e->do_not_resolve_again = 1;
@ -12431,7 +12437,13 @@ resolve_charlen (gfc_charlen *cl)
saved_specification_expr = specification_expr;
specification_expr = true;
if (cl->length_from_typespec)
/* if (cl->length == NULL) */
/* { */
/* specification_expr = saved_specification_expr; */
/* return true; // return false; */
/* } */
if (cl->length_from_typespec && cl->length)
{
if (!gfc_resolve_expr (cl->length))
{
@ -14723,6 +14735,10 @@ resolve_component (gfc_component *c, gfc_symbol *sym)
&& sym != c->ts.u.derived)
add_dt_to_dt_list (c->ts.u.derived);
if (c->as && c->as->type != AS_DEFERRED
&& (c->attr.pointer || c->attr.allocatable))
return false;
if (!gfc_resolve_array_spec (c->as,
!(c->attr.pointer || c->attr.proc_pointer
|| c->attr.allocatable)))

View File

@ -0,0 +1,19 @@
! { dg-do compile }
! PR fortran/98661 - valgrind issues with error recovery
!
! Test issues related to former testcase charlen_03.f90
program p
implicit none
type t
character(:), pointer :: c(n) ! { dg-error "must have a deferred shape" }
real, allocatable :: x(n) ! { dg-error "must have a deferred shape" }
end type
end
subroutine s
! no 'implicit none'
type u
character(:), pointer :: c(n) ! { dg-error "must have a deferred shape" }
real, allocatable :: x(n) ! { dg-error "must have a deferred shape" }
end type
end