gcc/testsuite/gfortran.dg/ISO_Fortran_binding_7.f90

   1 ! { dg-do run { target c99_runtime } }
   2 ! { dg-additional-sources ISO_Fortran_binding_7.c }
   3 !
   4 ! Test the fix for PR89841.
   5 !
   6 ! Contributed by Reinhold Bader  <Bader@lrz.de>
   7 !
   8 program assumed_shape_01
   9   use, intrinsic :: iso_c_binding
  10   implicit none
  11   type, bind(c) :: cstruct
  12      integer(c_int) :: i
  13      real(c_float) :: r(2)
  14   end type cstruct
  15   interface
  16      function psub(this, that, case) bind(c, name='Psuba') result(status)
  17        import :: c_float, c_int, cstruct
  18        real(c_float) :: this(:,:)
  19        type(cstruct) :: that(:)
  20        integer(c_int), value :: case
  21        integer(c_int) :: status
  22      end function psub
  23   end interface
  24
  25   real(c_float) :: t(3,7)
  26   type(cstruct), pointer :: u(:)
  27   type(cstruct), allocatable :: v(:)
  28   integer(c_int) :: st
  29
  30   allocate(u(1), source=[cstruct( 4, [1.1,2.2] ) ])
  31   allocate(v(1), source=[cstruct( 4, [1.1,2.2] ) ])
  32   t = 0.0
  33   t(3,2) = -2.0
  34   st = psub(t, u, 1)
  35   if (st .ne. 0) stop 1
  36   st = psub(t, v, 2)
  37   if (st .ne. 0) stop 2
  38   deallocate (u)
  39   deallocate (v)
  40
  41 end program assumed_shape_01
  42