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" } }