gcc/testsuite/gfortran.dg/PR100906.f90

   1 ! { dg-do run }
   2 ! { dg-additional-sources PR100906.c }
   3 !
   4 ! Test the fix for PR100906
   5 !
   6
   7 module isof_m
   8
   9   use, intrinsic :: iso_c_binding, only: &
  10     c_signed_char, c_int16_t
  11
  12   implicit none
  13
  14   private
  15
  16   public ::             &
  17     CFI_type_character
  18
  19   public ::             &
  20     CFI_type_char,      &
  21     CFI_type_ucs4_char
  22
  23   public ::      &
  24     check_tk_as, &
  25     check_tk_ar
  26
  27
  28   public ::          &
  29     cfi_encode_type
  30
  31   integer, parameter :: CFI_type_t = c_int16_t
  32
  33   integer(kind=c_int16_t), parameter :: CFI_type_mask = int(z"FF", kind=c_int16_t)
  34   integer(kind=c_int16_t), parameter :: CFI_type_kind_shift = 8_c_int16_t
  35
  36   ! Intrinsic types. Their kind number defines their storage size. */
  37   integer(kind=c_signed_char), parameter :: CFI_type_Character = 5
  38
  39   ! C-Fortran Interoperability types.
  40   integer(kind=cfi_type_t), parameter :: CFI_type_char      = &
  41     ior(int(CFI_type_Character, kind=c_int16_t), shiftl(1_c_int16_t, CFI_type_kind_shift))
  42   integer(kind=cfi_type_t), parameter :: CFI_type_ucs4_char = &
  43     ior(int(CFI_type_Character, kind=c_int16_t), shiftl(4_c_int16_t, CFI_type_kind_shift))
  44
  45   interface
  46     subroutine check_tk_as(a, t, k, e, n) &
  47       bind(c, name="check_tk")
  48       use, intrinsic :: iso_c_binding, only: &
  49         c_int16_t, c_signed_char, c_size_t
  50       implicit none
  51       type(*),                       intent(in) :: a(:)
  52       integer(c_int16_t),     value, intent(in) :: t
  53       integer(c_signed_char), value, intent(in) :: k
  54       integer(c_size_t),      value, intent(in) :: e
  55       integer(c_size_t),      value, intent(in) :: n
  56     end subroutine check_tk_as
  57     subroutine check_tk_ar(a, t, k, e, n) &
  58       bind(c, name="check_tk")
  59       use, intrinsic :: iso_c_binding, only: &
  60         c_int16_t, c_signed_char, c_size_t
  61       implicit none
  62       type(*),                       intent(in) :: a(..)
  63       integer(c_int16_t),     value, intent(in) :: t
  64       integer(c_signed_char), value, intent(in) :: k
  65       integer(c_size_t),      value, intent(in) :: e
  66       integer(c_size_t),      value, intent(in) :: n
  67     end subroutine check_tk_ar
  68   end interface
  69
  70 contains
  71
  72   elemental function cfi_encode_type(type, kind) result(itype)
  73     integer(kind=c_signed_char), intent(in) :: type
  74     integer(kind=c_signed_char), intent(in) :: kind
  75
  76     integer(kind=c_int16_t) :: itype, ikind
  77
  78     itype = int(type, kind=c_int16_t)
  79     itype = iand(itype, CFI_type_mask)
  80     ikind = int(kind, kind=c_int16_t)
  81     ikind = iand(ikind, CFI_type_mask)
  82     ikind = shiftl(ikind, CFI_type_kind_shift)
  83     itype = ior(ikind, itype)
  84     return
  85   end function cfi_encode_type
  86
  87 end module isof_m
  88
  89 module iso_check_m
  90
  91   use, intrinsic :: iso_c_binding, only: &
  92     c_signed_char, c_int16_t, c_size_t
  93
  94   use, intrinsic :: iso_c_binding, only: &
  95     c_char
  96
  97   use :: isof_m, only:  &
  98     CFI_type_character
  99
 100   use :: isof_m, only:  &
 101     CFI_type_char,      &
 102     CFI_type_ucs4_char
 103
 104   use :: isof_m, only: &
 105     check_tk_as,       &
 106     check_tk_ar
 107
 108   use :: isof_m, only: &
 109     cfi_encode_type
 110
 111   implicit none
 112
 113   private
 114
 115   public ::               &
 116     check_c_char_l1,      &
 117     check_c_char_lm,      &
 118     check_c_ucs4_char_l1, &
 119     check_c_ucs4_char_lm
 120
 121   integer                           :: i
 122   integer(kind=c_size_t), parameter :: b = 8
 123   integer,                parameter :: n = 11
 124   integer,                parameter :: m = 7
 125
 126   integer, parameter :: c_ucs4_char = 4
 127
 128   character(kind=c_char, len=1), parameter :: ref_c_char_l1(*) = &
 129     [(achar(i+iachar("A")-1, kind=c_char), i=1,n)]
 130   character(kind=c_char, len=m), parameter :: ref_c_char_lm(*) = &
 131     [(repeat(achar(i+iachar("A")-1, kind=c_char), m), i=1,n)]
 132   character(kind=c_ucs4_char, len=1), parameter :: ref_c_ucs4_char_l1(*) = &
 133     [(achar(i+iachar("A")-1, kind=c_ucs4_char), i=1,n)]
 134   character(kind=c_ucs4_char, len=m), parameter :: ref_c_ucs4_char_lm(*) = &
 135     [(repeat(achar(i+iachar("A")-1, kind=c_ucs4_char), m), i=1,n)]
 136
 137 contains
 138
 139   subroutine check_c_char_l1()
 140     character(kind=c_char, len=1), target :: a(n)
 141     !
 142     character(kind=c_char, len=:), pointer :: p(:)
 143     !
 144     a = ref_c_char_l1
 145     call f_check_c_char_c1_as(a)
 146     if(any(a/=ref_c_char_l1)) stop 1
 147     a = ref_c_char_l1
 148     call c_check_c_char_c1_as(a)
 149     if(any(a/=ref_c_char_l1)) stop 2
 150     a = ref_c_char_l1
 151     call f_check_c_char_c1_ar(a)
 152     if(any(a/=ref_c_char_l1)) stop 3
 153     a = ref_c_char_l1
 154     call c_check_c_char_c1_ar(a)
 155     if(any(a/=ref_c_char_l1)) stop 4
 156     a = ref_c_char_l1
 157     call f_check_c_char_a1_as(a)
 158     if(any(a/=ref_c_char_l1)) stop 5
 159     a = ref_c_char_l1
 160     call c_check_c_char_a1_as(a)
 161     if(any(a/=ref_c_char_l1)) stop 6
 162     a = ref_c_char_l1
 163     call f_check_c_char_a1_ar(a)
 164     if(any(a/=ref_c_char_l1)) stop 7
 165     a = ref_c_char_l1
 166     call c_check_c_char_a1_ar(a)
 167     if(any(a/=ref_c_char_l1)) stop 8
 168     a = ref_c_char_l1
 169     p => a
 170     call f_check_c_char_d1_as(p)
 171     if(.not.associated(p)) stop 9
 172     if(.not.associated(p, a)) stop 10
 173     if(any(p/=ref_c_char_l1)) stop 11
 174     if(any(a/=ref_c_char_l1)) stop 12
 175     a = ref_c_char_l1
 176     p => a
 177     call c_check_c_char_d1_as(p)
 178     if(.not.associated(p)) stop 13
 179     if(.not.associated(p, a)) stop 14
 180     if(any(p/=ref_c_char_l1)) stop 15
 181     if(any(a/=ref_c_char_l1)) stop 16
 182     a = ref_c_char_l1
 183     p => a
 184     call f_check_c_char_d1_ar(p)
 185     if(.not.associated(p)) stop 17
 186     if(.not.associated(p, a)) stop 18
 187     if(any(p/=ref_c_char_l1)) stop 19
 188     if(any(a/=ref_c_char_l1)) stop 20
 189     a = ref_c_char_l1
 190     p => a
 191     call c_check_c_char_d1_ar(p)
 192     if(.not.associated(p)) stop 21
 193     if(.not.associated(p, a)) stop 22
 194     if(any(p/=ref_c_char_l1)) stop 23
 195     if(any(a/=ref_c_char_l1)) stop 24
 196     return
 197   end subroutine check_c_char_l1
 198
 199   subroutine f_check_c_char_c1_as(a)
 200     character(kind=c_char, len=1), intent(in) :: a(:)
 201     !
 202     integer(kind=c_int16_t)     :: t
 203     integer(kind=c_signed_char) :: k
 204     integer(kind=c_size_t)      :: e, n
 205     !
 206     k = kind(a)
 207     n = len(a, kind=kind(e))
 208     e = storage_size(a, kind=kind(e))/(b*1)
 209     t = cfi_encode_type(CFI_type_Character, k)
 210     if(k<=0_c_signed_char) stop 25
 211     if(k/=1_c_signed_char) stop 26
 212     if(n/=1) stop 27
 213     if(int(k, kind=c_size_t)/=e) stop 28
 214     if(t/=CFI_type_char) stop 29
 215     if(any(a/=ref_c_char_l1)) stop 30
 216     call check_tk_as(a, t, k, e, n)
 217     if(any(a/=ref_c_char_l1)) stop 31
 218     return
 219   end subroutine f_check_c_char_c1_as
 220
 221   subroutine c_check_c_char_c1_as(a) bind(c)
 222     character(kind=c_char, len=1), intent(in) :: a(:)
 223     !
 224     integer(kind=c_int16_t)     :: t
 225     integer(kind=c_signed_char) :: k
 226     integer(kind=c_size_t)      :: e, n
 227     !
 228     k = kind(a)
 229     n = len(a, kind=kind(e))
 230     e = storage_size(a, kind=kind(e))/(b*1)
 231     t = cfi_encode_type(CFI_type_Character, k)
 232     if(k<=0_c_signed_char) stop 32
 233     if(k/=1_c_signed_char) stop 33
 234     if(n/=1) stop 34
 235     if(int(k, kind=c_size_t)/=e) stop 35
 236     if(t/=CFI_type_char) stop 36
 237     if(any(a/=ref_c_char_l1)) stop 37
 238     call check_tk_as(a, t, k, e, n)
 239     if(any(a/=ref_c_char_l1)) stop 38
 240     return
 241   end subroutine c_check_c_char_c1_as
 242
 243   subroutine f_check_c_char_c1_ar(a)
 244     character(kind=c_char, len=1), intent(in) :: a(..)
 245     !
 246     integer(kind=c_int16_t)     :: t
 247     integer(kind=c_signed_char) :: k
 248     integer(kind=c_size_t)      :: e, n
 249     !
 250     k = kind(a)
 251     n = len(a, kind=kind(e))
 252     e = storage_size(a, kind=kind(e))/(b*1)
 253     t = cfi_encode_type(CFI_type_Character, k)
 254     if(k<=0_c_signed_char) stop 39
 255     if(k/=1_c_signed_char) stop 40
 256     if(n/=1) stop 41
 257     if(int(k, kind=c_size_t)/=e) stop 42
 258     if(t/=CFI_type_char) stop 43
 259     select rank(a)
 260     rank(1)
 261       if(any(a/=ref_c_char_l1)) stop 44
 262     rank default
 263       stop 45
 264     end select
 265     call check_tk_ar(a, t, k, e, n)
 266     select rank(a)
 267     rank(1)
 268       if(any(a/=ref_c_char_l1)) stop 46
 269     rank default
 270       stop 47
 271     end select
 272     return
 273   end subroutine f_check_c_char_c1_ar
 274
 275   subroutine c_check_c_char_c1_ar(a) bind(c)
 276     character(kind=c_char, len=1), intent(in) :: a(..)
 277     !
 278     integer(kind=c_int16_t)     :: t
 279     integer(kind=c_signed_char) :: k
 280     integer(kind=c_size_t)      :: e, n
 281     !
 282     k = kind(a)
 283     n = len(a, kind=kind(e))
 284     e = storage_size(a, kind=kind(e))/(b*1)
 285     t = cfi_encode_type(CFI_type_Character, k)
 286     if(k<=0_c_signed_char) stop 48
 287     if(k/=1_c_signed_char) stop 49
 288     if(n/=1) stop 50
 289     if(int(k, kind=c_size_t)/=e) stop 51
 290     if(t/=CFI_type_char) stop 52
 291     select rank(a)
 292     rank(1)
 293       if(any(a/=ref_c_char_l1)) stop 53
 294     rank default
 295       stop 54
 296     end select
 297     call check_tk_ar(a, t, k, e, n)
 298     select rank(a)
 299     rank(1)
 300       if(any(a/=ref_c_char_l1)) stop 55
 301     rank default
 302       stop 56
 303     end select
 304     return
 305   end subroutine c_check_c_char_c1_ar
 306
 307   subroutine f_check_c_char_a1_as(a)
 308     character(kind=c_char, len=*), intent(in) :: a(:)
 309     !
 310     integer(kind=c_int16_t)     :: t
 311     integer(kind=c_signed_char) :: k
 312     integer(kind=c_size_t)      :: e, n
 313     !
 314     k = kind(a)
 315     n = len(a, kind=kind(e))
 316     e = storage_size(a, kind=kind(e))/(b*1)
 317     t = cfi_encode_type(CFI_type_Character, k)
 318     if(k<=0_c_signed_char) stop 57
 319     if(k/=1_c_signed_char) stop 58
 320     if(n/=1) stop 59
 321     if(int(k, kind=c_size_t)/=e) stop 60
 322     if(t/=CFI_type_char) stop 61
 323     if(any(a/=ref_c_char_l1)) stop 62
 324     call check_tk_as(a, t, k, e, n)
 325     if(any(a/=ref_c_char_l1)) stop 63
 326     return
 327   end subroutine f_check_c_char_a1_as
 328
 329   subroutine c_check_c_char_a1_as(a) bind(c)
 330     character(kind=c_char, len=*), intent(in) :: a(:)
 331     !
 332     integer(kind=c_int16_t)     :: t
 333     integer(kind=c_signed_char) :: k
 334     integer(kind=c_size_t)      :: e, n
 335     !
 336     k = kind(a)
 337     n = len(a, kind=kind(e))
 338     e = storage_size(a, kind=kind(e))/(b*1)
 339     t = cfi_encode_type(CFI_type_Character, k)
 340     if(k<=0_c_signed_char) stop 64
 341     if(k/=1_c_signed_char) stop 65
 342     if(n/=1) stop 66
 343     if(int(k, kind=c_size_t)/=e) stop 67
 344     if(t/=CFI_type_char) stop 68
 345     if(any(a/=ref_c_char_l1)) stop 69
 346     call check_tk_as(a, t, k, e, n)
 347     if(any(a/=ref_c_char_l1)) stop 70
 348     return
 349   end subroutine c_check_c_char_a1_as
 350
 351   subroutine f_check_c_char_a1_ar(a)
 352     character(kind=c_char, len=*), intent(in) :: a(..)
 353     !
 354     integer(kind=c_int16_t)     :: t
 355     integer(kind=c_signed_char) :: k
 356     integer(kind=c_size_t)      :: e, n
 357     !
 358     k = kind(a)
 359     n = len(a, kind=kind(e))
 360     e = storage_size(a, kind=kind(e))/(b*1)
 361     t = cfi_encode_type(CFI_type_Character, k)
 362     if(k<=0_c_signed_char) stop 71
 363     if(k/=1_c_signed_char) stop 72
 364     if(n/=1) stop 73
 365     if(int(k, kind=c_size_t)/=e) stop 74
 366     if(t/=CFI_type_char) stop 75
 367     select rank(a)
 368     rank(1)
 369       if(any(a/=ref_c_char_l1)) stop 76
 370     rank default
 371       stop 77
 372     end select
 373     call check_tk_ar(a, t, k, e, n)
 374     select rank(a)
 375     rank(1)
 376       if(any(a/=ref_c_char_l1)) stop 78
 377     rank default
 378       stop 79
 379     end select
 380     return
 381   end subroutine f_check_c_char_a1_ar
 382
 383   subroutine c_check_c_char_a1_ar(a) bind(c)
 384     character(kind=c_char, len=*), intent(in) :: a(..)
 385     !
 386     integer(kind=c_int16_t)     :: t
 387     integer(kind=c_signed_char) :: k
 388     integer(kind=c_size_t)      :: e, n
 389     !
 390     k = kind(a)
 391     n = len(a, kind=kind(e))
 392     e = storage_size(a, kind=kind(e))/(b*1)
 393     t = cfi_encode_type(CFI_type_Character, k)
 394     if(k<=0_c_signed_char) stop 80
 395     if(k/=1_c_signed_char) stop 81
 396     if(n/=1) stop 82
 397     if(int(k, kind=c_size_t)/=e) stop 83
 398     if(t/=CFI_type_char) stop 84
 399     select rank(a)
 400     rank(1)
 401       if(any(a/=ref_c_char_l1)) stop 85
 402     rank default
 403       stop 86
 404     end select
 405     call check_tk_ar(a, t, k, e, n)
 406     select rank(a)
 407     rank(1)
 408       if(any(a/=ref_c_char_l1)) stop 87
 409     rank default
 410       stop 88
 411     end select
 412     return
 413   end subroutine c_check_c_char_a1_ar
 414
 415   subroutine f_check_c_char_d1_as(a)
 416     character(kind=c_char, len=:), pointer, intent(in) :: a(:)
 417     !
 418     integer(kind=c_int16_t)     :: t
 419     integer(kind=c_signed_char) :: k
 420     integer(kind=c_size_t)      :: e, n
 421     !
 422     k = kind(a)
 423     n = len(a, kind=kind(e))
 424     e = storage_size(a, kind=kind(e))/(b*1)
 425     t = cfi_encode_type(CFI_type_Character, k)
 426     if(k<=0_c_signed_char) stop 89
 427     if(k/=1_c_signed_char) stop 90
 428     if(n/=1) stop 91
 429     if(int(k, kind=c_size_t)/=e) stop 92
 430     if(t/=CFI_type_char) stop 93
 431     if(any(a/=ref_c_char_l1)) stop 94
 432     call check_tk_as(a, t, k, e, n)
 433     if(any(a/=ref_c_char_l1)) stop 95
 434     return
 435   end subroutine f_check_c_char_d1_as
 436
 437   subroutine c_check_c_char_d1_as(a) bind(c)
 438     character(kind=c_char, len=:), pointer, intent(in) :: a(:)
 439     !
 440     integer(kind=c_int16_t)     :: t
 441     integer(kind=c_signed_char) :: k
 442     integer(kind=c_size_t)      :: e, n
 443     !
 444     k = kind(a)
 445     n = len(a, kind=kind(e))
 446     e = storage_size(a, kind=kind(e))/(b*1)
 447     t = cfi_encode_type(CFI_type_Character, k)
 448     if(k<=0_c_signed_char) stop 96
 449     if(k/=1_c_signed_char) stop 97
 450     if(n/=1) stop 98
 451     if(int(k, kind=c_size_t)/=e) stop 99
 452     if(t/=CFI_type_char) stop 100
 453     if(any(a/=ref_c_char_l1)) stop 101
 454     call check_tk_as(a, t, k, e, n)
 455     if(any(a/=ref_c_char_l1)) stop 102
 456     return
 457   end subroutine c_check_c_char_d1_as
 458
 459   subroutine f_check_c_char_d1_ar(a)
 460     character(kind=c_char, len=:), pointer, intent(in) :: a(..)
 461     !
 462     integer(kind=c_int16_t)     :: t
 463     integer(kind=c_signed_char) :: k
 464     integer(kind=c_size_t)      :: e, n
 465     !
 466     k = kind(a)
 467     n = len(a, kind=kind(e))
 468     e = storage_size(a, kind=kind(e))/(b*1)
 469     t = cfi_encode_type(CFI_type_Character, k)
 470     if(k<=0_c_signed_char) stop 103
 471     if(k/=1_c_signed_char) stop 104
 472     if(n/=1) stop 105
 473     if(int(k, kind=c_size_t)/=e) stop 106
 474     if(t/=CFI_type_char) stop 107
 475     select rank(a)
 476     rank(1)
 477       if(any(a/=ref_c_char_l1)) stop 108
 478     rank default
 479       stop 109
 480     end select
 481     call check_tk_ar(a, t, k, e, n)
 482     select rank(a)
 483     rank(1)
 484       if(any(a/=ref_c_char_l1)) stop 110
 485     rank default
 486       stop 111
 487     end select
 488     return
 489   end subroutine f_check_c_char_d1_ar
 490
 491   subroutine c_check_c_char_d1_ar(a) bind(c)
 492     character(kind=c_char, len=:), pointer, intent(in) :: a(..)
 493     !
 494     integer(kind=c_int16_t)     :: t
 495     integer(kind=c_signed_char) :: k
 496     integer(kind=c_size_t)      :: e, n
 497     !
 498     k = kind(a)
 499     n = len(a, kind=kind(e))
 500     e = storage_size(a, kind=kind(e))/(b*1)
 501     t = cfi_encode_type(CFI_type_Character, k)
 502     if(k<=0_c_signed_char) stop 112
 503     if(k/=1_c_signed_char) stop 113
 504     if(n/=1) stop 114
 505     if(int(k, kind=c_size_t)/=e) stop 115
 506     if(t/=CFI_type_char) stop 116
 507     select rank(a)
 508     rank(1)
 509       if(any(a/=ref_c_char_l1)) stop 117
 510     rank default
 511       stop 118
 512     end select
 513     call check_tk_ar(a, t, k, e, n)
 514     select rank(a)
 515     rank(1)
 516       if(any(a/=ref_c_char_l1)) stop 119
 517     rank default
 518       stop 120
 519     end select
 520     return
 521   end subroutine c_check_c_char_d1_ar
 522
 523   subroutine check_c_char_lm()
 524     character(kind=c_char, len=m), target :: a(n)
 525     !
 526     character(kind=c_char, len=:), pointer :: p(:)
 527     !
 528     a = ref_c_char_lm
 529     call f_check_c_char_cm_as(a)
 530     if(any(a/=ref_c_char_lm)) stop 121
 531     a = ref_c_char_lm
 532     call c_check_c_char_cm_as(a)
 533     if(any(a/=ref_c_char_lm)) stop 122
 534     a = ref_c_char_lm
 535     call f_check_c_char_cm_ar(a)
 536     if(any(a/=ref_c_char_lm)) stop 123
 537     a = ref_c_char_lm
 538     call c_check_c_char_cm_ar(a)
 539     if(any(a/=ref_c_char_lm)) stop 124
 540     a = ref_c_char_lm
 541     call f_check_c_char_am_as(a)
 542     if(any(a/=ref_c_char_lm)) stop 125
 543     a = ref_c_char_lm
 544     call c_check_c_char_am_as(a)
 545     if(any(a/=ref_c_char_lm)) stop 126
 546     a = ref_c_char_lm
 547     call f_check_c_char_am_ar(a)
 548     if(any(a/=ref_c_char_lm)) stop 127
 549     a = ref_c_char_lm
 550     call c_check_c_char_am_ar(a)
 551     if(any(a/=ref_c_char_lm)) stop 128
 552     a = ref_c_char_lm
 553     p => a
 554     call f_check_c_char_dm_as(p)
 555     if(.not.associated(p)) stop 129
 556     if(.not.associated(p, a)) stop 130
 557     if(any(p/=ref_c_char_lm)) stop 131
 558     if(any(a/=ref_c_char_lm)) stop 132
 559     a = ref_c_char_lm
 560     p => a
 561     call c_check_c_char_dm_as(p)
 562     if(.not.associated(p)) stop 133
 563     if(.not.associated(p, a)) stop 134
 564     if(any(p/=ref_c_char_lm)) stop 135
 565     if(any(a/=ref_c_char_lm)) stop 136
 566     a = ref_c_char_lm
 567     p => a
 568     call f_check_c_char_dm_ar(p)
 569     if(.not.associated(p)) stop 137
 570     if(.not.associated(p, a)) stop 138
 571     if(any(p/=ref_c_char_lm)) stop 139
 572     if(any(a/=ref_c_char_lm)) stop 140
 573     a = ref_c_char_lm
 574     p => a
 575     call c_check_c_char_dm_ar(p)
 576     if(.not.associated(p)) stop 141
 577     if(.not.associated(p, a)) stop 142
 578     if(any(p/=ref_c_char_lm)) stop 143
 579     if(any(a/=ref_c_char_lm)) stop 144
 580     return
 581   end subroutine check_c_char_lm
 582
 583   subroutine f_check_c_char_cm_as(a)
 584     character(kind=c_char, len=m), intent(in) :: a(:)
 585     !
 586     integer(kind=c_int16_t)     :: t
 587     integer(kind=c_signed_char) :: k
 588     integer(kind=c_size_t)      :: e, n
 589     !
 590     k = kind(a)
 591     n = len(a, kind=kind(e))
 592     e = storage_size(a, kind=kind(e))/(b*m)
 593     t = cfi_encode_type(CFI_type_Character, k)
 594     if(k<=0_c_signed_char) stop 145
 595     if(k/=1_c_signed_char) stop 146
 596     if(n/=m) stop 147
 597     if(int(k, kind=c_size_t)/=e) stop 148
 598     if(t/=CFI_type_char) stop 149
 599     if(any(a/=ref_c_char_lm)) stop 150
 600     call check_tk_as(a, t, k, e, n)
 601     if(any(a/=ref_c_char_lm)) stop 151
 602     return
 603   end subroutine f_check_c_char_cm_as
 604
 605   subroutine c_check_c_char_cm_as(a) bind(c)
 606     character(kind=c_char, len=m), intent(in) :: a(:)
 607     !
 608     integer(kind=c_int16_t)     :: t
 609     integer(kind=c_signed_char) :: k
 610     integer(kind=c_size_t)      :: e, n
 611     !
 612     k = kind(a)
 613     n = len(a, kind=kind(e))
 614     e = storage_size(a, kind=kind(e))/(b*m)
 615     t = cfi_encode_type(CFI_type_Character, k)
 616     if(k<=0_c_signed_char) stop 152
 617     if(k/=1_c_signed_char) stop 153
 618     if(n/=m) stop 154
 619     if(int(k, kind=c_size_t)/=e) stop 155
 620     if(t/=CFI_type_char) stop 156
 621     if(any(a/=ref_c_char_lm)) stop 157
 622     call check_tk_as(a, t, k, e, n)
 623     if(any(a/=ref_c_char_lm)) stop 158
 624     return
 625   end subroutine c_check_c_char_cm_as
 626
 627   subroutine f_check_c_char_cm_ar(a)
 628     character(kind=c_char, len=m), intent(in) :: a(..)
 629     !
 630     integer(kind=c_int16_t)     :: t
 631     integer(kind=c_signed_char) :: k
 632     integer(kind=c_size_t)      :: e, n
 633     !
 634     k = kind(a)
 635     n = len(a, kind=kind(e))
 636     e = storage_size(a, kind=kind(e))/(b*m)
 637     t = cfi_encode_type(CFI_type_Character, k)
 638     if(k<=0_c_signed_char) stop 159
 639     if(k/=1_c_signed_char) stop 160
 640     if(n/=m) stop 161
 641     if(int(k, kind=c_size_t)/=e) stop 162
 642     if(t/=CFI_type_char) stop 163
 643     select rank(a)
 644     rank(1)
 645       if(any(a/=ref_c_char_lm)) stop 164
 646     rank default
 647       stop 165
 648     end select
 649     call check_tk_ar(a, t, k, e, n)
 650     select rank(a)
 651     rank(1)
 652       if(any(a/=ref_c_char_lm)) stop 166
 653     rank default
 654       stop 167
 655     end select
 656     return
 657   end subroutine f_check_c_char_cm_ar
 658
 659   subroutine c_check_c_char_cm_ar(a) bind(c)
 660     character(kind=c_char, len=m), intent(in) :: a(..)
 661     !
 662     integer(kind=c_int16_t)     :: t
 663     integer(kind=c_signed_char) :: k
 664     integer(kind=c_size_t)      :: e, n
 665     !
 666     k = kind(a)
 667     n = len(a, kind=kind(e))
 668     e = storage_size(a, kind=kind(e))/(b*m)
 669     t = cfi_encode_type(CFI_type_Character, k)
 670     if(k<=0_c_signed_char) stop 168
 671     if(k/=1_c_signed_char) stop 169
 672     if(n/=m) stop 170
 673     if(int(k, kind=c_size_t)/=e) stop 171
 674     if(t/=CFI_type_char) stop 172
 675     select rank(a)
 676     rank(1)
 677       if(any(a/=ref_c_char_lm)) stop 173
 678     rank default
 679       stop 174
 680     end select
 681     call check_tk_ar(a, t, k, e, n)
 682     select rank(a)
 683     rank(1)
 684       if(any(a/=ref_c_char_lm)) stop 175
 685     rank default
 686       stop 176
 687     end select
 688     return
 689   end subroutine c_check_c_char_cm_ar
 690
 691   subroutine f_check_c_char_am_as(a)
 692     character(kind=c_char, len=*), intent(in) :: a(:)
 693     !
 694     integer(kind=c_int16_t)     :: t
 695     integer(kind=c_signed_char) :: k
 696     integer(kind=c_size_t)      :: e, n
 697     !
 698     k = kind(a)
 699     n = len(a, kind=kind(e))
 700     e = storage_size(a, kind=kind(e))/(b*m)
 701     t = cfi_encode_type(CFI_type_Character, k)
 702     if(k<=0_c_signed_char) stop 177
 703     if(k/=1_c_signed_char) stop 178
 704     if(n/=m) stop 179
 705     if(int(k, kind=c_size_t)/=e) stop 180
 706     if(t/=CFI_type_char) stop 181
 707     if(any(a/=ref_c_char_lm)) stop 182
 708     call check_tk_as(a, t, k, e, n)
 709     if(any(a/=ref_c_char_lm)) stop 183
 710     return
 711   end subroutine f_check_c_char_am_as
 712
 713   subroutine c_check_c_char_am_as(a) bind(c)
 714     character(kind=c_char, len=*), intent(in) :: a(:)
 715     !
 716     integer(kind=c_int16_t)     :: t
 717     integer(kind=c_signed_char) :: k
 718     integer(kind=c_size_t)      :: e, n
 719     !
 720     k = kind(a)
 721     n = len(a, kind=kind(e))
 722     e = storage_size(a, kind=kind(e))/(b*m)
 723     t = cfi_encode_type(CFI_type_Character, k)
 724     if(k<=0_c_signed_char) stop 184
 725     if(k/=1_c_signed_char) stop 185
 726     if(n/=m) stop 186
 727     if(int(k, kind=c_size_t)/=e) stop 187
 728     if(t/=CFI_type_char) stop 188
 729     if(any(a/=ref_c_char_lm)) stop 189
 730     call check_tk_as(a, t, k, e, n)
 731     if(any(a/=ref_c_char_lm)) stop 190
 732     return
 733   end subroutine c_check_c_char_am_as
 734
 735   subroutine f_check_c_char_am_ar(a)
 736     character(kind=c_char, len=*), intent(in) :: a(..)
 737     !
 738     integer(kind=c_int16_t)     :: t
 739     integer(kind=c_signed_char) :: k
 740     integer(kind=c_size_t)      :: e, n
 741     !
 742     k = kind(a)
 743     n = len(a, kind=kind(e))
 744     e = storage_size(a, kind=kind(e))/(b*m)
 745     t = cfi_encode_type(CFI_type_Character, k)
 746     if(k<=0_c_signed_char) stop 191
 747     if(k/=1_c_signed_char) stop 192
 748     if(n/=m) stop 193
 749     if(int(k, kind=c_size_t)/=e) stop 194
 750     if(t/=CFI_type_char) stop 195
 751     select rank(a)
 752     rank(1)
 753       if(any(a/=ref_c_char_lm)) stop 196
 754     rank default
 755       stop 197
 756     end select
 757     call check_tk_ar(a, t, k, e, n)
 758     select rank(a)
 759     rank(1)
 760       if(any(a/=ref_c_char_lm)) stop 198
 761     rank default
 762       stop 199
 763     end select
 764     return
 765   end subroutine f_check_c_char_am_ar
 766
 767   subroutine c_check_c_char_am_ar(a) bind(c)
 768     character(kind=c_char, len=*), intent(in) :: a(..)
 769     !
 770     integer(kind=c_int16_t)     :: t
 771     integer(kind=c_signed_char) :: k
 772     integer(kind=c_size_t)      :: e, n
 773     !
 774     k = kind(a)
 775     n = len(a, kind=kind(e))
 776     e = storage_size(a, kind=kind(e))/(b*m)
 777     t = cfi_encode_type(CFI_type_Character, k)
 778     if(k<=0_c_signed_char) stop 200
 779     if(k/=1_c_signed_char) stop 201
 780     if(n/=m) stop 202
 781     if(int(k, kind=c_size_t)/=e) stop 203
 782     if(t/=CFI_type_char) stop 204
 783     select rank(a)
 784     rank(1)
 785       if(any(a/=ref_c_char_lm)) stop 205
 786     rank default
 787       stop 206
 788     end select
 789     call check_tk_ar(a, t, k, e, n)
 790     select rank(a)
 791     rank(1)
 792       if(any(a/=ref_c_char_lm)) stop 207
 793     rank default
 794       stop 208
 795     end select
 796     return
 797   end subroutine c_check_c_char_am_ar
 798
 799   subroutine f_check_c_char_dm_as(a)
 800     character(kind=c_char, len=:), pointer, intent(in) :: a(:)
 801     !
 802     integer(kind=c_int16_t)     :: t
 803     integer(kind=c_signed_char) :: k
 804     integer(kind=c_size_t)      :: e, n
 805     !
 806     k = kind(a)
 807     n = len(a, kind=kind(e))
 808     e = storage_size(a, kind=kind(e))/(b*m)
 809     t = cfi_encode_type(CFI_type_Character, k)
 810     if(k<=0_c_signed_char) stop 209
 811     if(k/=1_c_signed_char) stop 210
 812     if(n/=m) stop 211
 813     if(int(k, kind=c_size_t)/=e) stop 212
 814     if(t/=CFI_type_char) stop 213
 815     if(any(a/=ref_c_char_lm)) stop 214
 816     call check_tk_as(a, t, k, e, n)
 817     if(any(a/=ref_c_char_lm)) stop 215
 818     return
 819   end subroutine f_check_c_char_dm_as
 820
 821   subroutine c_check_c_char_dm_as(a) bind(c)
 822     character(kind=c_char, len=:), pointer, intent(in) :: a(:)
 823     !
 824     integer(kind=c_int16_t)     :: t
 825     integer(kind=c_signed_char) :: k
 826     integer(kind=c_size_t)      :: e, n
 827     !
 828     k = kind(a)
 829     n = len(a, kind=kind(e))
 830     e = storage_size(a, kind=kind(e))/(b*m)
 831     t = cfi_encode_type(CFI_type_Character, k)
 832     if(k<=0_c_signed_char) stop 216
 833     if(k/=1_c_signed_char) stop 217
 834     if(n/=m) stop 218
 835     if(int(k, kind=c_size_t)/=e) stop 219
 836     if(t/=CFI_type_char) stop 220
 837     if(any(a/=ref_c_char_lm)) stop 221
 838     call check_tk_as(a, t, k, e, n)
 839     if(any(a/=ref_c_char_lm)) stop 222
 840     return
 841   end subroutine c_check_c_char_dm_as
 842
 843   subroutine f_check_c_char_dm_ar(a)
 844     character(kind=c_char, len=:), pointer, intent(in) :: a(..)
 845     !
 846     integer(kind=c_int16_t)     :: t
 847     integer(kind=c_signed_char) :: k
 848     integer(kind=c_size_t)      :: e, n
 849     !
 850     k = kind(a)
 851     n = len(a, kind=kind(e))
 852     e = storage_size(a, kind=kind(e))/(b*m)
 853     t = cfi_encode_type(CFI_type_Character, k)
 854     if(k<=0_c_signed_char) stop 223
 855     if(k/=1_c_signed_char) stop 224
 856     if(n/=m) stop 225
 857     if(int(k, kind=c_size_t)/=e) stop 226
 858     if(t/=CFI_type_char) stop 227
 859     select rank(a)
 860     rank(1)
 861       if(any(a/=ref_c_char_lm)) stop 228
 862     rank default
 863       stop 229
 864     end select
 865     call check_tk_ar(a, t, k, e, n)
 866     select rank(a)
 867     rank(1)
 868       if(any(a/=ref_c_char_lm)) stop 230
 869     rank default
 870       stop 231
 871     end select
 872     return
 873   end subroutine f_check_c_char_dm_ar
 874
 875   subroutine c_check_c_char_dm_ar(a) bind(c)
 876     character(kind=c_char, len=:), pointer, intent(in) :: a(..)
 877     !
 878     integer(kind=c_int16_t)     :: t
 879     integer(kind=c_signed_char) :: k
 880     integer(kind=c_size_t)      :: e, n
 881     !
 882     k = kind(a)
 883     n = len(a, kind=kind(e))
 884     e = storage_size(a, kind=kind(e))/(b*m)
 885     t = cfi_encode_type(CFI_type_Character, k)
 886     if(k<=0_c_signed_char) stop 232
 887     if(k/=1_c_signed_char) stop 233
 888     if(n/=m) stop 234
 889     if(int(k, kind=c_size_t)/=e) stop 235
 890     if(t/=CFI_type_char) stop 236
 891     select rank(a)
 892     rank(1)
 893       if(any(a/=ref_c_char_lm)) stop 237
 894     rank default
 895       stop 238
 896     end select
 897     call check_tk_ar(a, t, k, e, n)
 898     select rank(a)
 899     rank(1)
 900       if(any(a/=ref_c_char_lm)) stop 239
 901     rank default
 902       stop 240
 903     end select
 904     return
 905   end subroutine c_check_c_char_dm_ar
 906
 907   subroutine check_c_ucs4_char_l1()
 908     character(kind=c_ucs4_char, len=1), target :: a(n)
 909     !
 910     character(kind=c_ucs4_char, len=:), pointer :: p(:)
 911     !
 912     a = ref_c_ucs4_char_l1
 913     call f_check_c_ucs4_char_c1_as(a)
 914     if(any(a/=ref_c_ucs4_char_l1)) stop 241
 915     a = ref_c_ucs4_char_l1
 916     call c_check_c_ucs4_char_c1_as(a)
 917     if(any(a/=ref_c_ucs4_char_l1)) stop 242
 918     a = ref_c_ucs4_char_l1
 919     call f_check_c_ucs4_char_c1_ar(a)
 920     if(any(a/=ref_c_ucs4_char_l1)) stop 243
 921     a = ref_c_ucs4_char_l1
 922     call c_check_c_ucs4_char_c1_ar(a)
 923     if(any(a/=ref_c_ucs4_char_l1)) stop 244
 924     a = ref_c_ucs4_char_l1
 925     call f_check_c_ucs4_char_a1_as(a)
 926     if(any(a/=ref_c_ucs4_char_l1)) stop 245
 927     a = ref_c_ucs4_char_l1
 928     call c_check_c_ucs4_char_a1_as(a)
 929     if(any(a/=ref_c_ucs4_char_l1)) stop 246
 930     a = ref_c_ucs4_char_l1
 931     call f_check_c_ucs4_char_a1_ar(a)
 932     if(any(a/=ref_c_ucs4_char_l1)) stop 247
 933     a = ref_c_ucs4_char_l1
 934     call c_check_c_ucs4_char_a1_ar(a)
 935     if(any(a/=ref_c_ucs4_char_l1)) stop 248
 936     a = ref_c_ucs4_char_l1
 937     p => a
 938     call f_check_c_ucs4_char_d1_as(p)
 939     if(.not.associated(p)) stop 249
 940     if(.not.associated(p, a)) stop 250
 941     if(any(p/=ref_c_ucs4_char_l1)) stop 251
 942     if(any(a/=ref_c_ucs4_char_l1)) stop 252
 943     a = ref_c_ucs4_char_l1
 944     p => a
 945     call c_check_c_ucs4_char_d1_as(p)
 946     if(.not.associated(p)) stop 253
 947     if(.not.associated(p, a)) stop 254
 948     if(any(p/=ref_c_ucs4_char_l1)) stop 255
 949     if(any(a/=ref_c_ucs4_char_l1)) stop 256
 950     a = ref_c_ucs4_char_l1
 951     p => a
 952     call f_check_c_ucs4_char_d1_ar(p)
 953     if(.not.associated(p)) stop 257
 954     if(.not.associated(p, a)) stop 258
 955     if(any(p/=ref_c_ucs4_char_l1)) stop 259
 956     if(any(a/=ref_c_ucs4_char_l1)) stop 260
 957     a = ref_c_ucs4_char_l1
 958     p => a
 959     call c_check_c_ucs4_char_d1_ar(p)
 960     if(.not.associated(p)) stop 261
 961     if(.not.associated(p, a)) stop 262
 962     if(any(p/=ref_c_ucs4_char_l1)) stop 263
 963     if(any(a/=ref_c_ucs4_char_l1)) stop 264
 964     return
 965   end subroutine check_c_ucs4_char_l1
 966
 967   subroutine f_check_c_ucs4_char_c1_as(a)
 968     character(kind=c_ucs4_char, len=1), intent(in) :: a(:)
 969     !
 970     integer(kind=c_int16_t)     :: t
 971     integer(kind=c_signed_char) :: k
 972     integer(kind=c_size_t)      :: e, n
 973     !
 974     k = kind(a)
 975     n = len(a, kind=kind(e))
 976     e = storage_size(a, kind=kind(e))/(b*1)
 977     t = cfi_encode_type(CFI_type_Character, k)
 978     if(k<=0_c_signed_char) stop 265
 979     if(k/=4_c_signed_char) stop 266
 980     if(n/=1) stop 267
 981     if(int(k, kind=c_size_t)/=e) stop 268
 982     if(t/=CFI_type_ucs4_char) stop 269
 983     if(any(a/=ref_c_ucs4_char_l1)) stop 270
 984     call check_tk_as(a, t, k, e, n)
 985     if(any(a/=ref_c_ucs4_char_l1)) stop 271
 986     return
 987   end subroutine f_check_c_ucs4_char_c1_as
 988
 989   subroutine c_check_c_ucs4_char_c1_as(a) bind(c)
 990     character(kind=c_ucs4_char, len=1), intent(in) :: a(:)
 991     !
 992     integer(kind=c_int16_t)     :: t
 993     integer(kind=c_signed_char) :: k
 994     integer(kind=c_size_t)      :: e, n
 995     !
 996     k = kind(a)
 997     n = len(a, kind=kind(e))
 998     e = storage_size(a, kind=kind(e))/(b*1)
 999     t = cfi_encode_type(CFI_type_Character, k)
