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_b(b1)  ! { dg-error "Shape mismatch" }
  11 call call_c(c1)  ! { dg-error "POINTER attribute mismatch in function result" }
  12 call call_d(c1)  ! { dg-error "ALLOCATABLE attribute mismatch in function result" }
  13 call call_e(e1)  ! { dg-error "CONTIGUOUS attribute mismatch in function result" }
  14 call call_f(c1)  ! { dg-error "PROCEDURE POINTER mismatch in function result" }
  15
  16 contains
  17
  18   character(1) function a1()
  19   end function
  20
  21   subroutine call_a(a3)
  22     interface
  23       character(2) function a3()
  24       end function
  25     end interface
  26   end subroutine
  27
  28
  29   function b1()
  30     integer, dimension(1:3) :: b1
  31   end function
  32
  33   subroutine call_b(b2)
  34     interface
  35       function b2()
  36         integer, dimension(0:4) :: b2
  37       end function
  38     end interface
  39   end subroutine
  40
  41
  42   integer function c1()
  43   end function
  44
  45   subroutine call_c(c2)
  46     interface
  47       function c2()
  48         integer, pointer :: c2
  49       end function
  50     end interface
  51   end subroutine
  52
  53
  54   subroutine call_d(d2)
  55     interface
  56       function d2()
  57         integer, allocatable :: d2
  58       end function
  59     end interface
  60   end subroutine
  61
  62
  63   function e1()
  64     integer, dimension(:), pointer :: e1
  65   end function
  66
  67   subroutine call_e(e2)
  68     interface
  69       function e2()
  70         integer, dimension(:), pointer, contiguous :: e2
  71       end function
  72     end interface
  73   end subroutine
  74
  75
  76   subroutine call_f(f2)
  77     interface
  78       function f2()
  79         procedure(integer), pointer :: f2
  80       end function
  81     end interface
  82   end subroutine
  83
  84 end