gcc/testsuite/gfortran.dg/typebound_proc_19.f90

   1 ! { dg-do compile }
   2 ! { dg-require-visibility "" }
   3 !
   4 ! PR fortran/47399
   5 !
   6 ! Contributed by Wolfgang Kilian.
   7 !
   8
   9 module mytypes
  10    implicit none
  11    private
  12    public :: mytype, get_i
  13
  14    integer, save :: i_priv = 13
  15    type :: mytype
  16       integer :: dummy
  17     contains
  18       procedure, nopass :: i => get_i
  19    end type mytype
  20  contains
  21    pure function get_i () result (i)
  22      integer :: i
  23      i = i_priv
  24    end function get_i
  25 end module mytypes
  26
  27 subroutine test()
  28    use mytypes
  29    implicit none
  30
  31    type(mytype) :: a
  32    type(mytype), parameter :: a_const = mytype (0)
  33    integer, dimension (get_i()) :: x            ! #1
  34    integer, dimension (a%i()) :: y              ! #2
  35    integer, dimension (a_const%i()) :: z        ! #3
  36
  37    if (size (x) /= 13 .or. size(y) /= 13 .or. size(z) /= 13) STOP 1
  38 !   print *, size (x), size(y), size(z)
  39 end subroutine test
  40
  41 call test()
  42 end