! { dg-do run }
! { dg-additional-sources PR100906.c }
!
! Test the fix for PR100906
!
module isof_m
use, intrinsic :: iso_c_binding, only: &
c_signed_char, c_int16_t
implicit none
private
public :: &
CFI_type_character
public :: &
CFI_type_char, &
CFI_type_ucs4_char
public :: &
check_tk_as, &
check_tk_ar
public :: &
cfi_encode_type
integer, parameter :: CFI_type_t = c_int16_t
integer(kind=c_int16_t), parameter :: CFI_type_mask = int(z"FF", kind=c_int16_t)
integer(kind=c_int16_t), parameter :: CFI_type_kind_shift = 8_c_int16_t
! Intrinsic types. Their kind number defines their storage size. */
integer(kind=c_signed_char), parameter :: CFI_type_Character = 5
! C-Fortran Interoperability types.
integer(kind=cfi_type_t), parameter :: CFI_type_char = &
ior(int(CFI_type_Character, kind=c_int16_t), shiftl(1_c_int16_t, CFI_type_kind_shift))
integer(kind=cfi_type_t), parameter :: CFI_type_ucs4_char = &
ior(int(CFI_type_Character, kind=c_int16_t), shiftl(4_c_int16_t, CFI_type_kind_shift))
interface
subroutine check_tk_as(a, t, k, e, n) &
bind(c, name="check_tk")
use, intrinsic :: iso_c_binding, only: &
c_int16_t, c_signed_char, c_size_t
implicit none
type(*), intent(in) :: a(:)
integer(c_int16_t), value, intent(in) :: t
integer(c_signed_char), value, intent(in) :: k
integer(c_size_t), value, intent(in) :: e
integer(c_size_t), value, intent(in) :: n
end subroutine check_tk_as
subroutine check_tk_ar(a, t, k, e, n) &
bind(c, name="check_tk")
use, intrinsic :: iso_c_binding, only: &
c_int16_t, c_signed_char, c_size_t
implicit none
type(*), intent(in) :: a(..)
integer(c_int16_t), value, intent(in) :: t
integer(c_signed_char), value, intent(in) :: k
integer(c_size_t), value, intent(in) :: e
integer(c_size_t), value, intent(in) :: n
end subroutine check_tk_ar
end interface
contains
elemental function cfi_encode_type(type, kind) result(itype)
integer(kind=c_signed_char), intent(in) :: type
integer(kind=c_signed_char), intent(in) :: kind
integer(kind=c_int16_t) :: itype, ikind
itype = int(type, kind=c_int16_t)
itype = iand(itype, CFI_type_mask)
ikind = int(kind, kind=c_int16_t)
ikind = iand(ikind, CFI_type_mask)
ikind = shiftl(ikind, CFI_type_kind_shift)
itype = ior(ikind, itype)
return
end function cfi_encode_type
end module isof_m
module iso_check_m
use, intrinsic :: iso_c_binding, only: &
c_signed_char, c_int16_t, c_size_t
use, intrinsic :: iso_c_binding, only: &
c_char
use :: isof_m, only: &
CFI_type_character
use :: isof_m, only: &
CFI_type_char, &
CFI_type_ucs4_char
use :: isof_m, only: &
check_tk_as, &
check_tk_ar
use :: isof_m, only: &
cfi_encode_type
implicit none
private
public :: &
check_c_char_l1, &
check_c_char_lm, &
check_c_ucs4_char_l1, &
check_c_ucs4_char_lm
integer :: i
integer(kind=c_size_t), parameter :: b = 8
integer, parameter :: n = 11
integer, parameter :: m = 7
integer, parameter :: c_ucs4_char = 4
character(kind=c_char, len=1), parameter :: ref_c_char_l1(*) = &
[(achar(i+iachar("A")-1, kind=c_char), i=1,n)]
character(kind=c_char, len=m), parameter :: ref_c_char_lm(*) = &
[(repeat(achar(i+iachar("A")-1, kind=c_char), m), i=1,n)]
character(kind=c_ucs4_char, len=1), parameter :: ref_c_ucs4_char_l1(*) = &
[(achar(i+iachar("A")-1, kind=c_ucs4_char), i=1,n)]
character(kind=c_ucs4_char, len=m), parameter :: ref_c_ucs4_char_lm(*) = &
[(repeat(achar(i+iachar("A")-1, kind=c_ucs4_char), m), i=1,n)]
contains
subroutine check_c_char_l1()
character(kind=c_char, len=1), target :: a(n)
!
character(kind=c_char, len=:), pointer :: p(:)
!
a = ref_c_char_l1
call f_check_c_char_c1_as(a)
if(any(a/=ref_c_char_l1)) stop 1
a = ref_c_char_l1
call c_check_c_char_c1_as(a)
if(any(a/=ref_c_char_l1)) stop 2
a = ref_c_char_l1
call f_check_c_char_c1_ar(a)
if(any(a/=ref_c_char_l1)) stop 3
a = ref_c_char_l1
call c_check_c_char_c1_ar(a)
if(any(a/=ref_c_char_l1)) stop 4
a = ref_c_char_l1
call f_check_c_char_a1_as(a)
if(any(a/=ref_c_char_l1)) stop 5
a = ref_c_char_l1
call c_check_c_char_a1_as(a)
if(any(a/=ref_c_char_l1)) stop 6
a = ref_c_char_l1
call f_check_c_char_a1_ar(a)
if(any(a/=ref_c_char_l1)) stop 7
a = ref_c_char_l1
call c_check_c_char_a1_ar(a)
if(any(a/=ref_c_char_l1)) stop 8
a = ref_c_char_l1
p => a
call f_check_c_char_d1_as(p)
if(.not.associated(p)) stop 9
if(.not.associated(p, a)) stop 10
if(any(p/=ref_c_char_l1)) stop 11
if(any(a/=ref_c_char_l1)) stop 12
a = ref_c_char_l1
p => a
call c_check_c_char_d1_as(p)
if(.not.associated(p)) stop 13
if(.not.associated(p, a)) stop 14
if(any(p/=ref_c_char_l1)) stop 15
if(any(a/=ref_c_char_l1)) stop 16
a = ref_c_char_l1
p => a
call f_check_c_char_d1_ar(p)
if(.not.associated(p)) stop 17
if(.not.associated(p, a)) stop 18
if(any(p/=ref_c_char_l1)) stop 19
if(any(a/=ref_c_char_l1)) stop 20
a = ref_c_char_l1
p => a
call c_check_c_char_d1_ar(p)
if(.not.associated(p)) stop 21
if(.not.associated(p, a)) stop 22
if(any(p/=ref_c_char_l1)) stop 23
if(any(a/=ref_c_char_l1)) stop 24
return
end subroutine check_c_char_l1
subroutine f_check_c_char_c1_as(a)
character(kind=c_char, len=1), intent(in) :: a(:)
!
integer(kind=c_int16_t) :: t
integer(kind=c_signed_char) :: k
integer(kind=c_size_t) :: e, n
!
k = kind(a)
n = len(a, kind=kind(e))
e = storage_size(a, kind=kind(e))/(b*1)
t = cfi_encode_type(CFI_type_Character, k)
if(k<=0_c_signed_char) stop 25
if(k/=1_c_signed_char) stop 26
if(n/=1) stop 27
if(int(k, kind=c_size_t)/=e) stop 28
if(t/=CFI_type_char) stop 29
if(any(a/=ref_c_char_l1)) stop 30
call check_tk_as(a, t, k, e, n)
if(any(a/=ref_c_char_l1)) stop 31
return
end subroutine f_check_c_char_c1_as
subroutine c_check_c_char_c1_as(a) bind(c)
character(kind=c_char, len=1), intent(in) :: a(:)
!
integer(kind=c_int16_t) :: t
integer(kind=c_signed_char) :: k
integer(kind=c_size_t) :: e, n
!
k = kind(a)
n = len(a, kind=kind(e))
e = storage_size(a, kind=kind(e))/(b*1)
t = cfi_encode_type(CFI_type_Character, k)
if(k<=0_c_signed_char) stop 32
if(k/=1_c_signed_char) stop 33
if(n/=1) stop 34
if(int(k, kind=c_size_t)/=e) stop 35
if(t/=CFI_type_char) stop 36
if(any(a/=ref_c_char_l1)) stop 37
call check_tk_as(a, t, k, e, n)
if(any(a/=ref_c_char_l1)) stop 38
return
end subroutine c_check_c_char_c1_as
subroutine f_check_c_char_c1_ar(a)
character(kind=c_char, len=1), intent(in) :: a(..)
!
integer(kind=c_int16_t) :: t
integer(kind=c_signed_char) :: k
integer(kind=c_size_t) :: e, n
!
k = kind(a)
n = len(a, kind=kind(e))
e = storage_size(a, kind=kind(e))/(b*1)
t = cfi_encode_type(CFI_type_Character, k)
if(k<=0_c_signed_char) stop 39
if(k/=1_c_signed_char) stop 40
if(n/=1) stop 41
if(int(k, kind=c_size_t)/=e) stop 42
if(t/=CFI_type_char) stop 43
select rank(a)
rank(1)
if(any(a/=ref_c_char_l1)) stop 44
rank default
stop 45
end select
call check_tk_ar(a, t, k, e, n)
select rank(a)
rank(1)
if(any(a/=ref_c_char_l1)) stop 46
rank default
stop 47
end select
return
end subroutine f_check_c_char_c1_ar
subroutine c_check_c_char_c1_ar(a) bind(c)
character(kind=c_char, len=1), intent(in) :: a(..)
!
integer(kind=c_int16_t) :: t
integer(kind=c_signed_char) :: k
integer(kind=c_size_t) :: e, n
!
k = kind(a)
n = len(a, kind=kind(e))
e = storage_size(a, kind=kind(e))/(b*1)
t = cfi_encode_type(CFI_type_Character, k)
if(k<=0_c_signed_char) stop 48
if(k/=1_c_signed_char) stop 49
if(n/=1) stop 50
if(int(k, kind=c_size_t)/=e) stop 51
if(t/=CFI_type_char) stop 52
select rank(a)
rank(1)
if(any(a/=ref_c_char_l1)) stop 53
rank default
stop 54
end select
call check_tk_ar(a, t, k, e, n)
select rank(a)
rank(1)
if(any(a/=ref_c_char_l1)) stop 55
rank default
stop 56
end select
return
end subroutine c_check_c_char_c1_ar
subroutine f_check_c_char_a1_as(a)
character(kind=c_char, len=*), intent(in) :: a(:)
!
integer(kind=c_int16_t) :: t
integer(kind=c_signed_char) :: k
integer(kind=c_size_t) :: e, n
!
k = kind(a)
n = len(a, kind=kind(e))
e = storage_size(a, kind=kind(e))/(b*1)
t = cfi_encode_type(CFI_type_Character, k)
if(k<=0_c_signed_char) stop 57
if(k/=1_c_signed_char) stop 58
if(n/=1) stop 59
if(int(k, kind=c_size_t)/=e) stop 60
if(t/=CFI_type_char) stop 61
if(any(a/=ref_c_char_l1)) stop 62
call check_tk_as(a, t, k, e, n)
if(any(a/=ref_c_char_l1)) stop 63
return
end subroutine f_check_c_char_a1_as
subroutine c_check_c_char_a1_as(a) bind(c)
character(kind=c_char, len=*), intent(in) :: a(:)
!
integer(kind=c_int16_t) :: t
integer(kind=c_signed_char) :: k
integer(kind=c_size_t) :: e, n
!
k = kind(a)
n = len(a, kind=kind(e))
e = storage_size(a, kind=kind(e))/(b*1)
t = cfi_encode_type(CFI_type_Character, k)
if(k<=0_c_signed_char) stop 64
if(k/=1_c_signed_char) stop 65
if(n/=1) stop 66
if(int(k, kind=c_size_t)/=e) stop 67
if(t/=CFI_type_char) stop 68
if(any(a/=ref_c_char_l1)) stop 69
call check_tk_as(a, t, k, e, n)
if(any(a/=ref_c_char_l1)) stop 70
return
end subroutine c_check_c_char_a1_as
subroutine f_check_c_char_a1_ar(a)
character(kind=c_char, len=*), intent(in) :: a(..)
!
integer(kind=c_int16_t) :: t
integer(kind=c_signed_char) :: k
integer(kind=c_size_t) :: e, n
!
k = kind(a)
n = len(a, kind=kind(e))
e = storage_size(a, kind=kind(e))/(b*1)
t = cfi_encode_type(CFI_type_Character, k)
if(k<=0_c_signed_char) stop 71
if(k/=1_c_signed_char) stop 72
if(n/=1) stop 73
if(int(k, kind=c_size_t)/=e) stop 74
if(t/=CFI_type_char) stop 75
select rank(a)
rank(1)
if(any(a/=ref_c_char_l1)) stop 76
rank default
stop 77
end select
call check_tk_ar(a, t, k, e, n)
select rank(a)
rank(1)
if(any(a/=ref_c_char_l1)) stop 78
rank default
stop 79
end select
return
end subroutine f_check_c_char_a1_ar
subroutine c_check_c_char_a1_ar(a) bind(c)
character(kind=c_char, len=*), intent(in) :: a(..)
!
integer(kind=c_int16_t) :: t
integer(kind=c_signed_char) :: k
integer(kind=c_size_t) :: e, n
!
k = kind(a)
n = len(a, kind=kind(e))
e = storage_size(a, kind=kind(e))/(b*1)
t = cfi_encode_type(CFI_type_Character, k)
if(k<=0_c_signed_char) stop 80
if(k/=1_c_signed_char) stop 81
if(n/=1) stop 82
if(int(k, kind=c_size_t)/=e) stop 83
if(t/=CFI_type_char) stop 84
select rank(a)
rank(1)
if(any(a/=ref_c_char_l1)) stop 85
rank default
stop 86
end select
call check_tk_ar(a, t, k, e, n)
select rank(a)
rank(1)
if(any(a/=ref_c_char_l1)) stop 87
rank default
stop 88
end select
return
end subroutine c_check_c_char_a1_ar
subroutine f_check_c_char_d1_as(a)
character(kind=c_char, len=:), pointer, intent(in) :: a(:)
!
integer(kind=c_int16_t) :: t
integer(kind=c_signed_char) :: k
integer(kind=c_size_t) :: e, n
!
k = kind(a)
n = len(a, kind=kind(e))
e = storage_size(a, kind=kind(e))/(b*1)
t = cfi_encode_type(CFI_type_Character, k)
if(k<=0_c_signed_char) stop 89
if(k/=1_c_signed_char) stop 90
if(n/=1) stop 91
if(int(k, kind=c_size_t)/=e) stop 92
if(t/=CFI_type_char) stop 93
if(any(a/=ref_c_char_l1)) stop 94
call check_tk_as(a, t, k, e, n)
if(any(a/=ref_c_char_l1)) stop 95
return
end subroutine f_check_c_char_d1_as
subroutine c_check_c_char_d1_as(a) bind(c)
character(kind=c_char, len=:), pointer, intent(in) :: a(:)
!
integer(kind=c_int16_t) :: t
integer(kind=c_signed_char) :: k
integer(kind=c_size_t) :: e, n
!
k = kind(a)
n = len(a, kind=kind(e))
e = storage_size(a, kind=kind(e))/(b*1)
t = cfi_encode_type(CFI_type_Character, k)
if(k<=0_c_signed_char) stop 96
if(k/=1_c_signed_char) stop 97
if(n/=1) stop 98
if(int(k, kind=c_size_t)/=e) stop 99
if(t/=CFI_type_char) stop 100
if(any(a/=ref_c_char_l1)) stop 101
call check_tk_as(a, t, k, e, n)
if(any(a/=ref_c_char_l1)) stop 102
return
end subroutine c_check_c_char_d1_as
subroutine f_check_c_char_d1_ar(a)
character(kind=c_char, len=:), pointer, intent(in) :: a(..)
!
integer(kind=c_int16_t) :: t
integer(kind=c_signed_char) :: k
integer(kind=c_size_t) :: e, n
!
k = kind(a)
n = len(a, kind=kind(e))
e = storage_size(a, kind=kind(e))/(b*1)
t = cfi_encode_type(CFI_type_Character, k)
if(k<=0_c_signed_char) stop 103
if(k/=1_c_signed_char) stop 104
if(n/=1) stop 105
if(int(k, kind=c_size_t)/=e) stop 106
if(t/=CFI_type_char) stop 107
select rank(a)
rank(1)
if(any(a/=ref_c_char_l1)) stop 108
rank default
stop 109
end select
call check_tk_ar(a, t, k, e, n)
select rank(a)
rank(1)
if(any(a/=ref_c_char_l1)) stop 110
rank default
stop 111
end select
return
end subroutine f_check_c_char_d1_ar
subroutine c_check_c_char_d1_ar(a) bind(c)
character(kind=c_char, len=:), pointer, intent(in) :: a(..)
!
integer(kind=c_int16_t) :: t
integer(kind=c_signed_char) :: k
integer(kind=c_size_t) :: e, n
!
k = kind(a)
n = len(a, kind=kind(e))
e = storage_size(a, kind=kind(e))/(b*1)
t = cfi_encode_type(CFI_type_Character, k)
if(k<=0_c_signed_char) stop 112
if(k/=1_c_signed_char) stop 113
if(n/=1) stop 114
if(int(k, kind=c_size_t)/=e) stop 115
if(t/=CFI_type_char) stop 116
select rank(a)
rank(1)
if(any(a/=ref_c_char_l1)) stop 117
rank default
stop 118
end select
call check_tk_ar(a, t, k, e, n)
select rank(a)
rank(1)
if(any(a/=ref_c_char_l1)) stop 119
rank default
stop 120
end select
return
end subroutine c_check_c_char_d1_ar
subroutine check_c_char_lm()
character(kind=c_char, len=m), target :: a(n)
!
character(kind=c_char, len=:), pointer :: p(:)
!
a = ref_c_char_lm
call f_check_c_char_cm_as(a)
if(any(a/=ref_c_char_lm)) stop 121
a = ref_c_char_lm
call c_check_c_char_cm_as(a)
if(any(a/=ref_c_char_lm)) stop 122
a = ref_c_char_lm
call f_check_c_char_cm_ar(a)
if(any(a/=ref_c_char_lm)) stop 123
a = ref_c_char_lm
call c_check_c_char_cm_ar(a)
if(any(a/=ref_c_char_lm)) stop 124
a = ref_c_char_lm
call f_check_c_char_am_as(a)
if(any(a/=ref_c_char_lm)) stop 125
a = ref_c_char_lm
call c_check_c_char_am_as(a)
if(any(a/=ref_c_char_lm)) stop 126
a = ref_c_char_lm
call f_check_c_char_am_ar(a)
if(any(a/=ref_c_char_lm)) stop 127
a = ref_c_char_lm
call c_check_c_char_am_ar(a)
if(any(a/=ref_c_char_lm)) stop 128
a = ref_c_char_lm
p => a
call f_check_c_char_dm_as(p)
if(.not.associated(p)) stop 129
if(.not.associated(p, a)) stop 130
if(any(p/=ref_c_char_lm)) stop 131
if(any(a/=ref_c_char_lm)) stop 132
a = ref_c_char_lm
p => a
call c_check_c_char_dm_as(p)
if(.not.associated(p)) stop 133
if(.not.associated(p, a)) stop 134
if(any(p/=ref_c_char_lm)) stop 135
if(any(a/=ref_c_char_lm)) stop 136
a = ref_c_char_lm
p => a
call f_check_c_char_dm_ar(p)
if(.not.associated(p)) stop 137
if(.not.associated(p, a)) stop 138
if(any(p/=ref_c_char_lm)) stop 139
if(any(a/=ref_c_char_lm)) stop 140
a = ref_c_char_lm
p => a
call c_check_c_char_dm_ar(p)
if(.not.associated(p)) stop 141
if(.not.associated(p, a)) stop 142
if(any(p/=ref_c_char_lm)) stop 143
if(any(a/=ref_c_char_lm)) stop 144
return
end subroutine check_c_char_lm
subroutine f_check_c_char_cm_as(a)
character(kind=c_char, len=m), intent(in) :: a(:)
!
integer(kind=c_int16_t) :: t
integer(kind=c_signed_char) :: k
integer(kind=c_size_t) :: e, n
!
k = kind(a)
n = len(a, kind=kind(e))
e = storage_size(a, kind=kind(e))/(b*m)
t = cfi_encode_type(CFI_type_Character, k)
if(k<=0_c_signed_char) stop 145
if(k/=1_c_signed_char) stop 146
if(n/=m) stop 147
if(int(k, kind=c_size_t)/=e) stop 148
if(t/=CFI_type_char) stop 149
if(any(a/=ref_c_char_lm)) stop 150
call check_tk_as(a, t, k, e, n)
if(any(a/=ref_c_char_lm)) stop 151
return
end subroutine f_check_c_char_cm_as
subroutine c_check_c_char_cm_as(a) bind(c)
character(kind=c_char, len=m), intent(in) :: a(:)
!
integer(kind=c_int16_t) :: t
integer(kind=c_signed_char) :: k
integer(kind=c_size_t) :: e, n
!
k = kind(a)
n = len(a, kind=kind(e))
e = storage_size(a, kind=kind(e))/(b*m)
t = cfi_encode_type(CFI_type_Character, k)
if(k<=0_c_signed_char) stop 152
if(k/=1_c_signed_char) stop 153
if(n/=m) stop 154
if(int(k, kind=c_size_t)/=e) stop 155
if(t/=CFI_type_char) stop 156
if(any(a/=ref_c_char_lm)) stop 157
call check_tk_as(a, t, k, e, n)
if(any(a/=ref_c_char_lm)) stop 158
return
end subroutine c_check_c_char_cm_as
subroutine f_check_c_char_cm_ar(a)
character(kind=c_char, len=m), intent(in) :: a(..)
!
integer(kind=c_int16_t) :: t
integer(kind=c_signed_char) :: k
integer(kind=c_size_t) :: e, n
!
k = kind(a)
n = len(a, kind=kind(e))
e = storage_size(a, kind=kind(e))/(b*m)
t = cfi_encode_type(CFI_type_Character, k)
if(k<=0_c_signed_char) stop 159
if(k/=1_c_signed_char) stop 160
if(n/=m) stop 161
if(int(k, kind=c_size_t)/=e) stop 162
if(t/=CFI_type_char) stop 163
select rank(a)
rank(1)
if(any(a/=ref_c_char_lm)) stop 164
rank default
stop 165
end select
call check_tk_ar(a, t, k, e, n)
select rank(a)
rank(1)
if(any(a/=ref_c_char_lm)) stop 166
rank default
stop 167
end select
return
end subroutine f_check_c_char_cm_ar
subroutine c_check_c_char_cm_ar(a) bind(c)
character(kind=c_char, len=m), intent(in) :: a(..)
!
integer(kind=c_int16_t) :: t
integer(kind=c_signed_char) :: k
integer(kind=c_size_t) :: e, n
!
k = kind(a)
n = len(a, kind=kind(e))
e = storage_size(a, kind=kind(e))/(b*m)
t = cfi_encode_type(CFI_type_Character, k)
if(k<=0_c_signed_char) stop 168
if(k/=1_c_signed_char) stop 169
if(n/=m) stop 170
if(int(k, kind=c_size_t)/=e) stop 171
if(t/=CFI_type_char) stop 172
select rank(a)
rank(1)
if(any(a/=ref_c_char_lm)) stop 173
rank default
stop 174
end select
call check_tk_ar(a, t, k, e, n)
select rank(a)
rank(1)
if(any(a/=ref_c_char_lm)) stop 175
rank default
stop 176
end select
return
end subroutine c_check_c_char_cm_ar
subroutine f_check_c_char_am_as(a)
character(kind=c_char, len=*), intent(in) :: a(:)
!
integer(kind=c_int16_t) :: t
integer(kind=c_signed_char) :: k
integer(kind=c_size_t) :: e, n
!
k = kind(a)
n = len(a, kind=kind(e))
e = storage_size(a, kind=kind(e))/(b*m)
t = cfi_encode_type(CFI_type_Character, k)
if(k<=0_c_signed_char) stop 177
if(k/=1_c_signed_char) stop 178
if(n/=m) stop 179
if(int(k, kind=c_size_t)/=e) stop 180
if(t/=CFI_type_char) stop 181
if(any(a/=ref_c_char_lm)) stop 182
call check_tk_as(a, t, k, e, n)
if(any(a/=ref_c_char_lm)) stop 183
return
end subroutine f_check_c_char_am_as
subroutine c_check_c_char_am_as(a) bind(c)
character(kind=c_char, len=*), intent(in) :: a(:)
!
integer(kind=c_int16_t) :: t
integer(kind=c_signed_char) :: k
integer(kind=c_size_t) :: e, n
!
k = kind(a)
n = len(a, kind=kind(e))
e = storage_size(a, kind=kind(e))/(b*m)
t = cfi_encode_type(CFI_type_Character, k)
if(k<=0_c_signed_char) stop 184
if(k/=1_c_signed_char) stop 185
if(n/=m) stop 186
if(int(k, kind=c_size_t)/=e) stop 187
if(t/=CFI_type_char) stop 188
if(any(a/=ref_c_char_lm)) stop 189
call check_tk_as(a, t, k, e, n)
if(any(a/=ref_c_char_lm)) stop 190
return
end subroutine c_check_c_char_am_as
subroutine f_check_c_char_am_ar(a)
character(kind=c_char, len=*), intent(in) :: a(..)
!
integer(kind=c_int16_t) :: t
integer(kind=c_signed_char) :: k
integer(kind=c_size_t) :: e, n
!
k = kind(a)
n = len(a, kind=kind(e))
e = storage_size(a, kind=kind(e))/(b*m)
t = cfi_encode_type(CFI_type_Character, k)
if(k<=0_c_signed_char) stop 191
if(k/=1_c_signed_char) stop 192
if(n/=m) stop 193
if(int(k, kind=c_size_t)/=e) stop 194
if(t/=CFI_type_char) stop 195
select rank(a)
rank(1)
if(any(a/=ref_c_char_lm)) stop 196
rank default
stop 197
end select
call check_tk_ar(a, t, k, e, n)
select rank(a)
rank(1)
if(any(a/=ref_c_char_lm)) stop 198
rank default
stop 199
end select
return
end subroutine f_check_c_char_am_ar
subroutine c_check_c_char_am_ar(a) bind(c)
character(kind=c_char, len=*), intent(in) :: a(..)
!
integer(kind=c_int16_t) :: t
integer(kind=c_signed_char) :: k
integer(kind=c_size_t) :: e, n
!
k = kind(a)
n = len(a, kind=kind(e))
e = storage_size(a, kind=kind(e))/(b*m)
t = cfi_encode_type(CFI_type_Character, k)
if(k<=0_c_signed_char) stop 200
if(k/=1_c_signed_char) stop 201
if(n/=m) stop 202
if(int(k, kind=c_size_t)/=e) stop 203
if(t/=CFI_type_char) stop 204
select rank(a)
rank(1)
if(any(a/=ref_c_char_lm)) stop 205
rank default
stop 206
end select
call check_tk_ar(a, t, k, e, n)
select rank(a)
rank(1)
if(any(a/=ref_c_char_lm)) stop 207
rank default
stop 208
end select
return
end subroutine c_check_c_char_am_ar
subroutine f_check_c_char_dm_as(a)
character(kind=c_char, len=:), pointer, intent(in) :: a(:)
!
integer(kind=c_int16_t) :: t
integer(kind=c_signed_char) :: k
integer(kind=c_size_t) :: e, n
!
k = kind(a)
n = len(a, kind=kind(e))
e = storage_size(a, kind=kind(e))/(b*m)
t = cfi_encode_type(CFI_type_Character, k)
if(k<=0_c_signed_char) stop 209
if(k/=1_c_signed_char) stop 210
if(n/=m) stop 211
if(int(k, kind=c_size_t)/=e) stop 212
if(t/=CFI_type_char) stop 213
if(any(a/=ref_c_char_lm)) stop 214
call check_tk_as(a, t, k, e, n)
if(any(a/=ref_c_char_lm)) stop 215
return
end subroutine f_check_c_char_dm_as
subroutine c_check_c_char_dm_as(a) bind(c)
character(kind=c_char, len=:), pointer, intent(in) :: a(:)
!
integer(kind=c_int16_t) :: t
integer(kind=c_signed_char) :: k
integer(kind=c_size_t) :: e, n
!
k = kind(a)
n = len(a, kind=kind(e))
e = storage_size(a, kind=kind(e))/(b*m)
t = cfi_encode_type(CFI_type_Character, k)
if(k<=0_c_signed_char) stop 216
if(k/=1_c_signed_char) stop 217
if(n/=m) stop 218
if(int(k, kind=c_size_t)/=e) stop 219
if(t/=CFI_type_char) stop 220
if(any(a/=ref_c_char_lm)) stop 221
call check_tk_as(a, t, k, e, n)
if(any(a/=ref_c_char_lm)) stop 222
return
end subroutine c_check_c_char_dm_as
subroutine f_check_c_char_dm_ar(a)
character(kind=c_char, len=:), pointer, intent(in) :: a(..)
!
integer(kind=c_int16_t) :: t
integer(kind=c_signed_char) :: k
integer(kind=c_size_t) :: e, n
!
k = kind(a)
n = len(a, kind=kind(e))
e = storage_size(a, kind=kind(e))/(b*m)
t = cfi_encode_type(CFI_type_Character, k)
if(k<=0_c_signed_char) stop 223
if(k/=1_c_signed_char) stop 224
if(n/=m) stop 225
if(int(k, kind=c_size_t)/=e) stop 226
if(t/=CFI_type_char) stop 227
select rank(a)
rank(1)
if(any(a/=ref_c_char_lm)) stop 228
rank default
stop 229
end select
call check_tk_ar(a, t, k, e, n)
select rank(a)
rank(1)
if(any(a/=ref_c_char_lm)) stop 230
rank default
stop 231
end select
return
end subroutine f_check_c_char_dm_ar
subroutine c_check_c_char_dm_ar(a) bind(c)
character(kind=c_char, len=:), pointer, intent(in) :: a(..)
!
integer(kind=c_int16_t) :: t
integer(kind=c_signed_char) :: k
integer(kind=c_size_t) :: e, n
!
k = kind(a)
n = len(a, kind=kind(e))
e = storage_size(a, kind=kind(e))/(b*m)
t = cfi_encode_type(CFI_type_Character, k)
if(k<=0_c_signed_char) stop 232
if(k/=1_c_signed_char) stop 233
if(n/=m) stop 234
if(int(k, kind=c_size_t)/=e) stop 235
if(t/=CFI_type_char) stop 236
select rank(a)
rank(1)
if(any(a/=ref_c_char_lm)) stop 237
rank default
stop 238
end select
call check_tk_ar(a, t, k, e, n)
select rank(a)
rank(1)
if(any(a/=ref_c_char_lm)) stop 239
rank default
stop 240
end select
return
end subroutine c_check_c_char_dm_ar
subroutine check_c_ucs4_char_l1()
character(kind=c_ucs4_char, len=1), target :: a(n)
!
character(kind=c_ucs4_char, len=:), pointer :: p(:)
!
a = ref_c_ucs4_char_l1
call f_check_c_ucs4_char_c1_as(a)
if(any(a/=ref_c_ucs4_char_l1)) stop 241
a = ref_c_ucs4_char_l1
call c_check_c_ucs4_char_c1_as(a)
if(any(a/=ref_c_ucs4_char_l1)) stop 242
a = ref_c_ucs4_char_l1
call f_check_c_ucs4_char_c1_ar(a)
if(any(a/=ref_c_ucs4_char_l1)) stop 243
a = ref_c_ucs4_char_l1
call c_check_c_ucs4_char_c1_ar(a)
if(any(a/=ref_c_ucs4_char_l1)) stop 244
a = ref_c_ucs4_char_l1
call f_check_c_ucs4_char_a1_as(a)
if(any(a/=ref_c_ucs4_char_l1)) stop 245
a = ref_c_ucs4_char_l1
call c_check_c_ucs4_char_a1_as(a)
if(any(a/=ref_c_ucs4_char_l1)) stop 246
a = ref_c_ucs4_char_l1
call f_check_c_ucs4_char_a1_ar(a)
if(any(a/=ref_c_ucs4_char_l1)) stop 247
a = ref_c_ucs4_char_l1
call c_check_c_ucs4_char_a1_ar(a)
if(any(a/=ref_c_ucs4_char_l1)) stop 248
a = ref_c_ucs4_char_l1
p => a
call f_check_c_ucs4_char_d1_as(p)
if(.not.associated(p)) stop 249
if(.not.associated(p, a)) stop 250
if(any(p/=ref_c_ucs4_char_l1)) stop 251
if(any(a/=ref_c_ucs4_char_l1)) stop 252
a = ref_c_ucs4_char_l1
p => a
call c_check_c_ucs4_char_d1_as(p)
if(.not.associated(p)) stop 253
if(.not.associated(p, a)) stop 254
if(any(p/=ref_c_ucs4_char_l1)) stop 255
if(any(a/=ref_c_ucs4_char_l1)) stop 256
a = ref_c_ucs4_char_l1
p => a
call f_check_c_ucs4_char_d1_ar(p)
if(.not.associated(p)) stop 257
if(.not.associated(p, a)) stop 258
if(any(p/=ref_c_ucs4_char_l1)) stop 259
if(any(a/=ref_c_ucs4_char_l1)) stop 260
a = ref_c_ucs4_char_l1
p => a
call c_check_c_ucs4_char_d1_ar(p)
if(.not.associated(p)) stop 261
if(.not.associated(p, a)) stop 262
if(any(p/=ref_c_ucs4_char_l1)) stop 263
if(any(a/=ref_c_ucs4_char_l1)) stop 264
return
end subroutine check_c_ucs4_char_l1
subroutine f_check_c_ucs4_char_c1_as(a)
character(kind=c_ucs4_char, len=1), intent(in) :: a(:)
!
integer(kind=c_int16_t) :: t
integer(kind=c_signed_char) :: k
integer(kind=c_size_t) :: e, n
!
k = kind(a)
n = len(a, kind=kind(e))
e = storage_size(a, kind=kind(e))/(b*1)
t = cfi_encode_type(CFI_type_Character, k)
if(k<=0_c_signed_char) stop 265
if(k/=4_c_signed_char) stop 266
if(n/=1) stop 267
if(int(k, kind=c_size_t)/=e) stop 268
if(t/=CFI_type_ucs4_char) stop 269
if(any(a/=ref_c_ucs4_char_l1)) stop 270
call check_tk_as(a, t, k, e, n)
if(any(a/=ref_c_ucs4_char_l1)) stop 271
return
end subroutine f_check_c_ucs4_char_c1_as
subroutine c_check_c_ucs4_char_c1_as(a) bind(c)
character(kind=c_ucs4_char, len=1), intent(in) :: a(:)
!
integer(kind=c_int16_t) :: t
integer(kind=c_signed_char) :: k
integer(kind=c_size_t) :: e, n
!
k = kind(a)
n = len(a, kind=kind(e))
e = storage_size(a, kind=kind(e))/(b*1)
t = cfi_encode_type(CFI_type_Character, k)
if(k<=0_c_signed_char) stop 272
if(k/=4_c_signed_char) stop 273
if(n/=1) stop 274
if(int(k, kind=c_size_t)/=e) stop 275
if(t/=CFI_type_ucs4_char) stop 276
if(any(a/=ref_c_ucs4_char_l1)) stop 277
call check_tk_as(a, t, k, e, n)
if(any(a/=ref_c_ucs4_char_l1)) stop 278
return
end subroutine c_check_c_ucs4_char_c1_as
subroutine f_check_c_ucs4_char_c1_ar(a)
character(kind=c_ucs4_char, len=1), intent(in) :: a(..)
!
integer(kind=c_int16_t) :: t
integer(kind=c_signed_char) :: k
integer(kind=c_size_t) :: e, n
!
k = kind(a)
n = len(a, kind=kind(e))
e = storage_size(a, kind=kind(e))/(b*1)
t = cfi_encode_type(CFI_type_Character, k)
if(k<=0_c_signed_char) stop 279
if(k/=4_c_signed_char) stop 280
if(n/=1) stop 281
if(int(k, kind=c_size_t)/=e) stop 282
if(t/=CFI_type_ucs4_char) stop 283
select rank(a)
rank(1)
if(any(a/=ref_c_ucs4_char_l1)) stop 284
rank default
stop 285
end select
call check_tk_ar(a, t, k, e, n)
select rank(a)
rank(1)
if(any(a/=ref_c_ucs4_char_l1)) stop 286
rank default
stop 287
end select
return
end subroutine f_check_c_ucs4_char_c1_ar
subroutine c_check_c_ucs4_char_c1_ar(a) bind(c)
character(kind=c_ucs4_char, len=1), intent(in) :: a(..)
!
integer(kind=c_int16_t) :: t
integer(kind=c_signed_char) :: k
integer(kind=c_size_t) :: e, n
!
k = kind(a)
n = len(a, kind=kind(e))
e = storage_size(a, kind=kind(e))/(b*1)
t = cfi_encode_type(CFI_type_Character, k)
if(k<=0_c_signed_char) stop 288
if(k/=4_c_signed_char) stop 289
if(n/=1) stop 290
if(int(k, kind=c_size_t)/=e) stop 291
if(t/=CFI_type_ucs4_char) stop 292
select rank(a)
rank(1)
if(any(a/=ref_c_ucs4_char_l1)) stop 293
rank default
stop 294
end select
call check_tk_ar(a, t, k, e, n)
select rank(a)
rank(1)
if(any(a/=ref_c_ucs4_char_l1)) stop 295
rank default
stop 296
end select
return
end subroutine c_check_c_ucs4_char_c1_ar
subroutine f_check_c_ucs4_char_a1_as(a)
character(kind=c_ucs4_char, len=*), intent(in) :: a(:)
!
integer(kind=c_int16_t) :: t
integer(kind=c_signed_char) :: k
integer(kind=c_size_t) :: e, n
!
k = kind(a)
n = len(a, kind=kind(e))
e = storage_size(a, kind=kind(e))/(b*1)
t = cfi_encode_type(CFI_type_Character, k)
if(k<=0_c_signed_char) stop 297
if(k/=4_c_signed_char) stop 298
if(n/=1) stop 299
if(int(k, kind=c_size_t)/=e) stop 300
if(t/=CFI_type_ucs4_char) stop 301
if(any(a/=ref_c_ucs4_char_l1)) stop 302
call check_tk_as(a, t, k, e, n)
if(any(a/=ref_c_ucs4_char_l1)) stop 303
return
end subroutine f_check_c_ucs4_char_a1_as
subroutine c_check_c_ucs4_char_a1_as(a) bind(c)
character(kind=c_ucs4_char, len=*), intent(in) :: a(:)
!
integer(kind=c_int16_t) :: t
integer(kind=c_signed_char) :: k
integer(kind=c_size_t) :: e, n
!
k = kind(a)
n = len(a, kind=kind(e))
e = storage_size(a, kind=kind(e))/(b*1)
t = cfi_encode_type(CFI_type_Character, k)
if(k<=0_c_signed_char) stop 304
if(k/=4_c_signed_char) stop 305
if(n/=1) stop 306
if(int(k, kind=c_size_t)/=e) stop 307
if(t/=CFI_type_ucs4_char) stop 308
if(any(a/=ref_c_ucs4_char_l1)) stop 309
call check_tk_as(a, t, k, e, n)
if(any(a/=ref_c_ucs4_char_l1)) stop 310
return
end subroutine c_check_c_ucs4_char_a1_as
subroutine f_check_c_ucs4_char_a1_ar(a)
character(kind=c_ucs4_char, len=*), intent(in) :: a(..)
!
integer(kind=c_int16_t) :: t
integer(kind=c_signed_char) :: k
integer(kind=c_size_t) :: e, n
!
k = kind(a)
n = len(a, kind=kind(e))
e = storage_size(a, kind=kind(e))/(b*1)
t = cfi_encode_type(CFI_type_Character, k)
if(k<=0_c_signed_char) stop 311
if(k/=4_c_signed_char) stop 312
if(n/=1) stop 313
if(int(k, kind=c_size_t)/=e) stop 314
if(t/=CFI_type_ucs4_char) stop 315
select rank(a)
rank(1)
if(any(a/=ref_c_ucs4_char_l1)) stop 316
rank default
stop 317
end select
call check_tk_ar(a, t, k, e, n)
select rank(a)
rank(1)
if(any(a/=ref_c_ucs4_char_l1)) stop 318
rank default
stop 319
end select
return
end subroutine f_check_c_ucs4_char_a1_ar
subroutine c_check_c_ucs4_char_a1_ar(a) bind(c)
character(kind=c_ucs4_char, len=*), intent(in) :: a(..)
!
integer(kind=c_int16_t) :: t
integer(kind=c_signed_char) :: k
integer(kind=c_size_t) :: e, n
!
k = kind(a)
n = len(a, kind=kind(e))
e = storage_size(a, kind=kind(e))/(b*1)
t = cfi_encode_type(CFI_type_Character, k)
if(k<=0_c_signed_char) stop 320
if(k/=4_c_signed_char) stop 321
if(n/=1) stop 322
if(int(k, kind=c_size_t)/=e) stop 323
if(t/=CFI_type_ucs4_char) stop 324
select rank(a)
rank(1)
if(any(a/=ref_c_ucs4_char_l1)) stop 325
rank default
stop 326
end select
call check_tk_ar(a, t, k, e, n)
select rank(a)
rank(1)
if(any(a/=ref_c_ucs4_char_l1)) stop 327
rank default
stop 328
end select
return
end subroutine c_check_c_ucs4_char_a1_ar
subroutine f_check_c_ucs4_char_d1_as(a)
character(kind=c_ucs4_char, len=:), pointer, intent(in) :: a(:)
!
integer(kind=c_int16_t) :: t
integer(kind=c_signed_char) :: k
integer(kind=c_size_t) :: e, n
!
k = kind(a)
n = len(a, kind=kind(e))
e = storage_size(a, kind=kind(e))/(b*1)
t = cfi_encode_type(CFI_type_Character, k)
if(k<=0_c_signed_char) stop 329
if(k/=4_c_signed_char) stop 330
if(n/=1) stop 331
if(int(k, kind=c_size_t)/=e) stop 332
if(t/=CFI_type_ucs4_char) stop 333
if(any(a/=ref_c_ucs4_char_l1)) stop 334
call check_tk_as(a, t, k, e, n)
if(any(a/=ref_c_ucs4_char_l1)) stop 335
return
end subroutine f_check_c_ucs4_char_d1_as
subroutine c_check_c_ucs4_char_d1_as(a) bind(c)
character(kind=c_ucs4_char, len=:), pointer, intent(in) :: a(:)
!
integer(kind=c_int16_t) :: t
integer(kind=c_signed_char) :: k
integer(kind=c_size_t) :: e, n
!
k = kind(a)
n = len(a, kind=kind(e))
e = storage_size(a, kind=kind(e))/(b*1)
t = cfi_encode_type(CFI_type_Character, k)
if(k<=0_c_signed_char) stop 336
if(k/=4_c_signed_char) stop 337
if(n/=1) stop 338
if(int(k, kind=c_size_t)/=e) stop 339
if(t/=CFI_type_ucs4_char) stop 340
if(any(a/=ref_c_ucs4_char_l1)) stop 341
call check_tk_as(a, t, k, e, n)
if(any(a/=ref_c_ucs4_char_l1)) stop 342
return
end subroutine c_check_c_ucs4_char_d1_as
subroutine f_check_c_ucs4_char_d1_ar(a)
character(kind=c_ucs4_char, len=:), pointer, intent(in) :: a(..)
!
integer(kind=c_int16_t) :: t
integer(kind=c_signed_char) :: k
integer(kind=c_size_t) :: e, n
!
k = kind(a)
n = len(a, kind=kind(e))
e = storage_size(a, kind=kind(e))/(b*1)
t = cfi_encode_type(CFI_type_Character, k)
if(k<=0_c_signed_char) stop 343
if(k/=4_c_signed_char) stop 344
if(n/=1) stop 345
if(int(k, kind=c_size_t)/=e) stop 346
if(t/=CFI_type_ucs4_char) stop 347
select rank(a)
rank(1)
if(any(a/=ref_c_ucs4_char_l1)) stop 348
rank default
stop 349
end select
call check_tk_ar(a, t, k, e, n)
select rank(a)
rank(1)
if(any(a/=ref_c_ucs4_char_l1)) stop 350
rank default
stop 351
end select
return
end subroutine f_check_c_ucs4_char_d1_ar
subroutine c_check_c_ucs4_char_d1_ar(a) bind(c)
character(kind=c_ucs4_char, len=:), pointer, intent(in) :: a(..)
!
integer(kind=c_int16_t) :: t
integer(kind=c_signed_char) :: k
integer(kind=c_size_t) :: e, n
!
k = kind(a)
n = len(a, kind=kind(e))
e = storage_size(a, kind=kind(e))/(b*1)
t = cfi_encode_type(CFI_type_Character, k)
if(k<=0_c_signed_char) stop 352
if(k/=4_c_signed_char) stop 353
if(n/=1) stop 354
if(int(k, kind=c_size_t)/=e) stop 355
if(t/=CFI_type_ucs4_char) stop 356
select rank(a)
rank(1)
if(any(a/=ref_c_ucs4_char_l1)) stop 357
rank default
stop 358
end select
call check_tk_ar(a, t, k, e, n)
select rank(a)
rank(1)
if(any(a/=ref_c_ucs4_char_l1)) stop 359
rank default
stop 360
end select
return
end subroutine c_check_c_ucs4_char_d1_ar
subroutine check_c_ucs4_char_lm()
character(kind=c_ucs4_char, len=m), target :: a(n)
!
character(kind=c_ucs4_char, len=:), pointer :: p(:)
!
a = ref_c_ucs4_char_lm
call f_check_c_ucs4_char_cm_as(a)
if(any(a/=ref_c_ucs4_char_lm)) stop 361
a = ref_c_ucs4_char_lm
call c_check_c_ucs4_char_cm_as(a)
if(any(a/=ref_c_ucs4_char_lm)) stop 362
a = ref_c_ucs4_char_lm
call f_check_c_ucs4_char_cm_ar(a)
if(any(a/=ref_c_ucs4_char_lm)) stop 363
a = ref_c_ucs4_char_lm
call c_check_c_ucs4_char_cm_ar(a)
if(any(a/=ref_c_ucs4_char_lm)) stop 364
a = ref_c_ucs4_char_lm
call f_check_c_ucs4_char_am_as(a)
if(any(a/=ref_c_ucs4_char_lm)) stop 365
a = ref_c_ucs4_char_lm
call c_check_c_ucs4_char_am_as(a)
if(any(a/=ref_c_ucs4_char_lm)) stop 366
a = ref_c_ucs4_char_lm
call f_check_c_ucs4_char_am_ar(a)
if(any(a/=ref_c_ucs4_char_lm)) stop 367
a = ref_c_ucs4_char_lm
call c_check_c_ucs4_char_am_ar(a)
if(any(a/=ref_c_ucs4_char_lm)) stop 368
a = ref_c_ucs4_char_lm
p => a
call f_check_c_ucs4_char_dm_as(p)
if(.not.associated(p)) stop 369
if(.not.associated(p, a)) stop 370
if(any(p/=ref_c_ucs4_char_lm)) stop 371
if(any(a/=ref_c_ucs4_char_lm)) stop 372
a = ref_c_ucs4_char_lm
p => a
call c_check_c_ucs4_char_dm_as(p)
if(.not.associated(p)) stop 373
if(.not.associated(p, a)) stop 374
if(any(p/=ref_c_ucs4_char_lm)) stop 375
if(any(a/=ref_c_ucs4_char_lm)) stop 376
a = ref_c_ucs4_char_lm
p => a
call f_check_c_ucs4_char_dm_ar(p)
if(.not.associated(p)) stop 377
if(.not.associated(p, a)) stop 378
if(any(p/=ref_c_ucs4_char_lm)) stop 379
if(any(a/=ref_c_ucs4_char_lm)) stop 380
a = ref_c_ucs4_char_lm
p => a
call c_check_c_ucs4_char_dm_ar(p)
if(.not.associated(p)) stop 381
if(.not.associated(p, a)) stop 382
if(any(p/=ref_c_ucs4_char_lm)) stop 383
if(any(a/=ref_c_ucs4_char_lm)) stop 384
return
end subroutine check_c_ucs4_char_lm
subroutine f_check_c_ucs4_char_cm_as(a)
character(kind=c_ucs4_char, len=m), intent(in) :: a(:)
!
integer(kind=c_int16_t) :: t
integer(kind=c_signed_char) :: k
integer(kind=c_size_t) :: e, n
!
k = kind(a)
n = len(a, kind=kind(e))
e = storage_size(a, kind=kind(e))/(b*m)
t = cfi_encode_type(CFI_type_Character, k)
if(k<=0_c_signed_char) stop 385
if(k/=4_c_signed_char) stop 386
if(n/=m) stop 387
if(int(k, kind=c_size_t)/=e) stop 388
if(t/=CFI_type_ucs4_char) stop 389
if(any(a/=ref_c_ucs4_char_lm)) stop 390
call check_tk_as(a, t, k, e, n)
if(any(a/=ref_c_ucs4_char_lm)) stop 391
return
end subroutine f_check_c_ucs4_char_cm_as
subroutine c_check_c_ucs4_char_cm_as(a) bind(c)
character(kind=c_ucs4_char, len=m), intent(in) :: a(:)
!
integer(kind=c_int16_t) :: t
integer(kind=c_signed_char) :: k
integer(kind=c_size_t) :: e, n
!
k = kind(a)
n = len(a, kind=kind(e))
e = storage_size(a, kind=kind(e))/(b*m)
t = cfi_encode_type(CFI_type_Character, k)
if(k<=0_c_signed_char) stop 392
if(k/=4_c_signed_char) stop 393
if(n/=m) stop 394
if(int(k, kind=c_size_t)/=e) stop 395
if(t/=CFI_type_ucs4_char) stop 396
if(any(a/=ref_c_ucs4_char_lm)) stop 397
call check_tk_as(a, t, k, e, n)
if(any(a/=ref_c_ucs4_char_lm)) stop 398
return
end subroutine c_check_c_ucs4_char_cm_as
subroutine f_check_c_ucs4_char_cm_ar(a)
character(kind=c_ucs4_char, len=m), intent(in) :: a(..)
!
integer(kind=c_int16_t) :: t
integer(kind=c_signed_char) :: k
integer(kind=c_size_t) :: e, n
!
k = kind(a)
n = len(a, kind=kind(e))
e = storage_size(a, kind=kind(e))/(b*m)
t = cfi_encode_type(CFI_type_Character, k)
if(k<=0_c_signed_char) stop 399
if(k/=4_c_signed_char) stop 400
if(n/=m) stop 401
if(int(k, kind=c_size_t)/=e) stop 402
if(t/=CFI_type_ucs4_char) stop 403
select rank(a)
rank(1)
if(any(a/=ref_c_ucs4_char_lm)) stop 404
rank default
stop 405
end select
call check_tk_ar(a, t, k, e, n)
select rank(a)
rank(1)
if(any(a/=ref_c_ucs4_char_lm)) stop 406
rank default
stop 407
end select
return
end subroutine f_check_c_ucs4_char_cm_ar
subroutine c_check_c_ucs4_char_cm_ar(a) bind(c)
character(kind=c_ucs4_char, len=m), intent(in) :: a(..)
!
integer(kind=c_int16_t) :: t
integer(kind=c_signed_char) :: k
integer(kind=c_size_t) :: e, n
!
k = kind(a)
n = len(a, kind=kind(e))
e = storage_size(a, kind=kind(e))/(b*m)
t = cfi_encode_type(CFI_type_Character, k)
if(k<=0_c_signed_char) stop 408
if(k/=4_c_signed_char) stop 409
if(n/=m) stop 410
if(int(k, kind=c_size_t)/=e) stop 411
if(t/=CFI_type_ucs4_char) stop 412
select rank(a)
rank(1)
if(any(a/=ref_c_ucs4_char_lm)) stop 413
rank default
stop 414
end select
call check_tk_ar(a, t, k, e, n)
select rank(a)
rank(1)
if(any(a/=ref_c_ucs4_char_lm)) stop 415
rank default
stop 416
end select
return
end subroutine c_check_c_ucs4_char_cm_ar
subroutine f_check_c_ucs4_char_am_as(a)
character(kind=c_ucs4_char, len=*), intent(in) :: a(:)
!
integer(kind=c_int16_t) :: t
integer(kind=c_signed_char) :: k
integer(kind=c_size_t) :: e, n
!
k = kind(a)
n = len(a, kind=kind(e))
e = storage_size(a, kind=kind(e))/(b*m)
t = cfi_encode_type(CFI_type_Character, k)
if(k<=0_c_signed_char) stop 417
if(k/=4_c_signed_char) stop 418
if(n/=m) stop 419
if(int(k, kind=c_size_t)/=e) stop 420
if(t/=CFI_type_ucs4_char) stop 421
if(any(a/=ref_c_ucs4_char_lm)) stop 422
call check_tk_as(a, t, k, e, n)
if(any(a/=ref_c_ucs4_char_lm)) stop 423
return
end subroutine f_check_c_ucs4_char_am_as
subroutine c_check_c_ucs4_char_am_as(a) bind(c)
character(kind=c_ucs4_char, len=*), intent(in) :: a(:)
!
integer(kind=c_int16_t) :: t
integer(kind=c_signed_char) :: k
integer(kind=c_size_t) :: e, n
!
k = kind(a)
n = len(a, kind=kind(e))
e = storage_size(a, kind=kind(e))/(b*m)
t = cfi_encode_type(CFI_type_Character, k)
if(k<=0_c_signed_char) stop 424
if(k/=4_c_signed_char) stop 425
if(n/=m) stop 426
if(int(k, kind=c_size_t)/=e) stop 427
if(t/=CFI_type_ucs4_char) stop 428
if(any(a/=ref_c_ucs4_char_lm)) stop 429
call check_tk_as(a, t, k, e, n)
if(any(a/=ref_c_ucs4_char_lm)) stop 430
return
end subroutine c_check_c_ucs4_char_am_as
subroutine f_check_c_ucs4_char_am_ar(a)
character(kind=c_ucs4_char, len=*), intent(in) :: a(..)
!
integer(kind=c_int16_t) :: t
integer(kind=c_signed_char) :: k
integer(kind=c_size_t) :: e, n
!
k = kind(a)
n = len(a, kind=kind(e))
e = storage_size(a, kind=kind(e))/(b*m)
t = cfi_encode_type(CFI_type_Character, k)
if(k<=0_c_signed_char) stop 431
if(k/=4_c_signed_char) stop 432
if(n/=m) stop 433
if(int(k, kind=c_size_t)/=e) stop 434
if(t/=CFI_type_ucs4_char) stop 435
select rank(a)
rank(1)
if(any(a/=ref_c_ucs4_char_lm)) stop 436
rank default
stop 437
end select
call check_tk_ar(a, t, k, e, n)
select rank(a)
rank(1)
if(any(a/=ref_c_ucs4_char_lm)) stop 438
rank default
stop 439
end select
return
end subroutine f_check_c_ucs4_char_am_ar
subroutine c_check_c_ucs4_char_am_ar(a) bind(c)
character(kind=c_ucs4_char, len=*), intent(in) :: a(..)
!
integer(kind=c_int16_t) :: t
integer(kind=c_signed_char) :: k
integer(kind=c_size_t) :: e, n
!
k = kind(a)
n = len(a, kind=kind(e))
e = storage_size(a, kind=kind(e))/(b*m)
t = cfi_encode_type(CFI_type_Character, k)
if(k<=0_c_signed_char) stop 440
if(k/=4_c_signed_char) stop 441
if(n/=m) stop 442
if(int(k, kind=c_size_t)/=e) stop 443
if(t/=CFI_type_ucs4_char) stop 444
select rank(a)
rank(1)
if(any(a/=ref_c_ucs4_char_lm)) stop 445
rank default
stop 446
end select
call check_tk_ar(a, t, k, e, n)
select rank(a)
rank(1)
if(any(a/=ref_c_ucs4_char_lm)) stop 447
rank default
stop 448
end select
return
end subroutine c_check_c_ucs4_char_am_ar
subroutine f_check_c_ucs4_char_dm_as(a)
character(kind=c_ucs4_char, len=:), pointer, intent(in) :: a(:)
!
integer(kind=c_int16_t) :: t
integer(kind=c_signed_char) :: k
integer(kind=c_size_t) :: e, n
!
k = kind(a)
n = len(a, kind=kind(e))
e = storage_size(a, kind=kind(e))/(b*m)
t = cfi_encode_type(CFI_type_Character, k)
if(k<=0_c_signed_char) stop 449
if(k/=4_c_signed_char) stop 450
if(n/=m) stop 451
if(int(k, kind=c_size_t)/=e) stop 452
if(t/=CFI_type_ucs4_char) stop 453
if(any(a/=ref_c_ucs4_char_lm)) stop 454
call check_tk_as(a, t, k, e, n)
if(any(a/=ref_c_ucs4_char_lm)) stop 455
return
end subroutine f_check_c_ucs4_char_dm_as
subroutine c_check_c_ucs4_char_dm_as(a) bind(c)
character(kind=c_ucs4_char, len=:), pointer, intent(in) :: a(:)
!
integer(kind=c_int16_t) :: t
integer(kind=c_signed_char) :: k
integer(kind=c_size_t) :: e, n
!
k = kind(a)
n = len(a, kind=kind(e))
e = storage_size(a, kind=kind(e))/(b*m)
t = cfi_encode_type(CFI_type_Character, k)
if(k<=0_c_signed_char) stop 456
if(k/=4_c_signed_char) stop 457
if(n/=m) stop 458
if(int(k, kind=c_size_t)/=e) stop 459
if(t/=CFI_type_ucs4_char) stop 460
if(any(a/=ref_c_ucs4_char_lm)) stop 461
call check_tk_as(a, t, k, e, n)
if(any(a/=ref_c_ucs4_char_lm)) stop 462
return
end subroutine c_check_c_ucs4_char_dm_as
subroutine f_check_c_ucs4_char_dm_ar(a)
character(kind=c_ucs4_char, len=:), pointer, intent(in) :: a(..)
!
integer(kind=c_int16_t) :: t
integer(kind=c_signed_char) :: k
integer(kind=c_size_t) :: e, n
!
k = kind(a)
n = len(a, kind=kind(e))
e = storage_size(a, kind=kind(e))/(b*m)
t = cfi_encode_type(CFI_type_Character, k)
if(k<=0_c_signed_char) stop 463
if(k/=4_c_signed_char) stop 464
if(n/=m) stop 465
if(int(k, kind=c_size_t)/=e) stop 466
if(t/=CFI_type_ucs4_char) stop 467
select rank(a)
rank(1)
if(any(a/=ref_c_ucs4_char_lm)) stop 468
rank default
stop 469
end select
call check_tk_ar(a, t, k, e, n)
select rank(a)
rank(1)
if(any(a/=ref_c_ucs4_char_lm)) stop 470
rank default
stop 471
end select
return
end subroutine f_check_c_ucs4_char_dm_ar
subroutine c_check_c_ucs4_char_dm_ar(a) bind(c)
character(kind=c_ucs4_char, len=:), pointer, intent(in) :: a(..)
!
integer(kind=c_int16_t) :: t
integer(kind=c_signed_char) :: k
integer(kind=c_size_t) :: e, n
!
k = kind(a)
n = len(a, kind=kind(e))
e = storage_size(a, kind=kind(e))/(b*m)
t = cfi_encode_type(CFI_type_Character, k)
if(k<=0_c_signed_char) stop 472
if(k/=4_c_signed_char) stop 473
if(n/=m) stop 474
if(int(k, kind=c_size_t)/=e) stop 475
if(t/=CFI_type_ucs4_char) stop 476
select rank(a)
rank(1)
if(any(a/=ref_c_ucs4_char_lm)) stop 477
rank default
stop 478
end select
call check_tk_ar(a, t, k, e, n)
select rank(a)
rank(1)
if(any(a/=ref_c_ucs4_char_lm)) stop 479
rank default
stop 480
end select
return
end subroutine c_check_c_ucs4_char_dm_ar
end module iso_check_m
program main_p
use :: iso_check_m, only: &
check_c_char_l1, &
check_c_char_lm, &
check_c_ucs4_char_l1, &
check_c_ucs4_char_lm
implicit none
call check_c_char_l1()
call check_c_char_lm()
! See PR100907
!call check_c_ucs4_char_l1()
!call check_c_ucs4_char_lm()
stop
end program main_p
!! Local Variables:
!! mode: f90
!! End: