OSDN Git Service

2007-07-21 Christopher D. Rickett <crickett@lanl.gov>
[pf3gnuchains/gcc-fork.git] / gcc / testsuite / gfortran.dg / c_f_pointer_logical.f03
1 ! { dg-do run }
2 ! { dg-additional-sources c_f_pointer_logical_driver.c }
3 ! Verify that c_f_pointer exists for C logicals (_Bool).
4 module c_f_pointer_logical
5   use, intrinsic :: iso_c_binding, only: c_bool, c_f_pointer, c_ptr, c_int
6 contains
7   subroutine test_scalar(c_logical_ptr) bind(c)
8     type(c_ptr), value :: c_logical_ptr
9     logical(c_bool), pointer :: f03_logical_ptr
10     call c_f_pointer(c_logical_ptr, f03_logical_ptr)
11     
12     if(f03_logical_ptr .neqv. .true.) call abort ()
13   end subroutine test_scalar
14
15   subroutine test_array(c_logical_array, num_elems) bind(c)
16     type(c_ptr), value :: c_logical_array
17     integer(c_int), value :: num_elems
18     logical(c_bool), pointer, dimension(:) :: f03_logical_array
19     integer :: i
20
21     call c_f_pointer(c_logical_array, f03_logical_array, (/ num_elems /))
22
23     ! Odd numbered locations are true (even numbered offsets in C)
24     do i = 1, num_elems, 2
25        if(f03_logical_array(i) .neqv. .true.) call abort ()
26     end do
27     
28     ! Even numbered locations are false.
29     do i = 2, num_elems, 2
30        if(f03_logical_array(i) .neqv. .false.) call abort ()
31     end do
32   end subroutine test_array
33 end module c_f_pointer_logical
34 ! { dg-final { cleanup-modules "c_f_pointer_logical" } }