gcc/testsuite/gfortran.dg/ISO_Fortran_binding_8.f90

   1 ! { dg-do run { target c99_runtime } }
   2 ! { dg-additional-sources ISO_Fortran_binding_8.c }
   3 !
   4 ! Test the fix for PR89842.
   5 !
   6 ! Contributed by Reinhold Bader  <Bader@lrz.de>
   7 !
   8 module mod_alloc_01
   9   use, intrinsic :: iso_c_binding
  10   implicit none
  11
  12   interface
  13      subroutine globalp(this) bind(c)
  14        import :: c_float
  15        real(c_float), allocatable :: this(:)
  16      end subroutine globalp
  17   end interface
  18 end module mod_alloc_01
  19
  20 program alloc_01
  21   use mod_alloc_01
  22   implicit none
  23
  24   real(c_float), allocatable :: myp(:)
  25   integer :: status
  26
  27   status = 0
  28   call globalp(myp)
  29
  30 !  write(*,*) 'globalp done'
  31   if (.not. allocated(myp)) then
  32      write(*,*) 'FAIL 1'
  33      stop 1
  34   end if
  35   if (lbound(myp,1) /= 3 .or. size(myp,1) /= 4) then
  36      write(*,*) 'FAIL 2: ', lbound(myp), size(myp,1)
  37      status = status + 1
  38   else
  39 !     write(*,*) 'Now checking data', myp(3)
  40      if (maxval(abs(myp - [1.1, 2.3, 5.1, 4.2])) > 1.0e-6) then
  41         write(*,*) 'FAIL 3: ', myp
  42         status = status + 1
  43      end if
  44   end if
  45
  46   if (status .ne. 0) then
  47      stop status
  48   end if
  49 end program alloc_01
  50