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