[Bug fortran/77525] wrong requirement of an upper bound for an array argument

[Bug fortran/77525] wrong requirement of an upper bound for an array argument

[themos.tsikas at gmail dot com]

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

Themos Tsikas <themos.tsikas at gmail dot com> changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
                 CC|                            |themos.tsikas at gmail dot com

--- Comment #3 from Themos Tsikas <themos.tsikas at gmail dot com> ---
For the benefit of others which encounter this bug, a workaround is presented
below:

     Module mdb_proc
      Implicit None
      Abstract Interface
        Subroutine p(tx, r)
          Real, Intent (In) :: tx(*)
          Real, Intent (Out) :: r
        End Subroutine
      End Interface

      Type mdb_proc_t
        Character (32) :: cname
        Integer :: mode = 0
        Procedure (p), Pointer, Nopass :: f
      End Type

      Integer, Parameter :: nprocmax = 2
      Type (mdb_proc_t), Target :: listproc(1:nprocmax)

    End Module

    Subroutine test(tx, r)
      Use mdb_proc, Only: mdb_proc_t, listproc, p
      Implicit None
      Real, Intent (In) :: tx(*)
      Real, Intent (Out) :: r
      Type (mdb_proc_t), Pointer :: my_proc

      my_proc => listproc(1)
!     Call my_proc%f(tx,r)
      Call workaround(pp=my_proc%f, tx=tx, r=r)
      Print '(EN12.3)', r
    Contains
      Subroutine workaround(pp, tx, r)
        Procedure (p) :: pp
        Real, Intent (In) :: tx(*)
        Real, Intent (Out) :: r

        Call pp(tx, r)
      End Subroutine
    End Subroutine

    Program main
      Use mdb_proc, Only:mdb_proc_t, listproc

      Real, Allocatable :: z(:)
      Integer :: nz

      listproc(1) = mdb_proc_t('a', 1, p1)

      Allocate (z(0))
      nz = 0
      Call test(z, r)
      Deallocate (z)
      Allocate (z(1))
      z = 42.
      nz = 1
      Call test(z, r)
    Contains
      Subroutine p1(tx, r)
        Real, Intent (In) :: tx(*)
        Real, Intent (Out) :: r

        r = maxval(tx(1:nz))
      End Subroutine
    End Program