Hello All, The valgrind error in the summary line seems to have gone but deferred parameter errors were all missed. This patch fixes them all.
Since this is verging on obvious, I will leave explanation to the change logs and the diff. Regtests on FC43/x86_64. OK for mainline? Paul
diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc
index b2996759c68..79e579f2a8d 100644
--- a/gcc/fortran/match.cc
+++ b/gcc/fortran/match.cc
@@ -4973,6 +4973,22 @@ cleanup:
}
+/* A reduced version of gfc_spec_list_type, which only looks for deferred
+ type spec list parameters. */
+
+static gfc_param_spec_type
+spec_list_type (gfc_actual_arglist *param_list)
+{
+ gfc_param_spec_type res = SPEC_EXPLICIT;
+
+ for (; param_list; param_list = param_list->next)
+ if (param_list->spec_type == SPEC_DEFERRED)
+ res = param_list->spec_type;
+
+ return res;
+}
+
+
/* Frees a list of gfc_alloc structures. */
void
@@ -4998,6 +5014,7 @@ gfc_match_allocate (void)
gfc_expr *stat, *errmsg, *tmp, *source, *mold;
gfc_typespec ts;
gfc_symbol *sym;
+ gfc_ref *ref;
match m;
locus old_locus, deferred_locus, assumed_locus;
bool saw_stat, saw_errmsg, saw_source, saw_mold, saw_deferred, b1, b2, b3;
@@ -5057,8 +5074,7 @@ gfc_match_allocate (void)
}
if (type_param_spec_list
- && gfc_spec_list_type (type_param_spec_list, NULL)
- == SPEC_DEFERRED)
+ && spec_list_type (type_param_spec_list) == SPEC_DEFERRED)
{
gfc_error ("The type parameter spec list in the type-spec at "
"%L cannot contain DEFERRED parameters", &old_locus);
@@ -5120,11 +5136,28 @@ gfc_match_allocate (void)
goto cleanup;
}
- if (tail->expr->ts.deferred)
+ if (tail->expr->ts.deferred
+ || (tail->expr->symtree->n.sym->param_list
+ && spec_list_type (tail->expr->symtree->n.sym->param_list)
+ == SPEC_DEFERRED))
{
saw_deferred = true;
deferred_locus = tail->expr->where;
}
+ else if ((tail->expr->ts.type == BT_DERIVED
+ || tail->expr->ts.type == BT_CLASS)
+ && tail->expr->ref)
+ {
+ for (ref = tail->expr->ref; ref; ref = ref->next)
+ if (ref->type == REF_COMPONENT
+ && ref->u.c.component->param_list
+ && spec_list_type (ref->u.c.component->param_list)
+ == SPEC_DEFERRED)
+ {
+ saw_deferred = true;
+ deferred_locus = tail->expr->where;
+ }
+ }
if (gfc_find_state (COMP_DO_CONCURRENT)
|| gfc_find_state (COMP_CRITICAL))
diff --git a/gcc/testsuite/gfortran.dg/pdt_87.f03 b/gcc/testsuite/gfortran.dg/pdt_87.f03
new file mode 100644
index 00000000000..68681a5cb6d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pdt_87.f03
@@ -0,0 +1,89 @@
+! { dg-do compile }
+!
+! Test the fix for pr115316, in which none of the deferred type PDT errors were caught.
+! Note the exclusion of the old-style character length at line 62. This compiles OK
+! but causes an excess errors message in the testsuite.
+!
+! Contributed by David Binderman <[email protected]>
+!
+subroutine C933_a(b1, ca3, ca4, cp3, cp3mold, cp4, cp7, cp8, bsrc)
+! If any allocate-object has a deferred type parameter, is unlimited polymorphic,
+! or is of abstract type, either type-spec or source-expr shall appear.
+ type SomeType(k, l1, l2)
+ integer, kind :: k = 1
+ integer, len :: l1
+ integer, len :: l2 = 3
+ character(len=l2+l1) str
+ end type
+
+ type B(l)
+ integer, len :: l
+ character(:), allocatable :: msg
+ type(SomeType(4, l, :)), pointer :: something
+ end type
+ character(len=:), allocatable :: ca1, ca2(:)
+ character(len=*), allocatable :: ca3, ca4(:)
+ character(len=2), allocatable :: ca5, ca6(:)
+ character(len=5) mold
+
+ type(SomeType(l1=:,l2=:)), pointer :: cp1, cp2(:)
+ type(SomeType(l1=3,l2=4)) cp1mold
+ type(SomeType(1,*,:)), pointer :: cp3, cp4(:)
+ type(SomeType(1,*,5)) cp3mold
+ type(SomeType(l1=:)), pointer :: cp5, cp6(:)
+ type(SomeType(l1=6)) cp5mold
+ type(SomeType(1,*,*)), pointer :: cp7, cp8(:)
+ type(SomeType(1, l1=3)), pointer :: cp9, cp10(:)
+
+ type(B(*)) b1
+ type(B(:)), allocatable :: b2
+ type(B(5)) b3
+
+ type(SomeType(4, *, 8)) bsrc
+
+ allocate(ca1) ! { dg-error "requires either a type-spec or SOURCE tag or a MOLD tag" }
+ allocate(ca2(4)) ! { dg-error "requires either a type-spec or SOURCE tag or a MOLD tag" }
+ allocate(cp1) ! { dg-error "requires either a type-spec or SOURCE tag or a MOLD tag" }
+ allocate(cp2(2)) ! { dg-error "requires either a type-spec or SOURCE tag or a MOLD tag" }
+ allocate(cp3) ! { dg-error "requires either a type-spec or SOURCE tag or a MOLD tag" }
+ allocate(cp4(2)) ! { dg-error "requires either a type-spec or SOURCE tag or a MOLD tag" }
+ allocate(cp5) ! { dg-error "requires either a type-spec or SOURCE tag or a MOLD tag" }
+ allocate(cp6(2)) ! { dg-error "requires either a type-spec or SOURCE tag or a MOLD tag" }
+ allocate(b1%msg) ! { dg-error "requires either a type-spec or SOURCE tag or a MOLD tag" }
+ allocate(b1%something) ! { dg-error "requires either a type-spec or SOURCE tag or a MOLD tag" }
+ allocate(b2%msg) ! { dg-error "requires either a type-spec or SOURCE tag or a MOLD tag" }
+ allocate(b2%something) ! { dg-error "requires either a type-spec or SOURCE tag or a MOLD tag" }
+ allocate(b3%msg) ! { dg-error "requires either a type-spec or SOURCE tag or a MOLD tag" }
+ allocate(b3%something) ! { dg-error "requires either a type-spec or SOURCE tag or a MOLD tag" }
+
+ ! Nominal cases, expecting no errors
+ allocate(character(len=5):: ca2(4))
+ allocate(character(len=5):: ca1)
+! allocate(character*5:: ca1)
+ allocate(ca2(4), MOLD = "abcde")
+ allocate(ca2(2), MOLD = (/"abcde", "fghij"/))
+ allocate(ca1, MOLD = mold)
+ allocate(ca2(4), SOURCE = "abcde")
+ allocate(ca2(2), SOURCE = (/"abcde", "fghij"/))
+ allocate(ca1, SOURCE = mold)
+ allocate(SomeType(l1=1, l2=2):: cp1, cp2(2))
+ allocate(SomeType(1,*,5):: cp3, cp4(2))
+ allocate(SomeType(l1=1):: cp5, cp6(2))
+ allocate(cp1, cp2(2), mold = cp1mold)
+ allocate(cp3, cp4(2), mold = cp3mold)
+ allocate(cp5, cp6(2), mold = cp5mold)
+ allocate(cp1, cp2(2), source = cp1mold)
+ allocate(cp3, cp4(2), source = cp3mold)
+ allocate(cp5, cp6(2), source = cp5mold)
+ allocate(character(len=10):: b1%msg, b2%msg, b3%msg)
+ allocate(SomeType(4, b1%l, 9):: b1%something)
+ allocate(b2%something, source=bsrc)
+ allocate(SomeType(4, 5, 8):: b3%something)
+
+ ! assumed/explicit length do not need type-spec/mold
+ allocate(ca3, ca4(4))
+ allocate(ca5, ca6(4))
+ allocate(cp7, cp8(2))
+ allocate(cp9, cp10(2))
+
+end subroutine
Change.Logs
Description: Binary data
