gcc/testsuite/gfortran.dg/proc_ptr_comp_pass_4.f90

   1 ! { dg-do compile }
   2 !
   3 ! PR 39630: [F03] Procedure Pointer Components with PASS
   4 !
   5 ! Contributed by Janus Weil <janus@gcc.gnu.org>
   6
   7 module m
   8
   9  type :: t0
  10   procedure() :: p0  ! { dg-error "POINTER attribute is required for procedure pointer component" }
  11  end type
  12
  13  type :: t1
  14   integer :: i
  15   procedure(foo1), pointer :: f1  ! { dg-error "must be scalar" }
  16  end type
  17
  18  type :: t2
  19   integer :: i
  20   procedure(foo2), pointer :: f2  ! { dg-error "may not have the POINTER attribute" }
  21  end type
  22
  23  type :: t3
  24   integer :: i
  25   procedure(foo3), pointer :: f3  ! { dg-error "may not be ALLOCATABLE" }
  26  end type
  27
  28  type :: t4
  29    procedure(),     pass(x), pointer :: f4  ! { dg-error "NOPASS or explicit interface required" }
  30    procedure(real), pass(y), pointer :: f5  ! { dg-error "NOPASS or explicit interface required" }
  31    procedure(foo6), pass(c), pointer :: f6  ! { dg-error "has no argument" }
  32  end type
  33
  34  type :: t7
  35    procedure(foo7), pass, pointer :: f7  ! { dg-error "must have at least one argument" }
  36  end type
  37
  38  type :: t8
  39    procedure(foo8), pass, pointer :: f8  ! { dg-error "must be of the derived type" }
  40    procedure(foo9), pass, pointer :: f9  ! { dg-error "Non-polymorphic passed-object dummy argument" }
  41  end type
  42
  43 contains
  44
  45  subroutine foo1 (x1,y1)
  46   class(t1) :: x1(:)
  47   type(t1) :: y1
  48  end subroutine
  49
  50  subroutine foo2 (x2,y2)
  51   class(t2),pointer :: x2
  52   type(t2) :: y2
  53  end subroutine
  54
  55  subroutine foo3 (x3,y3)
  56   class(t3),allocatable :: x3
  57   type(t3) :: y3
  58  end subroutine
  59
  60  real function foo6 (a,b)
  61    real :: a,b
  62    foo6 = 1.
  63  end function
  64
  65  integer function foo7 ()
  66    foo7 = 2
  67  end function
  68
  69  character function foo8 (i)
  70    integer :: i
  71  end function
  72
  73  subroutine foo9(x)
  74    type(t8) :: x
  75  end subroutine
  76
  77 end module m