gcc/testsuite/gfortran.dg/spec_expr_6.f90

   1 ! { dg-do compile }
   2 !
   3 ! PR fortran/43591
   4 !
   5 ! Pureness check for TPB/PPC in specification expressions
   6 !
   7 ! Based on a test case of Thorsten Ohl
   8 !
   9 !
  10
  11 module m
  12   implicit none
  13   type t
  14      procedure(p1_type), nopass, pointer :: p1 => NULL()
  15   contains
  16      procedure, nopass :: tbp => p1_type
  17   end type t
  18 contains
  19   subroutine proc (t1, t2)
  20     type(t), intent(in) :: t1, t2
  21     integer, dimension(t1%p1(), t2%tbp()) :: table
  22   end subroutine proc
  23   pure function p1_type()
  24    integer :: p1_type
  25    p1_type = 42
  26   end function p1_type
  27   pure subroutine p(t1)
  28     type(t), intent(inout) :: t1
  29     integer :: a(t1%p1())
  30   end subroutine p
  31 end module m
  32
  33 module m2
  34   implicit none
  35   type t
  36      procedure(p1_type), nopass, pointer :: p1 => NULL()
  37   contains
  38      procedure, nopass :: tbp => p1_type
  39   end type t
  40 contains
  41   subroutine proc (t1, t2)
  42     type(t), intent(in) :: t1, t2
  43     integer, dimension(t1%p1()) :: table1 ! { dg-error "must be PURE" }
  44     integer, dimension(t2%tbp()) :: table2 ! { dg-error "must be PURE" }
  45   end subroutine proc
  46   function p1_type()
  47     integer :: p1_type
  48     p1_type = 42
  49   end function p1_type
  50 end module m2
  51
  52 ! { dg-final { cleanup-modules "m m2" } }