On Wed, Mar 11, 2026 at 12:39:15PM +0000, Paul Richard Thomas wrote:
> 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?
>
Ok, but with tiny questions below?
> 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;
Can there be more than one spec_type that is deferred?
Do you want/need something like?
It seems that you may be able to break out of the for-loop.
if (param_list->spec_type == SPEC_DEFERRED)
{
res = param_list->spec_type;
break;
}
> +
> + 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
--
Steve
