1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
|
! { dg-do run }
!
! PR fortran/45424
! PR fortran/48820
!
! Additional run-time checks for IS_CONTIGUOUS with assumed type/rank
program is_contiguous_2
implicit none
real, allocatable :: b(:,:)
real, pointer :: c(:,:)
integer, volatile :: k
target :: b
allocate(b(10,10))
k = 2
if (fail_ar (b, .true.) ) stop 1
if (fail_ar (b(::1,::1), .true.) ) stop 2
if (fail_ar (b(::2,::1), .false.)) stop 3
if (fail_ar (b(::1,::2), .false.)) stop 4
if (fail_ar (b(:10,:10), .true. )) stop 5
if (fail_ar (b(: 9,:10), .false.)) stop 6
if (fail_ar (b(2: ,: ), .false.)) stop 7
if (fail_ar (b(: ,2: ), .true. )) stop 8
if (fail_ar (b(k: ,: ), .false.)) stop 9
if (fail_ar (b(: ,k: ), .true. )) stop 10
if (fail_at (b(::1,k: ), .true. )) stop 11
if (fail_at (b(::k,k: ), .false.)) stop 12
if (fail_at (b(10,k) , .true. )) stop 13
c => b(::1,:)
if (fail_ar (c, .true.) ) stop 14
c => b(::2,:)
if (fail_ar (c, .false.)) stop 15
associate (d => b(:,2:), e => b(::k,:))
if (fail_ar (d, .true.) ) stop 16
if (fail_ar (e, .false.)) stop 17
end associate
contains
pure logical function fail_ar (x, expect) result (fail)
real, dimension(..), intent(in) :: x ! Assumed rank
logical, intent(in) :: expect
fail = is_contiguous (x) .neqv. expect
end function fail_ar
pure logical function fail_at (x, expect) result (fail)
type(*), dimension(..), intent(in) :: x ! Assumed type/assumed rank
logical, intent(in) :: expect
fail = is_contiguous (x) .neqv. expect
end function fail_at
end program
|
