| ! { 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: |
| |
