gcc/testsuite/gfortran.dg/proc_ptr_comp_20.f90

   1 ! { dg-do compile }
   2 !
   3 ! PR 40869: [F03] PPC assignment checking
   4 !
   5 ! Contributed by Janus Weil <janus@gcc.gnu.org>
   6
   7 implicit none
   8
   9 interface func
  10   procedure f1,f2 ! { dg-error "Ambiguous interfaces" }
  11 end interface
  12
  13 interface operator(.op.)
  14   procedure f1,f2 ! { dg-error "Ambiguous interfaces" }
  15 end interface
  16
  17 type :: t1
  18   procedure(integer), pointer, nopass :: ppc
  19 end type
  20
  21 type :: t2
  22   procedure(real), pointer, nopass :: ppc
  23 end type
  24
  25 type(t1) :: o1
  26 type(t2) :: o2
  27 procedure(logical),pointer :: pp1
  28 procedure(complex),pointer :: pp2
  29
  30 pp1 => pp2        ! { dg-error "Type/rank mismatch" }
  31 pp2 => o2%ppc     ! { dg-error "Type/rank mismatch" }
  32
  33 o1%ppc => pp1     ! { dg-error "Type/rank mismatch" }
  34 o1%ppc => o2%ppc  ! { dg-error "Type/rank mismatch" }
  35
  36 contains
  37
  38   real function f1(a,b) ! { dg-warning "Extension: Internal procedure" }
  39     real,intent(in) :: a,b
  40     f1 = a + b
  41   end function
  42
  43   integer function f2(a,b) ! { dg-warning "Extension: Internal procedure" }
  44     real,intent(in) :: a,b
  45     f2 = a - b
  46   end function
  47
  48 end
  49