1! { dg-do run } 2! { dg-additional-sources "cf-descriptor-3-c.c dump-descriptors.c" } 3! { dg-additional-options "-g" } 4! 5! This program checks that building a descriptor for an allocatable 6! or pointer scalar argument in C works and that you can use it to call 7! back into a Fortran function declared to have c binding. 8 9module mm 10 use iso_c_binding 11 type, bind (c) :: m 12 integer(C_INT) :: i, j 13 end type 14 15 integer(C_INT), parameter :: imagic = 42, jmagic = 69 16end module 17 18subroutine ftest (a, b, initp) bind (c, name="ftest") 19 use iso_c_binding 20 use mm 21 type(m), allocatable :: a 22 type(m), pointer :: b 23 integer(C_INT), value :: initp 24 25 if (rank(a) .ne. 0) stop 101 26 if (rank(b) .ne. 0) stop 101 27 28 if (initp .ne. 0 .and. .not. allocated(a)) stop 102 29 if (initp .eq. 0 .and. allocated(a)) stop 103 30 if (initp .ne. 0 .and. .not. associated(b)) stop 104 31 if (initp .eq. 0 .and. associated(b)) stop 105 32 33 if (initp .ne. 0) then 34 if (a%i .ne. imagic) stop 201 35 if (a%j .ne. jmagic) stop 202 36 if (b%i .ne. imagic + 1) stop 203 37 if (b%j .ne. jmagic + 1) stop 204 38 end if 39end subroutine 40 41 42program testit 43 use iso_c_binding 44 use mm 45 implicit none 46 47 interface 48 subroutine ctest (i, j) bind (c) 49 use iso_c_binding 50 integer(C_INT), value :: i, j 51 end subroutine 52 end interface 53 54 ! ctest will call ftest with both an unallocated and allocated argument. 55 56 call ctest (imagic, jmagic) 57 58end program 59