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
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
|
! { dg-do run }
!
! Test the fix for PR94022
!
function isasa_f(a) result(s)
implicit none
integer, intent(in) :: a(..)
logical :: s
select rank(a)
rank(*)
s = .true.
rank default
s = .false.
end select
return
end function isasa_f
function isasa_c(a) result(s) bind(c)
use, intrinsic :: iso_c_binding, only: c_int, c_bool
implicit none
integer(kind=c_int), intent(in) :: a(..)
logical(kind=c_bool) :: s
select rank(a)
rank(*)
s = .true.
rank default
s = .false.
end select
return
end function isasa_c
program isasa_p
implicit none
interface
function isasa_f(a) result(s)
implicit none
integer, intent(in) :: a(..)
logical :: s
end function isasa_f
function isasa_c(a) result(s) bind(c)
use, intrinsic :: iso_c_binding, only: c_int, c_bool
implicit none
integer(kind=c_int), intent(in) :: a(..)
logical(kind=c_bool) :: s
end function isasa_c
end interface
integer, parameter :: sz = 7
integer, parameter :: lb = 3
integer, parameter :: ub = 9
integer, parameter :: ex = ub-lb+1
integer :: arr(sz,lb:ub)
arr = 1
if (asaf_a(arr, lb+1, ub-1)) stop 1
if (asaf_p(arr, lb+1, ub-1)) stop 2
if (asaf_a(arr, 2, ex-1)) stop 3
if (asaf_p(arr, 2, ex-1)) stop 4
if (asac_a(arr, lb+1, ub-1)) stop 5
if (asac_p(arr, lb+1, ub-1)) stop 6
if (asac_a(arr, 2, ex-1)) stop 7
if (asac_p(arr, 2, ex-1)) stop 8
stop
contains
function asaf_a(a, lb, ub) result(s)
integer, intent(in) :: lb
integer, target, intent(in) :: a(sz,lb:*)
integer, intent(in) :: ub
logical :: s
s = isasa_f(a(:,lb:ub))
return
end function asaf_a
function asaf_p(a, lb, ub) result(s)
integer, intent(in) :: lb
integer, target, intent(in) :: a(sz,lb:*)
integer, intent(in) :: ub
logical :: s
integer, pointer :: p(:,:)
p => a(:,lb:ub)
s = isasa_f(p)
return
end function asaf_p
function asac_a(a, lb, ub) result(s)
integer, intent(in) :: lb
integer, target, intent(in) :: a(sz,lb:*)
integer, intent(in) :: ub
logical :: s
s = logical(isasa_c(a(:,lb:ub)))
return
end function asac_a
function asac_p(a, lb, ub) result(s)
integer, intent(in) :: lb
integer, target, intent(in) :: a(sz,lb:*)
integer, intent(in) :: ub
logical :: s
integer, pointer :: p(:,:)
p => a(:,lb:ub)
s = logical(isasa_c(p))
return
end function asac_p
end program isasa_p
|