1000     if(k<=0_c_signed_char) stop 272
1001     if(k/=4_c_signed_char) stop 273
1002     if(n/=1) stop 274
1003     if(int(k, kind=c_size_t)/=e) stop 275
1004     if(t/=CFI_type_ucs4_char) stop 276
1005     if(any(a/=ref_c_ucs4_char_l1)) stop 277
1006     call check_tk_as(a, t, k, e, n)
1007     if(any(a/=ref_c_ucs4_char_l1)) stop 278
1008     return
1009   end subroutine c_check_c_ucs4_char_c1_as
1010
1011   subroutine f_check_c_ucs4_char_c1_ar(a)
1012     character(kind=c_ucs4_char, len=1), intent(in) :: a(..)
1013     !
1014     integer(kind=c_int16_t)     :: t
1015     integer(kind=c_signed_char) :: k
1016     integer(kind=c_size_t)      :: e, n
1017     !
1018     k = kind(a)
1019     n = len(a, kind=kind(e))
1020     e = storage_size(a, kind=kind(e))/(b*1)
1021     t = cfi_encode_type(CFI_type_Character, k)
1022     if(k<=0_c_signed_char) stop 279
1023     if(k/=4_c_signed_char) stop 280
1024     if(n/=1) stop 281
1025     if(int(k, kind=c_size_t)/=e) stop 282
1026     if(t/=CFI_type_ucs4_char) stop 283
1027     select rank(a)
1028     rank(1)
1029       if(any(a/=ref_c_ucs4_char_l1)) stop 284
1030     rank default
1031       stop 285
1032     end select
1033     call check_tk_ar(a, t, k, e, n)
1034     select rank(a)
1035     rank(1)
1036       if(any(a/=ref_c_ucs4_char_l1)) stop 286
1037     rank default
1038       stop 287
1039     end select
1040     return
1041   end subroutine f_check_c_ucs4_char_c1_ar
1042
1043   subroutine c_check_c_ucs4_char_c1_ar(a) bind(c)
1044     character(kind=c_ucs4_char, len=1), intent(in) :: a(..)
1045     !
1046     integer(kind=c_int16_t)     :: t
1047     integer(kind=c_signed_char) :: k
1048     integer(kind=c_size_t)      :: e, n
1049     !
1050     k = kind(a)
1051     n = len(a, kind=kind(e))
1052     e = storage_size(a, kind=kind(e))/(b*1)
1053     t = cfi_encode_type(CFI_type_Character, k)
1054     if(k<=0_c_signed_char) stop 288
1055     if(k/=4_c_signed_char) stop 289
1056     if(n/=1) stop 290
1057     if(int(k, kind=c_size_t)/=e) stop 291
1058     if(t/=CFI_type_ucs4_char) stop 292
1059     select rank(a)
1060     rank(1)
1061       if(any(a/=ref_c_ucs4_char_l1)) stop 293
1062     rank default
1063       stop 294
1064     end select
1065     call check_tk_ar(a, t, k, e, n)
1066     select rank(a)
1067     rank(1)
1068       if(any(a/=ref_c_ucs4_char_l1)) stop 295
1069     rank default
1070       stop 296
1071     end select
1072     return
1073   end subroutine c_check_c_ucs4_char_c1_ar
1074
1075   subroutine f_check_c_ucs4_char_a1_as(a)
1076     character(kind=c_ucs4_char, len=*), intent(in) :: a(:)
1077     !
1078     integer(kind=c_int16_t)     :: t
1079     integer(kind=c_signed_char) :: k
1080     integer(kind=c_size_t)      :: e, n
1081     !
1082     k = kind(a)
1083     n = len(a, kind=kind(e))
1084     e = storage_size(a, kind=kind(e))/(b*1)
1085     t = cfi_encode_type(CFI_type_Character, k)
1086     if(k<=0_c_signed_char) stop 297
1087     if(k/=4_c_signed_char) stop 298
1088     if(n/=1) stop 299
1089     if(int(k, kind=c_size_t)/=e) stop 300
1090     if(t/=CFI_type_ucs4_char) stop 301
1091     if(any(a/=ref_c_ucs4_char_l1)) stop 302
1092     call check_tk_as(a, t, k, e, n)
1093     if(any(a/=ref_c_ucs4_char_l1)) stop 303
1094     return
1095   end subroutine f_check_c_ucs4_char_a1_as
1096
1097   subroutine c_check_c_ucs4_char_a1_as(a) bind(c)
1098     character(kind=c_ucs4_char, len=*), intent(in) :: a(:)
1099     !
1100     integer(kind=c_int16_t)     :: t
1101     integer(kind=c_signed_char) :: k
1102     integer(kind=c_size_t)      :: e, n
1103     !
1104     k = kind(a)
1105     n = len(a, kind=kind(e))
1106     e = storage_size(a, kind=kind(e))/(b*1)
1107     t = cfi_encode_type(CFI_type_Character, k)
1108     if(k<=0_c_signed_char) stop 304
1109     if(k/=4_c_signed_char) stop 305
1110     if(n/=1) stop 306
1111     if(int(k, kind=c_size_t)/=e) stop 307
1112     if(t/=CFI_type_ucs4_char) stop 308
1113     if(any(a/=ref_c_ucs4_char_l1)) stop 309
1114     call check_tk_as(a, t, k, e, n)
1115     if(any(a/=ref_c_ucs4_char_l1)) stop 310
1116     return
1117   end subroutine c_check_c_ucs4_char_a1_as
1118
1119   subroutine f_check_c_ucs4_char_a1_ar(a)
1120     character(kind=c_ucs4_char, len=*), intent(in) :: a(..)
1121     !
1122     integer(kind=c_int16_t)     :: t
1123     integer(kind=c_signed_char) :: k
1124     integer(kind=c_size_t)      :: e, n
1125     !
1126     k = kind(a)
1127     n = len(a, kind=kind(e))
1128     e = storage_size(a, kind=kind(e))/(b*1)
1129     t = cfi_encode_type(CFI_type_Character, k)
1130     if(k<=0_c_signed_char) stop 311
1131     if(k/=4_c_signed_char) stop 312
1132     if(n/=1) stop 313
1133     if(int(k, kind=c_size_t)/=e) stop 314
1134     if(t/=CFI_type_ucs4_char) stop 315
1135     select rank(a)
1136     rank(1)
1137       if(any(a/=ref_c_ucs4_char_l1)) stop 316
1138     rank default
1139       stop 317
1140     end select
1141     call check_tk_ar(a, t, k, e, n)
1142     select rank(a)
1143     rank(1)
1144       if(any(a/=ref_c_ucs4_char_l1)) stop 318
1145     rank default
1146       stop 319
1147     end select
1148     return
1149   end subroutine f_check_c_ucs4_char_a1_ar
1150
1151   subroutine c_check_c_ucs4_char_a1_ar(a) bind(c)
1152     character(kind=c_ucs4_char, len=*), intent(in) :: a(..)
1153     !
1154     integer(kind=c_int16_t)     :: t
1155     integer(kind=c_signed_char) :: k
1156     integer(kind=c_size_t)      :: e, n
1157     !
1158     k = kind(a)
1159     n = len(a, kind=kind(e))
1160     e = storage_size(a, kind=kind(e))/(b*1)
1161     t = cfi_encode_type(CFI_type_Character, k)
1162     if(k<=0_c_signed_char) stop 320
1163     if(k/=4_c_signed_char) stop 321
1164     if(n/=1) stop 322
1165     if(int(k, kind=c_size_t)/=e) stop 323
1166     if(t/=CFI_type_ucs4_char) stop 324
1167     select rank(a)
1168     rank(1)
1169       if(any(a/=ref_c_ucs4_char_l1)) stop 325
1170     rank default
1171       stop 326
1172     end select
1173     call check_tk_ar(a, t, k, e, n)
1174     select rank(a)
1175     rank(1)
1176       if(any(a/=ref_c_ucs4_char_l1)) stop 327
1177     rank default
1178       stop 328
1179     end select
1180     return
1181   end subroutine c_check_c_ucs4_char_a1_ar
1182
1183   subroutine f_check_c_ucs4_char_d1_as(a)
1184     character(kind=c_ucs4_char, len=:), pointer, intent(in) :: a(:)
1185     !
1186     integer(kind=c_int16_t)     :: t
1187     integer(kind=c_signed_char) :: k
1188     integer(kind=c_size_t)      :: e, n
1189     !
1190     k = kind(a)
1191     n = len(a, kind=kind(e))
1192     e = storage_size(a, kind=kind(e))/(b*1)
1193     t = cfi_encode_type(CFI_type_Character, k)
1194     if(k<=0_c_signed_char) stop 329
1195     if(k/=4_c_signed_char) stop 330
1196     if(n/=1) stop 331
1197     if(int(k, kind=c_size_t)/=e) stop 332
1198     if(t/=CFI_type_ucs4_char) stop 333
1199     if(any(a/=ref_c_ucs4_char_l1)) stop 334
1200     call check_tk_as(a, t, k, e, n)
1201     if(any(a/=ref_c_ucs4_char_l1)) stop 335
1202     return
1203   end subroutine f_check_c_ucs4_char_d1_as
1204
1205   subroutine c_check_c_ucs4_char_d1_as(a) bind(c)
1206     character(kind=c_ucs4_char, len=:), pointer, intent(in) :: a(:)
1207     !
1208     integer(kind=c_int16_t)     :: t
1209     integer(kind=c_signed_char) :: k
1210     integer(kind=c_size_t)      :: e, n
1211     !
1212     k = kind(a)
1213     n = len(a, kind=kind(e))
1214     e = storage_size(a, kind=kind(e))/(b*1)
1215     t = cfi_encode_type(CFI_type_Character, k)
1216     if(k<=0_c_signed_char) stop 336
1217     if(k/=4_c_signed_char) stop 337
1218     if(n/=1) stop 338
1219     if(int(k, kind=c_size_t)/=e) stop 339
1220     if(t/=CFI_type_ucs4_char) stop 340
1221     if(any(a/=ref_c_ucs4_char_l1)) stop 341
1222     call check_tk_as(a, t, k, e, n)
1223     if(any(a/=ref_c_ucs4_char_l1)) stop 342
1224     return
1225   end subroutine c_check_c_ucs4_char_d1_as
1226
1227   subroutine f_check_c_ucs4_char_d1_ar(a)
1228     character(kind=c_ucs4_char, len=:), pointer, intent(in) :: a(..)
1229     !
1230     integer(kind=c_int16_t)     :: t
1231     integer(kind=c_signed_char) :: k
1232     integer(kind=c_size_t)      :: e, n
1233     !
1234     k = kind(a)
1235     n = len(a, kind=kind(e))
1236     e = storage_size(a, kind=kind(e))/(b*1)
1237     t = cfi_encode_type(CFI_type_Character, k)
1238     if(k<=0_c_signed_char) stop 343
1239     if(k/=4_c_signed_char) stop 344
1240     if(n/=1) stop 345
1241     if(int(k, kind=c_size_t)/=e) stop 346
1242     if(t/=CFI_type_ucs4_char) stop 347
1243     select rank(a)
1244     rank(1)
1245       if(any(a/=ref_c_ucs4_char_l1)) stop 348
1246     rank default
1247       stop 349
1248     end select
1249     call check_tk_ar(a, t, k, e, n)
1250     select rank(a)
1251     rank(1)
1252       if(any(a/=ref_c_ucs4_char_l1)) stop 350
1253     rank default
1254       stop 351
1255     end select
1256     return
1257   end subroutine f_check_c_ucs4_char_d1_ar
1258
1259   subroutine c_check_c_ucs4_char_d1_ar(a) bind(c)
1260     character(kind=c_ucs4_char, len=:), pointer, intent(in) :: a(..)
1261     !
1262     integer(kind=c_int16_t)     :: t
1263     integer(kind=c_signed_char) :: k
1264     integer(kind=c_size_t)      :: e, n
1265     !
1266     k = kind(a)
1267     n = len(a, kind=kind(e))
1268     e = storage_size(a, kind=kind(e))/(b*1)
1269     t = cfi_encode_type(CFI_type_Character, k)
1270     if(k<=0_c_signed_char) stop 352
1271     if(k/=4_c_signed_char) stop 353
1272     if(n/=1) stop 354
1273     if(int(k, kind=c_size_t)/=e) stop 355
1274     if(t/=CFI_type_ucs4_char) stop 356
1275     select rank(a)
1276     rank(1)
1277       if(any(a/=ref_c_ucs4_char_l1)) stop 357
1278     rank default
1279       stop 358
1280     end select
1281     call check_tk_ar(a, t, k, e, n)
1282     select rank(a)
1283     rank(1)
1284       if(any(a/=ref_c_ucs4_char_l1)) stop 359
1285     rank default
1286       stop 360
1287     end select
1288     return
1289   end subroutine c_check_c_ucs4_char_d1_ar
1290
1291   subroutine check_c_ucs4_char_lm()
1292     character(kind=c_ucs4_char, len=m), target :: a(n)
1293     !
1294     character(kind=c_ucs4_char, len=:), pointer :: p(:)
1295     !
1296     a = ref_c_ucs4_char_lm
1297     call f_check_c_ucs4_char_cm_as(a)
1298     if(any(a/=ref_c_ucs4_char_lm)) stop 361
1299     a = ref_c_ucs4_char_lm
1300     call c_check_c_ucs4_char_cm_as(a)
1301     if(any(a/=ref_c_ucs4_char_lm)) stop 362
1302     a = ref_c_ucs4_char_lm
1303     call f_check_c_ucs4_char_cm_ar(a)
1304     if(any(a/=ref_c_ucs4_char_lm)) stop 363
1305     a = ref_c_ucs4_char_lm
1306     call c_check_c_ucs4_char_cm_ar(a)
1307     if(any(a/=ref_c_ucs4_char_lm)) stop 364
1308     a = ref_c_ucs4_char_lm
1309     call f_check_c_ucs4_char_am_as(a)
1310     if(any(a/=ref_c_ucs4_char_lm)) stop 365
1311     a = ref_c_ucs4_char_lm
1312     call c_check_c_ucs4_char_am_as(a)
1313     if(any(a/=ref_c_ucs4_char_lm)) stop 366
1314     a = ref_c_ucs4_char_lm
1315     call f_check_c_ucs4_char_am_ar(a)
1316     if(any(a/=ref_c_ucs4_char_lm)) stop 367
1317     a = ref_c_ucs4_char_lm
1318     call c_check_c_ucs4_char_am_ar(a)
1319     if(any(a/=ref_c_ucs4_char_lm)) stop 368
1320     a = ref_c_ucs4_char_lm
1321     p => a
1322     call f_check_c_ucs4_char_dm_as(p)
1323     if(.not.associated(p)) stop 369
1324     if(.not.associated(p, a)) stop 370
1325     if(any(p/=ref_c_ucs4_char_lm)) stop 371
1326     if(any(a/=ref_c_ucs4_char_lm)) stop 372
1327     a = ref_c_ucs4_char_lm
1328     p => a
1329     call c_check_c_ucs4_char_dm_as(p)
1330     if(.not.associated(p)) stop 373
1331     if(.not.associated(p, a)) stop 374
1332     if(any(p/=ref_c_ucs4_char_lm)) stop 375
1333     if(any(a/=ref_c_ucs4_char_lm)) stop 376
1334     a = ref_c_ucs4_char_lm
1335     p => a
1336     call f_check_c_ucs4_char_dm_ar(p)
1337     if(.not.associated(p)) stop 377
1338     if(.not.associated(p, a)) stop 378
1339     if(any(p/=ref_c_ucs4_char_lm)) stop 379
1340     if(any(a/=ref_c_ucs4_char_lm)) stop 380
1341     a = ref_c_ucs4_char_lm
1342     p => a
1343     call c_check_c_ucs4_char_dm_ar(p)
1344     if(.not.associated(p)) stop 381
1345     if(.not.associated(p, a)) stop 382
1346     if(any(p/=ref_c_ucs4_char_lm)) stop 383
1347     if(any(a/=ref_c_ucs4_char_lm)) stop 384
1348     return
1349   end subroutine check_c_ucs4_char_lm
1350
1351   subroutine f_check_c_ucs4_char_cm_as(a)
1352     character(kind=c_ucs4_char, len=m), intent(in) :: a(:)
1353     !
1354     integer(kind=c_int16_t)     :: t
1355     integer(kind=c_signed_char) :: k
1356     integer(kind=c_size_t)      :: e, n
1357     !
1358     k = kind(a)
1359     n = len(a, kind=kind(e))
1360     e = storage_size(a, kind=kind(e))/(b*m)
1361     t = cfi_encode_type(CFI_type_Character, k)
1362     if(k<=0_c_signed_char) stop 385
1363     if(k/=4_c_signed_char) stop 386
1364     if(n/=m) stop 387
1365     if(int(k, kind=c_size_t)/=e) stop 388
1366     if(t/=CFI_type_ucs4_char) stop 389
1367     if(any(a/=ref_c_ucs4_char_lm)) stop 390
1368     call check_tk_as(a, t, k, e, n)
1369     if(any(a/=ref_c_ucs4_char_lm)) stop 391
1370     return
1371   end subroutine f_check_c_ucs4_char_cm_as
1372
1373   subroutine c_check_c_ucs4_char_cm_as(a) bind(c)
1374     character(kind=c_ucs4_char, len=m), intent(in) :: a(:)
1375     !
1376     integer(kind=c_int16_t)     :: t
1377     integer(kind=c_signed_char) :: k
1378     integer(kind=c_size_t)      :: e, n
1379     !
1380     k = kind(a)
1381     n = len(a, kind=kind(e))
1382     e = storage_size(a, kind=kind(e))/(b*m)
1383     t = cfi_encode_type(CFI_type_Character, k)
1384     if(k<=0_c_signed_char) stop 392
1385     if(k/=4_c_signed_char) stop 393
1386     if(n/=m) stop 394
1387     if(int(k, kind=c_size_t)/=e) stop 395
1388     if(t/=CFI_type_ucs4_char) stop 396
1389     if(any(a/=ref_c_ucs4_char_lm)) stop 397
1390     call check_tk_as(a, t, k, e, n)
1391     if(any(a/=ref_c_ucs4_char_lm)) stop 398
1392     return
1393   end subroutine c_check_c_ucs4_char_cm_as
1394
1395   subroutine f_check_c_ucs4_char_cm_ar(a)
1396     character(kind=c_ucs4_char, len=m), intent(in) :: a(..)
1397     !
1398     integer(kind=c_int16_t)     :: t
1399     integer(kind=c_signed_char) :: k
1400     integer(kind=c_size_t)      :: e, n
1401     !
1402     k = kind(a)
1403     n = len(a, kind=kind(e))
1404     e = storage_size(a, kind=kind(e))/(b*m)
1405     t = cfi_encode_type(CFI_type_Character, k)
1406     if(k<=0_c_signed_char) stop 399
1407     if(k/=4_c_signed_char) stop 400
1408     if(n/=m) stop 401
1409     if(int(k, kind=c_size_t)/=e) stop 402
1410     if(t/=CFI_type_ucs4_char) stop 403
1411     select rank(a)
1412     rank(1)
1413       if(any(a/=ref_c_ucs4_char_lm)) stop 404
1414     rank default
1415       stop 405
1416     end select
1417     call check_tk_ar(a, t, k, e, n)
1418     select rank(a)
1419     rank(1)
1420       if(any(a/=ref_c_ucs4_char_lm)) stop 406
1421     rank default
1422       stop 407
1423     end select
1424     return
1425   end subroutine f_check_c_ucs4_char_cm_ar
1426
1427   subroutine c_check_c_ucs4_char_cm_ar(a) bind(c)
1428     character(kind=c_ucs4_char, len=m), intent(in) :: a(..)
1429     !
1430     integer(kind=c_int16_t)     :: t
1431     integer(kind=c_signed_char) :: k
1432     integer(kind=c_size_t)      :: e, n
1433     !
1434     k = kind(a)
1435     n = len(a, kind=kind(e))
1436     e = storage_size(a, kind=kind(e))/(b*m)
1437     t = cfi_encode_type(CFI_type_Character, k)
1438     if(k<=0_c_signed_char) stop 408
1439     if(k/=4_c_signed_char) stop 409
1440     if(n/=m) stop 410
1441     if(int(k, kind=c_size_t)/=e) stop 411
1442     if(t/=CFI_type_ucs4_char) stop 412
1443     select rank(a)
1444     rank(1)
1445       if(any(a/=ref_c_ucs4_char_lm)) stop 413
1446     rank default
1447       stop 414
1448     end select
1449     call check_tk_ar(a, t, k, e, n)
1450     select rank(a)
1451     rank(1)
1452       if(any(a/=ref_c_ucs4_char_lm)) stop 415
1453     rank default
1454       stop 416
1455     end select
1456     return
1457   end subroutine c_check_c_ucs4_char_cm_ar
1458
1459   subroutine f_check_c_ucs4_char_am_as(a)
1460     character(kind=c_ucs4_char, len=*), intent(in) :: a(:)
1461     !
1462     integer(kind=c_int16_t)     :: t
1463     integer(kind=c_signed_char) :: k
1464     integer(kind=c_size_t)      :: e, n
1465     !
1466     k = kind(a)
1467     n = len(a, kind=kind(e))
1468     e = storage_size(a, kind=kind(e))/(b*m)
1469     t = cfi_encode_type(CFI_type_Character, k)
1470     if(k<=0_c_signed_char) stop 417
1471     if(k/=4_c_signed_char) stop 418
1472     if(n/=m) stop 419
1473     if(int(k, kind=c_size_t)/=e) stop 420
1474     if(t/=CFI_type_ucs4_char) stop 421
1475     if(any(a/=ref_c_ucs4_char_lm)) stop 422
1476     call check_tk_as(a, t, k, e, n)
1477     if(any(a/=ref_c_ucs4_char_lm)) stop 423
1478     return
1479   end subroutine f_check_c_ucs4_char_am_as
1480
1481   subroutine c_check_c_ucs4_char_am_as(a) bind(c)
1482     character(kind=c_ucs4_char, len=*), intent(in) :: a(:)
1483     !
1484     integer(kind=c_int16_t)     :: t
1485     integer(kind=c_signed_char) :: k
1486     integer(kind=c_size_t)      :: e, n
1487     !
1488     k = kind(a)
1489     n = len(a, kind=kind(e))
1490     e = storage_size(a, kind=kind(e))/(b*m)
1491     t = cfi_encode_type(CFI_type_Character, k)
1492     if(k<=0_c_signed_char) stop 424
1493     if(k/=4_c_signed_char) stop 425
1494     if(n/=m) stop 426
1495     if(int(k, kind=c_size_t)/=e) stop 427
1496     if(t/=CFI_type_ucs4_char) stop 428
1497     if(any(a/=ref_c_ucs4_char_lm)) stop 429
1498     call check_tk_as(a, t, k, e, n)
1499     if(any(a/=ref_c_ucs4_char_lm)) stop 430
1500     return
1501   end subroutine c_check_c_ucs4_char_am_as
1502
1503   subroutine f_check_c_ucs4_char_am_ar(a)
1504     character(kind=c_ucs4_char, len=*), intent(in) :: a(..)
1505     !
1506     integer(kind=c_int16_t)     :: t
1507     integer(kind=c_signed_char) :: k
1508     integer(kind=c_size_t)      :: e, n
1509     !
1510     k = kind(a)
1511     n = len(a, kind=kind(e))
1512     e = storage_size(a, kind=kind(e))/(b*m)
1513     t = cfi_encode_type(CFI_type_Character, k)
1514     if(k<=0_c_signed_char) stop 431
1515     if(k/=4_c_signed_char) stop 432
1516     if(n/=m) stop 433
1517     if(int(k, kind=c_size_t)/=e) stop 434
1518     if(t/=CFI_type_ucs4_char) stop 435
1519     select rank(a)
1520     rank(1)
1521       if(any(a/=ref_c_ucs4_char_lm)) stop 436
1522     rank default
1523       stop 437
1524     end select
1525     call check_tk_ar(a, t, k, e, n)
1526     select rank(a)
1527     rank(1)
1528       if(any(a/=ref_c_ucs4_char_lm)) stop 438
1529     rank default
1530       stop 439
1531     end select
1532     return
1533   end subroutine f_check_c_ucs4_char_am_ar
1534
1535   subroutine c_check_c_ucs4_char_am_ar(a) bind(c)
1536     character(kind=c_ucs4_char, len=*), intent(in) :: a(..)
1537     !
1538     integer(kind=c_int16_t)     :: t
1539     integer(kind=c_signed_char) :: k
1540     integer(kind=c_size_t)      :: e, n
1541     !
1542     k = kind(a)
1543     n = len(a, kind=kind(e))
1544     e = storage_size(a, kind=kind(e))/(b*m)
1545     t = cfi_encode_type(CFI_type_Character, k)
1546     if(k<=0_c_signed_char) stop 440
1547     if(k/=4_c_signed_char) stop 441
1548     if(n/=m) stop 442
1549     if(int(k, kind=c_size_t)/=e) stop 443
1550     if(t/=CFI_type_ucs4_char) stop 444
1551     select rank(a)
1552     rank(1)
1553       if(any(a/=ref_c_ucs4_char_lm)) stop 445
1554     rank default
1555       stop 446
1556     end select
1557     call check_tk_ar(a, t, k, e, n)
1558     select rank(a)
1559     rank(1)
1560       if(any(a/=ref_c_ucs4_char_lm)) stop 447
1561     rank default
1562       stop 448
1563     end select
1564     return
1565   end subroutine c_check_c_ucs4_char_am_ar
1566
1567   subroutine f_check_c_ucs4_char_dm_as(a)
1568     character(kind=c_ucs4_char, len=:), pointer, intent(in) :: a(:)
1569     !
1570     integer(kind=c_int16_t)     :: t
1571     integer(kind=c_signed_char) :: k
1572     integer(kind=c_size_t)      :: e, n
1573     !
1574     k = kind(a)
1575     n = len(a, kind=kind(e))
1576     e = storage_size(a, kind=kind(e))/(b*m)
1577     t = cfi_encode_type(CFI_type_Character, k)
1578     if(k<=0_c_signed_char) stop 449
1579     if(k/=4_c_signed_char) stop 450
1580     if(n/=m) stop 451
1581     if(int(k, kind=c_size_t)/=e) stop 452
1582     if(t/=CFI_type_ucs4_char) stop 453
1583     if(any(a/=ref_c_ucs4_char_lm)) stop 454
1584     call check_tk_as(a, t, k, e, n)
1585     if(any(a/=ref_c_ucs4_char_lm)) stop 455
1586     return
1587   end subroutine f_check_c_ucs4_char_dm_as
1588
1589   subroutine c_check_c_ucs4_char_dm_as(a) bind(c)
1590     character(kind=c_ucs4_char, len=:), pointer, intent(in) :: a(:)
1591     !
1592     integer(kind=c_int16_t)     :: t
1593     integer(kind=c_signed_char) :: k
1594     integer(kind=c_size_t)      :: e, n
1595     !
1596     k = kind(a)
1597     n = len(a, kind=kind(e))
1598     e = storage_size(a, kind=kind(e))/(b*m)
1599     t = cfi_encode_type(CFI_type_Character, k)
1600     if(k<=0_c_signed_char) stop 456
1601     if(k/=4_c_signed_char) stop 457
1602     if(n/=m) stop 458
1603     if(int(k, kind=c_size_t)/=e) stop 459
1604     if(t/=CFI_type_ucs4_char) stop 460
1605     if(any(a/=ref_c_ucs4_char_lm)) stop 461
1606     call check_tk_as(a, t, k, e, n)
1607     if(any(a/=ref_c_ucs4_char_lm)) stop 462
1608     return
1609   end subroutine c_check_c_ucs4_char_dm_as
1610
1611   subroutine f_check_c_ucs4_char_dm_ar(a)
1612     character(kind=c_ucs4_char, len=:), pointer, intent(in) :: a(..)
1613     !
1614     integer(kind=c_int16_t)     :: t
1615     integer(kind=c_signed_char) :: k
1616     integer(kind=c_size_t)      :: e, n
1617     !
1618     k = kind(a)
1619     n = len(a, kind=kind(e))
1620     e = storage_size(a, kind=kind(e))/(b*m)
1621     t = cfi_encode_type(CFI_type_Character, k)
1622     if(k<=0_c_signed_char) stop 463
1623     if(k/=4_c_signed_char) stop 464
1624     if(n/=m) stop 465
1625     if(int(k, kind=c_size_t)/=e) stop 466
1626     if(t/=CFI_type_ucs4_char) stop 467
1627     select rank(a)
1628     rank(1)
1629       if(any(a/=ref_c_ucs4_char_lm)) stop 468
1630     rank default
1631       stop 469
1632     end select
1633     call check_tk_ar(a, t, k, e, n)
1634     select rank(a)
1635     rank(1)
1636       if(any(a/=ref_c_ucs4_char_lm)) stop 470
1637     rank default
1638       stop 471
1639     end select
1640     return
1641   end subroutine f_check_c_ucs4_char_dm_ar
1642
1643   subroutine c_check_c_ucs4_char_dm_ar(a) bind(c)
1644     character(kind=c_ucs4_char, len=:), pointer, intent(in) :: a(..)
1645     !
1646     integer(kind=c_int16_t)     :: t
1647     integer(kind=c_signed_char) :: k
1648     integer(kind=c_size_t)      :: e, n
1649     !
1650     k = kind(a)
1651     n = len(a, kind=kind(e))
1652     e = storage_size(a, kind=kind(e))/(b*m)
1653     t = cfi_encode_type(CFI_type_Character, k)
1654     if(k<=0_c_signed_char) stop 472
1655     if(k/=4_c_signed_char) stop 473
1656     if(n/=m) stop 474
1657     if(int(k, kind=c_size_t)/=e) stop 475
1658     if(t/=CFI_type_ucs4_char) stop 476
1659     select rank(a)
1660     rank(1)
1661       if(any(a/=ref_c_ucs4_char_lm)) stop 477
1662     rank default
1663       stop 478
1664     end select
1665     call check_tk_ar(a, t, k, e, n)
1666     select rank(a)
1667     rank(1)
1668       if(any(a/=ref_c_ucs4_char_lm)) stop 479
1669     rank default
1670       stop 480
1671     end select
1672     return
1673   end subroutine c_check_c_ucs4_char_dm_ar
1674
1675 end module iso_check_m
1676
1677 program main_p
1678
1679   use :: iso_check_m, only: &
1680     check_c_char_l1,        &
1681     check_c_char_lm,        &
1682     check_c_ucs4_char_l1,   &
1683     check_c_ucs4_char_lm
1684
1685   implicit none
1686
1687   call check_c_char_l1()
1688   call check_c_char_lm()
1689   ! See PR100907
1690   !call check_c_ucs4_char_l1()
1691   !call check_c_ucs4_char_lm()
1692   stop
1693
1694 end program main_p
1695
1696 !! Local Variables:
1697 !! mode: f90
1698 !! End:
1699