gcc/testsuite/gfortran.dg/PR100914.f90

   1 ! Fails on x86 targets where sizeof(long double) == 16.
   2 ! { dg-do run }
   3 ! { dg-additional-sources PR100914.c }
   4 ! { dg-require-effective-target fortran_real_c_float128 }
   5 ! { dg-additional-options "-Wno-pedantic" }
   6 !
   7 ! Test the fix for PR100914
   8 !
   9
  10 module isof_m
  11
  12   use, intrinsic :: iso_c_binding, only: &
  13     c_signed_char, c_int16_t
  14
  15   implicit none
  16
  17   private
  18
  19   public ::                       &
  20     CFI_type_Complex,             &
  21     CFI_type_float_Complex,       &
  22     CFI_type_double_Complex,      &
  23     CFI_type_long_double_Complex, &
  24     CFI_type_float128_Complex
  25
  26   public ::      &
  27     check_tk_as, &
  28     check_tk_ar
  29
  30
  31   public ::          &
  32     cfi_encode_type
  33
  34   integer, parameter :: CFI_type_t = c_int16_t
  35
  36   integer(kind=c_int16_t), parameter :: CFI_type_mask = int(z"FF", kind=c_int16_t)
  37   integer(kind=c_int16_t), parameter :: CFI_type_kind_shift = 8_c_int16_t
  38
  39   ! Intrinsic types. Their kind number defines their storage size. */
  40   integer(kind=c_signed_char), parameter :: CFI_type_Complex = 4
  41
  42   ! C-Fortran Interoperability types.
  43   integer(kind=cfi_type_t), parameter :: CFI_type_float_Complex = &
  44     ior(int(CFI_type_Complex, kind=c_int16_t), shiftl(4_c_int16_t, CFI_type_kind_shift))
  45   integer(kind=cfi_type_t), parameter :: CFI_type_double_Complex = &
  46     ior(int(CFI_type_Complex, kind=c_int16_t), shiftl(8_c_int16_t, CFI_type_kind_shift))
  47   integer(kind=cfi_type_t), parameter :: CFI_type_long_double_Complex = &
  48     ior(int(CFI_type_Complex, kind=c_int16_t), shiftl(10_c_int16_t, CFI_type_kind_shift))
  49   integer(kind=cfi_type_t), parameter :: CFI_type_float128_Complex = &
  50     ior(int(CFI_type_Complex, kind=c_int16_t), shiftl(16_c_int16_t, CFI_type_kind_shift))
  51
  52   interface
  53     subroutine check_tk_as(a, t, k, e, n) &
  54       bind(c, name="check_tk")
  55       use, intrinsic :: iso_c_binding, only: &
  56         c_int16_t, c_signed_char, c_size_t
  57       implicit none
  58       type(*),                       intent(in) :: a(:)
  59       integer(c_int16_t),     value, intent(in) :: t
  60       integer(c_signed_char), value, intent(in) :: k
  61       integer(c_size_t),      value, intent(in) :: e
  62       integer(c_size_t),      value, intent(in) :: n
  63     end subroutine check_tk_as
  64     subroutine check_tk_ar(a, t, k, e, n) &
  65       bind(c, name="check_tk")
  66       use, intrinsic :: iso_c_binding, only: &
  67         c_int16_t, c_signed_char, c_size_t
  68       implicit none
  69       type(*),                       intent(in) :: a(..)
  70       integer(c_int16_t),     value, intent(in) :: t
  71       integer(c_signed_char), value, intent(in) :: k
  72       integer(c_size_t),      value, intent(in) :: e
  73       integer(c_size_t),      value, intent(in) :: n
  74     end subroutine check_tk_ar
  75   end interface
  76
  77 contains
  78
  79   elemental function cfi_encode_type(type, kind) result(itype)
  80     integer(kind=c_signed_char), intent(in) :: type
  81     integer(kind=c_signed_char), intent(in) :: kind
  82
  83     integer(kind=c_int16_t) :: itype, ikind
  84
  85     itype = int(type, kind=c_int16_t)
  86     itype = iand(itype, CFI_type_mask)
  87     ikind = int(kind, kind=c_int16_t)
  88     ikind = iand(ikind, CFI_type_mask)
  89     ikind = shiftl(ikind, CFI_type_kind_shift)
  90     itype = ior(ikind, itype)
  91     return
  92   end function cfi_encode_type
  93
  94 end module isof_m
  95
  96 module iso_check_m
  97
  98   use, intrinsic :: iso_c_binding, only: &
  99     c_signed_char, c_int16_t, c_size_t
 100
 101   use, intrinsic :: iso_c_binding, only: &
 102     c_float_complex,                      &
 103     c_double_complex,                     &
 104     c_long_double_complex,                &
 105     c_float128_complex
 106
 107   use :: isof_m, only:  &
 108     CFI_type_Complex
 109
 110   use :: isof_m, only:            &
 111     CFI_type_float_Complex,       &
 112     CFI_type_double_Complex,      &
 113     CFI_type_long_double_Complex, &
 114     CFI_type_float128_Complex
 115
 116   use :: isof_m, only: &
 117     check_tk_as,       &
 118     check_tk_ar
 119
 120   use :: isof_m, only: &
 121     cfi_encode_type
 122
 123   implicit none
 124
 125   private
 126
 127   public ::                      &
 128     check_c_float_complex,       &
 129     check_c_double_complex,      &
 130     check_c_long_double_complex, &
 131     check_c_float128_complex
 132
 133   integer                           :: i
 134   integer(kind=c_size_t), parameter :: b = 8
 135   integer,                parameter :: n = 11
 136
 137   complex(kind=c_float_complex), parameter :: ref_c_float_complex(*)  = &
 138     [(cmplx(i, 2*i, kind=c_float_complex),  i=1,n)]
 139   complex(kind=c_double_complex), parameter :: ref_c_double_complex(*)  = &
 140     [(cmplx(i, 2*i, kind=c_double_complex),  i=1,n)]
 141   complex(kind=c_long_double_complex), parameter :: ref_c_long_double_complex(*)  = &
 142     [(cmplx(i, 2*i, kind=c_long_double_complex),  i=1,n)]
 143   complex(kind=c_float128_complex), parameter :: ref_c_float128_complex(*)  = &
 144     [(cmplx(i, 2*i, kind=c_float128_complex),  i=1,n)]
 145
 146 contains
 147
 148   ! CFI_type_float_complex
 149   subroutine check_c_float_complex()
 150     complex(kind=c_float_complex) :: a(n)
 151     !
 152     if (c_float_complex/=4) stop 1
 153     a = ref_c_float_complex
 154     call f_check_c_float_complex_as(a)
 155     if(any(abs(a-ref_c_float_complex)>0.0_c_float_complex)) stop 2
 156     a = ref_c_float_complex
 157     call c_check_c_float_complex_as(a)
 158     if(any(abs(a-ref_c_float_complex)>0.0_c_float_complex)) stop 3
 159     a = ref_c_float_complex
 160     call f_check_c_float_complex_ar(a)
 161     if(any(abs(a-ref_c_float_complex)>0.0_c_float_complex)) stop 4
 162     a = ref_c_float_complex
 163     call c_check_c_float_complex_ar(a)
 164     if(any(abs(a-ref_c_float_complex)>0.0_c_float_complex)) stop 5
 165     return
 166   end subroutine check_c_float_complex
 167
 168   subroutine f_check_c_float_complex_as(a)
 169     complex(kind=c_float_complex), intent(in) :: a(:)
 170     !
 171     integer(kind=c_int16_t)     :: t
 172     integer(kind=c_signed_char) :: k
 173     integer(kind=c_size_t)      :: e
 174     !
 175     k = kind(a)
 176     e = storage_size(a)/b
 177     t = cfi_encode_type(CFI_type_complex, k)
 178     if(k<=0_c_signed_char) stop 6
 179     if(k/=4_c_signed_char) stop 7
 180     if(int(k, kind=c_size_t)/=(e/2)) stop 8
 181     if(t/=CFI_type_float_complex) stop 9
 182     if(any(abs(a-ref_c_float_complex)>0.0_c_float_complex)) stop 10
 183     call check_tk_as(a, t, k, e, 1_c_size_t)
 184     if(any(abs(a-ref_c_float_complex)>0.0_c_float_complex)) stop 11
 185     return
 186   end subroutine f_check_c_float_complex_as
 187
 188   subroutine c_check_c_float_complex_as(a) bind(c)
 189     complex(kind=c_float_complex), intent(in) :: a(:)
 190     !
 191     integer(kind=c_int16_t)     :: t
 192     integer(kind=c_signed_char) :: k
 193     integer(kind=c_size_t)      :: e
 194     !
 195     k = kind(a)
 196     e = storage_size(a)/b
 197     t = cfi_encode_type(CFI_type_complex, k)
 198     if(k<=0_c_signed_char) stop 12
 199     if(k/=4_c_signed_char) stop 13
 200     if(int(k, kind=c_size_t)/=(e/2)) stop 14
 201     if(t/=CFI_type_float_complex) stop 15
 202     if(any(abs(a-ref_c_float_complex)>0.0_c_float_complex)) stop 16
 203     call check_tk_as(a, t, k, e, 1_c_size_t)
 204     if(any(abs(a-ref_c_float_complex)>0.0_c_float_complex)) stop 17
 205     return
 206   end subroutine c_check_c_float_complex_as
 207
 208   subroutine f_check_c_float_complex_ar(a)
 209     complex(kind=c_float_complex), intent(in) :: a(..)
 210     !
 211     integer(kind=c_int16_t)     :: t
 212     integer(kind=c_signed_char) :: k
 213     integer(kind=c_size_t)      :: e
 214     !
 215     k = kind(a)
 216     e = storage_size(a)/b
 217     t = cfi_encode_type(CFI_type_complex, k)
 218     if(k<=0_c_signed_char) stop 18
 219     if(k/=4_c_signed_char) stop 19
 220     if(int(k, kind=c_size_t)/=(e/2)) stop 20
 221     if(t/=CFI_type_float_complex) stop 21
 222     select rank(a)
 223     rank(1)
 224       if(any(abs(a-ref_c_float_complex)>0.0_c_float_complex)) stop 22
 225     rank default
 226       stop 23
 227     end select
 228     call check_tk_ar(a, t, k, e, 1_c_size_t)
 229     select rank(a)
 230     rank(1)
 231       if(any(abs(a-ref_c_float_complex)>0.0_c_float_complex)) stop 24
 232     rank default
 233       stop 25
 234     end select
 235     return
 236   end subroutine f_check_c_float_complex_ar
 237
 238   subroutine c_check_c_float_complex_ar(a) bind(c)
 239     complex(kind=c_float_complex), intent(in) :: a(..)
 240     !
 241     integer(kind=c_int16_t)     :: t
 242     integer(kind=c_signed_char) :: k
 243     integer(kind=c_size_t)      :: e
 244     !
 245     k = kind(a)
 246     e = storage_size(a)/b
 247     t = cfi_encode_type(CFI_type_complex, k)
 248     if(k<=0_c_signed_char) stop 26
 249     if(k/=4_c_signed_char) stop 27
 250     if(int(k, kind=c_size_t)/=(e/2)) stop 28
 251     if(t/=CFI_type_float_complex) stop 29
 252     select rank(a)
 253     rank(1)
 254       if(any(abs(a-ref_c_float_complex)>0.0_c_float_complex)) stop 30
 255     rank default
 256       stop 31
 257     end select
 258     call check_tk_ar(a, t, k, e, 1_c_size_t)
 259     select rank(a)
 260     rank(1)
 261       if(any(abs(a-ref_c_float_complex)>0.0_c_float_complex)) stop 32
 262     rank default
 263       stop 33
 264     end select
 265     return
 266   end subroutine c_check_c_float_complex_ar
 267
 268   ! CFI_type_double_complex
 269   subroutine check_c_double_complex()
 270     complex(kind=c_double_complex) :: a(n)
 271     !
 272     if (c_double_complex/=8) stop 34
 273     a = ref_c_double_complex
 274     call f_check_c_double_complex_as(a)
 275     if(any(abs(a-ref_c_double_complex)>0.0_c_double_complex)) stop 35
 276     a = ref_c_double_complex
 277     call c_check_c_double_complex_as(a)
 278     if(any(abs(a-ref_c_double_complex)>0.0_c_double_complex)) stop 36
 279     a = ref_c_double_complex
 280     call f_check_c_double_complex_ar(a)
 281     if(any(abs(a-ref_c_double_complex)>0.0_c_double_complex)) stop 37
 282     a = ref_c_double_complex
 283     call c_check_c_double_complex_ar(a)
 284     if(any(abs(a-ref_c_double_complex)>0.0_c_double_complex)) stop 38
 285     return
 286   end subroutine check_c_double_complex
 287
 288   subroutine f_check_c_double_complex_as(a)
 289     complex(kind=c_double_complex), intent(in) :: a(:)
 290     !
 291     integer(kind=c_int16_t)     :: t
 292     integer(kind=c_signed_char) :: k
 293     integer(kind=c_size_t)      :: e
 294     !
 295     k = kind(a)
 296     e = storage_size(a)/b
 297     t = cfi_encode_type(CFI_type_complex, k)
 298     if(k<=0_c_signed_char) stop 39
 299     if(k/=8_c_signed_char) stop 40
 300     if(int(k, kind=c_size_t)/=(e/2)) stop 41
 301     if(t/=CFI_type_double_complex) stop 42
 302     if(any(abs(a-ref_c_double_complex)>0.0_c_double_complex)) stop 43
 303     call check_tk_as(a, t, k, e, 1_c_size_t)
 304     if(any(abs(a-ref_c_double_complex)>0.0_c_double_complex)) stop 44
 305     return
 306   end subroutine f_check_c_double_complex_as
 307
 308   subroutine c_check_c_double_complex_as(a) bind(c)
 309     complex(kind=c_double_complex), intent(in) :: a(:)
 310     !
 311     integer(kind=c_int16_t)     :: t
 312     integer(kind=c_signed_char) :: k
 313     integer(kind=c_size_t)      :: e
 314     !
 315     k = kind(a)
 316     e = storage_size(a)/b
 317     t = cfi_encode_type(CFI_type_complex, k)
 318     if(k<=0_c_signed_char) stop 45
 319     if(k/=8_c_signed_char) stop 46
 320     if(int(k, kind=c_size_t)/=(e/2)) stop 47
 321     if(t/=CFI_type_double_complex) stop 48
 322     if(any(abs(a-ref_c_double_complex)>0.0_c_double_complex)) stop 49
 323     call check_tk_as(a, t, k, e, 1_c_size_t)
 324     if(any(abs(a-ref_c_double_complex)>0.0_c_double_complex)) stop 50
 325     return
 326   end subroutine c_check_c_double_complex_as
 327
 328   subroutine f_check_c_double_complex_ar(a)
 329     complex(kind=c_double_complex), intent(in) :: a(..)
 330     !
 331     integer(kind=c_int16_t)     :: t
 332     integer(kind=c_signed_char) :: k
 333     integer(kind=c_size_t)      :: e
 334     !
 335     k = kind(a)
 336     e = storage_size(a)/b
 337     t = cfi_encode_type(CFI_type_complex, k)
 338     if(k<=0_c_signed_char) stop 51
 339     if(k/=8_c_signed_char) stop 52
 340     if(int(k, kind=c_size_t)/=(e/2)) stop 53
 341     if(t/=CFI_type_double_complex) stop 54
 342     select rank(a)
 343     rank(1)
 344       if(any(abs(a-ref_c_double_complex)>0.0_c_double_complex)) stop 55
 345     rank default
 346       stop 56
 347     end select
 348     call check_tk_ar(a, t, k, e, 1_c_size_t)
 349     select rank(a)
 350     rank(1)
 351       if(any(abs(a-ref_c_double_complex)>0.0_c_double_complex)) stop 57
 352     rank default
 353       stop 58
 354     end select
 355     return
 356   end subroutine f_check_c_double_complex_ar
 357
 358   subroutine c_check_c_double_complex_ar(a) bind(c)
 359     complex(kind=c_double_complex), intent(in) :: a(..)
 360     !
 361     integer(kind=c_int16_t)     :: t
 362     integer(kind=c_signed_char) :: k
 363     integer(kind=c_size_t)      :: e
 364     !
 365     k = kind(a)
 366     e = storage_size(a)/b
 367     t = cfi_encode_type(CFI_type_complex, k)
 368     if(k<=0_c_signed_char) stop 59
 369     if(k/=8_c_signed_char) stop 60
 370     if(int(k, kind=c_size_t)/=(e/2)) stop 61
 371     if(t/=CFI_type_double_complex) stop 62
 372     select rank(a)
 373     rank(1)
 374       if(any(abs(a-ref_c_double_complex)>0.0_c_double_complex)) stop 63
 375     rank default
 376       stop 64
 377     end select
 378     call check_tk_ar(a, t, k, e, 1_c_size_t)
 379     select rank(a)
 380     rank(1)
 381       if(any(abs(a-ref_c_double_complex)>0.0_c_double_complex)) stop 65
 382     rank default
 383       stop 66
 384     end select
 385     return
 386   end subroutine c_check_c_double_complex_ar
 387
 388   ! CFI_type_long_double_complex
 389   subroutine check_c_long_double_complex()
 390     complex(kind=c_long_double_complex) :: a(n)
 391     !
 392     if (c_long_double_complex/=10) stop 67
 393     a = ref_c_long_double_complex
 394     call f_check_c_long_double_complex_as(a)
 395     if(any(abs(a-ref_c_long_double_complex)>0.0_c_long_double_complex)) stop 68
 396     a = ref_c_long_double_complex
 397     call c_check_c_long_double_complex_as(a)
 398     if(any(abs(a-ref_c_long_double_complex)>0.0_c_long_double_complex)) stop 69
 399     a = ref_c_long_double_complex
 400     call f_check_c_long_double_complex_ar(a)
 401     if(any(abs(a-ref_c_long_double_complex)>0.0_c_long_double_complex)) stop 70
 402     a = ref_c_long_double_complex
 403     call c_check_c_long_double_complex_ar(a)
 404     if(any(abs(a-ref_c_long_double_complex)>0.0_c_long_double_complex)) stop 71
 405     return
 406   end subroutine check_c_long_double_complex
 407
 408   subroutine f_check_c_long_double_complex_as(a)
 409     complex(kind=c_long_double_complex), intent(in) :: a(:)
 410     !
 411     integer(kind=c_int16_t)     :: t
 412     integer(kind=c_signed_char) :: k
 413     integer(kind=c_size_t)      :: e
 414     !
 415     k = kind(a)
 416     e = storage_size(a)/b
 417     t = cfi_encode_type(CFI_type_complex, k)
 418     if(k<=0_c_signed_char) stop 72
 419     if(k/=10_c_signed_char) stop 73
 420     if(e/=32) stop 74
 421     if(t/=CFI_type_long_double_complex) stop 75
 422     if(any(abs(a-ref_c_long_double_complex)>0.0_c_long_double_complex)) stop 76
 423     call check_tk_as(a, t, k, e, 1_c_size_t)
 424     if(any(abs(a-ref_c_long_double_complex)>0.0_c_long_double_complex)) stop 77
 425     return
 426   end subroutine f_check_c_long_double_complex_as
 427
 428   subroutine c_check_c_long_double_complex_as(a) bind(c)
 429     complex(kind=c_long_double_complex), intent(in) :: a(:)
 430     !
 431     integer(kind=c_int16_t)     :: t
 432     integer(kind=c_signed_char) :: k
 433     integer(kind=c_size_t)      :: e
 434     !
 435     k = kind(a)
 436     e = storage_size(a)/b
 437     t = cfi_encode_type(CFI_type_complex, k)
 438     if(k<=0_c_signed_char) stop 78
 439     if(k/=10_c_signed_char) stop 79
 440     if(e/=32) stop 80
 441     if(t/=CFI_type_long_double_complex) stop 81
 442     if(any(abs(a-ref_c_long_double_complex)>0.0_c_long_double_complex)) stop 82
 443     call check_tk_as(a, t, k, e, 1_c_size_t)
 444     if(any(abs(a-ref_c_long_double_complex)>0.0_c_long_double_complex)) stop 83
 445     return
 446   end subroutine c_check_c_long_double_complex_as
 447
 448   subroutine f_check_c_long_double_complex_ar(a)
 449     complex(kind=c_long_double_complex), intent(in) :: a(..)
 450     !
 451     integer(kind=c_int16_t)     :: t
 452     integer(kind=c_signed_char) :: k
 453     integer(kind=c_size_t)      :: e
 454     !
 455     k = kind(a)
 456     e = storage_size(a)/b
 457     t = cfi_encode_type(CFI_type_complex, k)
 458     if(k<=0_c_signed_char) stop 84
 459     if(k/=10_c_signed_char) stop 85
 460     if(e/=32) stop 86
 461     if(t/=CFI_type_long_double_complex) stop 87
 462     select rank(a)
 463     rank(1)
 464       if(any(abs(a-ref_c_long_double_complex)>0.0_c_long_double_complex)) stop 88
 465     rank default
 466       stop 89
 467     end select
 468     call check_tk_ar(a, t, k, e, 1_c_size_t)
 469     select rank(a)
 470     rank(1)
 471       if(any(abs(a-ref_c_long_double_complex)>0.0_c_long_double_complex)) stop 90
 472     rank default
 473       stop 91
 474     end select
 475     return
 476   end subroutine f_check_c_long_double_complex_ar
 477
 478   subroutine c_check_c_long_double_complex_ar(a) bind(c)
 479     complex(kind=c_long_double_complex), intent(in) :: a(..)
 480     !
 481     integer(kind=c_int16_t)     :: t
 482     integer(kind=c_signed_char) :: k
 483     integer(kind=c_size_t)      :: e
 484     !
 485     k = kind(a)
 486     e = storage_size(a)/b
 487     t = cfi_encode_type(CFI_type_complex, k)
 488     if(k<=0_c_signed_char) stop 92
 489     if(k/=10_c_signed_char) stop 93
 490     if(e/=32) stop 94
 491     if(t/=CFI_type_long_double_complex) stop 95
 492     select rank(a)
 493     rank(1)
 494       if(any(abs(a-ref_c_long_double_complex)>0.0_c_long_double_complex)) stop 96
 495     rank default
 496       stop 97
 497     end select
 498     call check_tk_ar(a, t, k, e, 1_c_size_t)
 499     select rank(a)
 500     rank(1)
 501       if(any(abs(a-ref_c_long_double_complex)>0.0_c_long_double_complex)) stop 98
 502     rank default
 503       stop 99
 504     end select
 505     return
 506   end subroutine c_check_c_long_double_complex_ar
 507
 508   ! CFI_type_float128_complex
 509   subroutine check_c_float128_complex()
 510     complex(kind=c_float128_complex) :: a(n)
 511     !
 512     if (c_float128_complex/=16) stop 100
 513     a = ref_c_float128_complex
 514     call f_check_c_float128_complex_as(a)
 515     if(any(abs(a-ref_c_float128_complex)>0.0_c_float128_complex)) stop 101
 516     a = ref_c_float128_complex
 517     call c_check_c_float128_complex_as(a)
 518     if(any(abs(a-ref_c_float128_complex)>0.0_c_float128_complex)) stop 102
 519     a = ref_c_float128_complex
 520     call f_check_c_float128_complex_ar(a)
 521     if(any(abs(a-ref_c_float128_complex)>0.0_c_float128_complex)) stop 103
 522     a = ref_c_float128_complex
 523     call c_check_c_float128_complex_ar(a)
 524     if(any(abs(a-ref_c_float128_complex)>0.0_c_float128_complex)) stop 104
 525     return
 526   end subroutine check_c_float128_complex
 527
 528   subroutine f_check_c_float128_complex_as(a)
 529     complex(kind=c_float128_complex), intent(in) :: a(:)
 530     !
 531     integer(kind=c_int16_t)     :: t
 532     integer(kind=c_signed_char) :: k
 533     integer(kind=c_size_t)      :: e
 534     !
 535     k = kind(a)
 536     e = storage_size(a)/b
 537     t = cfi_encode_type(CFI_type_complex, k)
 538     if(k<=0_c_signed_char) stop 105
 539     if(k/=16_c_signed_char) stop 106
 540     if(int(k, kind=c_size_t)/=(e/2)) stop 107
 541     if(t/=CFI_type_float128_complex) stop 108
 542     if(any(abs(a-ref_c_float128_complex)>0.0_c_float128_complex)) stop 109
 543     call check_tk_as(a, t, k, e, 1_c_size_t)
 544     if(any(abs(a-ref_c_float128_complex)>0.0_c_float128_complex)) stop 110
 545     return
 546   end subroutine f_check_c_float128_complex_as
 547
 548   subroutine c_check_c_float128_complex_as(a) bind(c)
 549     complex(kind=c_float128_complex), intent(in) :: a(:)
 550     !
 551     integer(kind=c_int16_t)     :: t
 552     integer(kind=c_signed_char) :: k
 553     integer(kind=c_size_t)      :: e
 554     !
 555     k = kind(a)
 556     e = storage_size(a)/b
 557     t = cfi_encode_type(CFI_type_complex, k)
 558     if(k<=0_c_signed_char) stop 111
 559     if(k/=16_c_signed_char) stop 112
 560     if(int(k, kind=c_size_t)/=(e/2)) stop 113
 561     if(t/=CFI_type_float128_complex) stop 114
 562     if(any(abs(a-ref_c_float128_complex)>0.0_c_float128_complex)) stop 115
 563     call check_tk_as(a, t, k, e, 1_c_size_t)
 564     if(any(abs(a-ref_c_float128_complex)>0.0_c_float128_complex)) stop 116
 565     return
 566   end subroutine c_check_c_float128_complex_as
 567
 568   subroutine f_check_c_float128_complex_ar(a)
 569     complex(kind=c_float128_complex), intent(in) :: a(..)
 570     !
 571     integer(kind=c_int16_t)     :: t
 572     integer(kind=c_signed_char) :: k
 573     integer(kind=c_size_t)      :: e
 574     !
 575     k = kind(a)
 576     e = storage_size(a)/b
 577     t = cfi_encode_type(CFI_type_complex, k)
 578     if(k<=0_c_signed_char) stop 117
 579     if(k/=16_c_signed_char) stop 118
 580     if(int(k, kind=c_size_t)/=(e/2)) stop 119
 581     if(t/=CFI_type_float128_complex) stop 120
 582     select rank(a)
 583     rank(1)
 584       if(any(abs(a-ref_c_float128_complex)>0.0_c_float128_complex)) stop 121
 585     rank default
 586       stop 122
 587     end select
 588     call check_tk_ar(a, t, k, e, 1_c_size_t)
 589     select rank(a)
 590     rank(1)
 591       if(any(abs(a-ref_c_float128_complex)>0.0_c_float128_complex)) stop 123
 592     rank default
 593       stop 124
 594     end select
 595     return
 596   end subroutine f_check_c_float128_complex_ar
 597
 598   subroutine c_check_c_float128_complex_ar(a) bind(c)
 599     complex(kind=c_float128_complex), intent(in) :: a(..)
 600     !
 601     integer(kind=c_int16_t)     :: t
 602     integer(kind=c_signed_char) :: k
 603     integer(kind=c_size_t)      :: e
 604     !
 605     k = kind(a)
 606     e = storage_size(a)/b
 607     t = cfi_encode_type(CFI_type_complex, k)
 608     if(k<=0_c_signed_char) stop 125
 609     if(k/=16_c_signed_char) stop 126
 610     if(int(k, kind=c_size_t)/=(e/2)) stop 127
 611     if(t/=CFI_type_float128_complex) stop 128
 612     select rank(a)
 613     rank(1)
 614       if(any(abs(a-ref_c_float128_complex)>0.0_c_float128_complex)) stop 129
 615     rank default
 616       stop 130
 617     end select
 618     call check_tk_ar(a, t, k, e, 1_c_size_t)
 619     select rank(a)
 620     rank(1)
 621       if(any(abs(a-ref_c_float128_complex)>0.0_c_float128_complex)) stop 131
 622     rank default
 623       stop 132
 624     end select
 625     return
 626   end subroutine c_check_c_float128_complex_ar
 627
 628 end module iso_check_m
 629
 630 program main_p
 631
 632   use :: iso_check_m, only:      &
 633     check_c_float_complex,       &
 634     check_c_double_complex,      &
 635     check_c_long_double_complex, &
 636     check_c_float128_complex
 637
 638   implicit none
 639
 640   call check_c_float_complex()
 641   call check_c_double_complex()
 642   ! see PR100910
 643   ! call check_c_long_double_complex()
 644   call check_c_float128_complex()
 645   stop
 646
 647 end program main_p
 648
 649 !! Local Variables:
 650 !! mode: f90
 651 !! End:
 652