gcc/testsuite/gfortran.dg/ISO_Fortran_binding_6.f90

   1 ! { dg-do run }
   2 ! { dg-additional-sources ISO_Fortran_binding_6.c }
   3 !
   4 ! Test fix of PR89366.
   5 !
   6 ! Contributed by Reinhold Bader  <Bader@lrz.de>
   7 !
   8 program assumed_length_01
   9   use, intrinsic :: iso_c_binding
  10   implicit none
  11   integer, parameter :: strlen = 12
  12   integer(c_int) :: ierr(3)
  13   character(kind=c_char,len=strlen) :: s1
  14   character(kind=c_char,len=:), allocatable :: s2
  15   character(kind=c_char,len=:), pointer :: s3
  16 !
  17 ! invoke a C function that processes an assumed length string
  18   interface
  19      subroutine process_string(this, ierr) BIND(C)
  20        import :: c_char, c_int
  21        character(kind=c_char,len=*), intent(in) :: this(..)
  22        integer(c_int), intent(inout) :: ierr
  23      end subroutine process_string
  24   end interface
  25 !
  26 !
  27   ierr = 0
  28   s1 = c_char_'wrzlprmft' // c_null_char
  29   call process_string(s1, ierr(1))
  30   if (ierr(1) /= 0) stop 1
  31   s2 = c_char_'wrzlprmft' // c_null_char
  32   allocate(s3, source=trim(s1))
  33   call process_string(s2, ierr(2))
  34   if (ierr(2) /= 0) stop 2
  35   call process_string(s3, ierr(3))
  36   if (ierr(3) /= 0) stop 3
  37   if (sum(abs(ierr)) == 0) write(*,*) 'OK'
  38
  39   deallocate(s2,s3)
  40
  41 end program assumed_length_01