Re: [Patch, fortran] PR115316 - [PDT] valgrind error in insert_parameter_exprs

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