gcc/testsuite/gfortran.dg/dummy_procedure_8.f90

   1 ! { dg-do compile }
   2 !
   3 ! PR 35831: [F95] Shape mismatch check missing for dummy procedure argument
   4 !
   5 ! Contributed by Janus Weil <janus@gcc.gnu.org>
   6
   7 implicit none
   8
   9 call call_a(a1)  ! { dg-error "Character length mismatch in function result" }
  10 call call_a(a2)  ! { dg-error "Character length mismatch in function result" }
  11 call call_b(b1)  ! { dg-error "Shape mismatch" }
  12 call call_c(c1)  ! { dg-error "POINTER attribute mismatch in function result" }
  13 call call_d(c1)  ! { dg-error "ALLOCATABLE attribute mismatch in function result" }
  14 call call_e(e1)  ! { dg-error "CONTIGUOUS attribute mismatch in function result" }
  15 call call_f(c1)  ! { dg-error "PROCEDURE POINTER mismatch in function result" }
  16
  17 contains
  18
  19   character(1) function a1()
  20   end function
  21
  22   character(:) function a2()
  23   end function
  24
  25   subroutine call_a(a3)
  26     interface
  27       character(2) function a3()
  28       end function
  29     end interface
  30   end subroutine
  31
  32
  33   function b1()
  34     integer, dimension(1:3) :: b1
  35   end function
  36
  37   subroutine call_b(b2)
  38     interface
  39       function b2()
  40         integer, dimension(0:4) :: b2
  41       end function
  42     end interface
  43   end subroutine
  44
  45
  46   integer function c1()
  47   end function
  48
  49   subroutine call_c(c2)
  50     interface
  51       function c2()
  52         integer, pointer :: c2
  53       end function
  54     end interface
  55   end subroutine
  56
  57
  58   subroutine call_d(d2)
  59     interface
  60       function d2()
  61         integer, allocatable :: d2
  62       end function
  63     end interface
  64   end subroutine
  65
  66
  67   function e1()
  68     integer, dimension(:), pointer :: e1
  69   end function
  70
  71   subroutine call_e(e2)
  72     interface
  73       function e2()
  74         integer, dimension(:), pointer, contiguous :: e2
  75       end function
  76     end interface
  77   end subroutine
  78
  79
  80   subroutine call_f(f2)
  81     interface
  82       function f2()
  83         procedure(integer), pointer :: f2
  84       end function
  85     end interface
  86   end subroutine
  87
  88 end