[Bug fortran/82649] (PDT) Invalid error for assumed parameters in ALLOCATE typespec

[pault at gcc dot gnu.org via Gcc-bugs]

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=82649

--- Comment #2 from Paul Thomas <pault at gcc dot gnu.org> ---
Created attachment 65954
  --> https://gcc.gnu.org/bugzilla/attachment.cgi?id=65954&action=edit
Regression free patch

This still needs some work on variations of one kind or another.

It has only taken 9 years!

Regression tests OK with all the fixes (1:12/16)for the reducers in comment #10
of PDT.

This extension of the original test comment #0 works OK:

module matrix_mod_assumed_02

  implicit none

  type :: matrix(rk, n, m)
     integer, kind :: rk
     integer, len :: n, m
     real(rk) :: entry(n, m)
  end type matrix
  integer, parameter :: rk=kind(1.d0)
  integer, parameter :: mm=20, nn=15

contains
  subroutine factory(o_matrix)
    type(matrix(rk, *, *)), allocatable :: o_matrix
    allocate(matrix(rk, *, *) :: o_matrix)
    o_matrix%entry = 1.0
  end subroutine

  subroutine indirect_factory(o_matrix)
    type(matrix(rk, *, *)), allocatable :: o_matrix
    call factory(o_matrix)
    o_matrix%entry = 2.0
  end subroutine
end module

program test

  use matrix_mod_assumed_02
  implicit none
  type(matrix(rk, nn, mm)), allocatable  :: o_matrix

  call factory(o_matrix)
  if (o_matrix%n /= nn .or. o_matrix%m /= mm) stop 1
  if (int (sum (o_matrix%entry)) /= nn * mm) stop 2
  deallocate (o_matrix)
  call indirect_factory(o_matrix)
  if (o_matrix%n /= nn .or. o_matrix%m /= mm) stop 3
  if (int (sum (o_matrix%entry)) /= 2 * nn * mm) stop 4
  deallocate (o_matrix)
end program test