1! { dg-do run } 2! { dg-additional-sources ISO_Fortran_binding_17.c } 3! { dg-options "-fcheck=all" } 4! { dg-warning "command-line option '-fcheck=all' is valid for Fortran but not for C" "" { target *-*-* } 0 } 5! 6! PR fortran/92470 7! 8! https://github.com/j3-fortran/fortran_proposals/issues/57#issuecomment-552680503 9! 10! Unit Test #: Test-1.F2018-2.7.5 11! Author : FortranFan 12! Reference : The New Features of Fortran 2018, John Reid, August 2, 2018 13! ISO/IEC JTC1/SC22/WG5 N2161 14! Description: 15! Test item 2.7.5 Fortran subscripting 16! void *CFI_address(const CFI_cdesc_t *dv, const CFI_index_t subscripts[]); 17! that returns the C address of a scalar or of an element of an array using 18! Fortran sub-scripting. 19! 20 use, intrinsic :: iso_c_binding, only: c_int, c_size_t, c_loc 21 implicit none 22 23 integer, parameter :: LB_A = -2 24 integer, parameter :: UB_A = 1 25 character(len=*), parameter :: fmtg = "(*(g0,1x))" 26 character(len=*), parameter :: fmth = "(g0,1x,z0)" 27 28 blk1: block 29 interface 30 subroutine Csub(a, loc_a_1, invalid_idx) bind(C, name="Csub") 31 import :: c_size_t 32 type(*), intent(in) :: a(:) 33 integer(c_size_t), intent(in), value :: loc_a_1, invalid_idx 34 end subroutine 35 end interface 36 37 integer(c_int), target :: a( LB_A:UB_A ) 38 integer(c_size_t) :: loc_a 39 40 print fmtg, "Block 1" 41 42 loc_a = transfer( c_loc(a(lbound(a,dim=1))), mold=loc_a) 43 print fmth, "Address of a: ", loc_a 44 45 call Csub(a, loc_a, -1_c_size_t) ! LB starts at 0 46 call Csub(a, loc_a, 5_c_size_t) ! 4 elements + 1 47 print * 48 end block blk1 49 50 blk2: block 51 interface 52 subroutine Csub(a, loc_a_1, invalid_idx) bind(C, name="Csub") 53 import :: c_int, c_size_t 54 integer(kind=c_int), allocatable, intent(in) :: a(:) 55 integer(c_size_t), intent(in), value :: loc_a_1, invalid_idx 56 end subroutine 57 end interface 58 59 integer(c_int), allocatable, target :: a(:) 60 integer(c_size_t) :: loc_a 61 62 print fmtg, "Block 2" 63 64 allocate( a( LB_A:UB_A ) ) 65 loc_a = transfer( c_loc(a(lbound(a,dim=1))), mold=loc_a ) 66 print fmth, "Address of a: ", loc_a 67 68 call Csub(a, loc_a, LB_A-1_c_size_t) 69 call Csub(a, loc_a, UB_A+1_c_size_t) 70 print * 71 end block blk2 72end 73 74! { dg-output "CFI_address: subscripts\\\[0\\\] is out of bounds. For dimension = 0, subscripts = -1, lower_bound = 0, upper bound = 4, extend = 4(\n|\r\n|\r)" } 75! { dg-output "CFI_address: subscripts\\\[0\\\] is out of bounds. For dimension = 0, subscripts = 5, lower_bound = 0, upper bound = 4, extend = 4(\n|\r\n|\r).*" } 76! { dg-output "CFI_address: subscripts\\\[0\\\] is out of bounds. For dimension = 0, subscripts = -3, lower_bound = -2, upper bound = 6, extend = 4(\n|\r\n|\r)" } 77! { dg-output "CFI_address: subscripts\\\[0\\\] is out of bounds. For dimension = 0, subscripts = 2, lower_bound = -2, upper bound = 6, extend = 4(\n|\r\n|\r)" } 78