gcc/testsuite/gfortran.dg/class_optional_2.f90

   1 ! { dg-do run }
   2 ! { dg-options "-fcoarray=single" }
   3 !
   4 ! PR fortran/50981
   5 ! PR fortran/54618
   6 ! PR fortran/55978
   7
   8   implicit none
   9   type t
  10    integer, allocatable :: i
  11   end type t
  12   type, extends (t):: t2
  13    integer, allocatable :: j
  14   end type t2
  15
  16   call s1a1()
  17   call s1a()
  18   call s1ac1()
  19   call s1ac()
  20   call s2()
  21   call s2p(psnt=.false.)
  22   call s2caf()
  23   call s2elem()
  24   call s2elem_t()
  25   call s2elem_t2()
  26   call s2t()
  27   call s2tp(psnt=.false.)
  28   call s2t2()
  29   call s2t2p(psnt=.false.)
  30
  31   call a1a1()
  32   call a1a()
  33   call a1ac1()
  34   call a1ac()
  35   call a2()
  36   call a2p(psnt=.false.)
  37   call a2caf()
  38
  39   call a3a1()
  40   call a3a()
  41   call a3ac1()
  42   call a3ac()
  43   call a4()
  44   call a4p(psnt=.false.)
  45   call a4caf()
  46
  47   call ar1a1()
  48   call ar1a()
  49   call ar1ac1()
  50   call ar1ac()
  51   call ar()
  52   call art()
  53   call arp(psnt=.false.)
  54   call artp(psnt=.false.)
  55
  56 contains
  57
  58  subroutine s1a1(z, z2, z3, z4, z5)
  59    type(t), optional :: z, z4[*]
  60    type(t), pointer, optional :: z2
  61    type(t), allocatable, optional :: z3, z5[:]
  62    type(t), allocatable :: x
  63    type(t), pointer :: y
  64    y => null()
  65    call s2(x)
  66    call s2(y)
  67    call s2(z)
  68    call s2(z2)
  69    call s2(z3)
  70    call s2(z4)
  71    call s2(z5)
  72    call s2p(y,psnt=.true.)
  73    call s2p(z2,psnt=.false.)
  74    call s2elem(x)
  75    call s2elem(y)
  76    call s2elem(z)
  77    call s2elem(z2)
  78    call s2elem(z3)
  79    call s2elem(z4)
  80    call s2elem(z5)
  81    call s2elem_t(x)
  82    call s2elem_t(y)
  83    call s2elem_t(z)
  84 !   call s2elem_t(z2) ! FIXME: Segfault
  85 !   call s2elem_t(z3) ! FIXME: Segfault
  86 !   call s2elem_t(z4) ! FIXME: Segfault
  87 !   call s2elem_t(z5) ! FIXME: Segfault
  88    call s2caf(z4)
  89    call s2caf(z5)
  90    call ar(x)
  91    call ar(y)
  92    call ar(z)
  93    call ar(z2)
  94    call ar(z3)
  95    call ar(z4)
  96    call ar(z5)
  97    call arp(y,psnt=.true.)
  98    call arp(z2,psnt=.false.)
  99    call s2t(x)
 100    call s2t(y)
 101    call s2t(z)
 102 !  call s2t(z2) ! FIXME: Segfault
 103 !   call s2t(z3) ! FIXME: Segfault
 104 !   call s2t(z4) ! FIXME: Segfault
 105 !   call s2t(z5) ! FIXME: Segfault
 106    call s2tp(y,psnt=.true.)
 107    call s2tp(z2,psnt=.false.)
 108  end subroutine s1a1
 109  subroutine s1a(z, z2, z3, z4, z5)
 110    type(t2), optional :: z, z4[*]
 111    type(t2), optional, pointer :: z2
 112    type(t2), optional, allocatable :: z3, z5[:]
 113    type(t2), allocatable :: x
 114    type(t2), pointer :: y
 115    y => null()
 116    call s2(x)
 117    call s2(y)
 118    call s2(z)
 119    call s2(z2)
 120    call s2(z3)
 121    call s2(z4)
 122    call s2(z5)
 123    call s2p(y,psnt=.true.)
 124    call s2p(z2,psnt=.false.)
 125    call s2elem(x)
 126    call s2elem(y)
 127    call s2elem(z)
 128    call s2elem(z2)
 129    call s2elem(z3)
 130    call s2elem(z4)
 131    call s2elem(z5)
 132    call s2elem_t2(x)
 133    call s2elem_t2(y)
 134    call s2elem_t2(z)
 135 !   call s2elem_t2(z2) ! FIXME: Segfault
 136 !   call s2elem_t2(z3) ! FIXME: Segfault
 137 !   call s2elem_t2(z4) ! FIXME: Segfault
 138 !   call s2elem_t2(z5) ! FIXME: Segfault
 139    call s2caf(z4)
 140    call s2caf(z5)
 141    call ar(x)
 142    call ar(y)
 143    call ar(z)
 144    call ar(z2)
 145    call ar(z3)
 146    call ar(z4)
 147    call ar(z5)
 148    call arp(y,psnt=.true.)
 149    call arp(z2,psnt=.false.)
 150    call s2t2(x)
 151    call s2t2(y)
 152    call s2t2(z)
 153 !   call s2t2(z2) ! FIXME: Segfault
 154 !   call s2t2(z3) ! FIXME: Segfault
 155    call s2t2(z4)
 156 !   call s2t2(z5) ! FIXME: Segfault
 157    call s2t2p(y,psnt=.true.)
 158    call s2t2p(z2,psnt=.false.)
 159  end subroutine s1a
 160  subroutine s1ac1(z, z2, z3, z4, z5)
 161    class(t), optional :: z, z4[*]
 162    class(t), optional, pointer :: z2
 163    class(t), optional, allocatable :: z3, z5[:]
 164    class(t), allocatable :: x
 165    class(t), pointer :: y
 166    y => null()
 167    call s2(x)
 168    call s2(y)
 169    call s2(z)
 170    call s2(z2)
 171    call s2(z3)
 172    call s2(z4)
 173    call s2(z5)
 174    call s2p(y,psnt=.true.)
 175    call s2p(z2,psnt=.false.)
 176    call s2elem(x)
 177    call s2elem(y)
 178    call s2elem(z)
 179    call s2elem(z2)
 180    call s2elem(z3)
 181    call s2elem(z4)
 182    call s2elem(z5)
 183    call s2elem_t(x)
 184    call s2elem_t(y)
 185 !   call s2elem_t(z) ! FIXME: Segfault
 186 !   call s2elem_t(z2) ! FIXME: Segfault
 187 !   call s2elem_t(z3) ! FIXME: Segfault
 188 !   call s2elem_t(z4) ! FIXME: Segfault
 189 !   call s2elem_t(z5) ! FIXME: Segfault
 190    call s2caf(z4)
 191    call s2caf(z5)
 192    call ar(x)
 193    call ar(y)
 194    call ar(z)
 195    call ar(z2)
 196    call ar(z3)
 197    call ar(z4)
 198    call ar(z5)
 199    call arp(y,psnt=.true.)
 200    call arp(z2,psnt=.false.)
 201    call s2t(x)
 202    call s2t(y)
 203 !   call s2t(z) ! FIXME: Segfault
 204 !   call s2t(z2) ! FIXME: Segfault
 205 !   call s2t(z3) ! FIXME: Segfault
 206 !   call s2t(z4) ! FIXME: Segfault
 207 !   call s2t(z5) ! FIXME: Segfault
 208    call s2tp(y,psnt=.true.)
 209    call s2tp(z2,psnt=.false.)
 210  end subroutine s1ac1
 211  subroutine s1ac(z, z2, z3, z4, z5)
 212    class(t2), optional :: z, z4[*]
 213    class(t2), optional, pointer :: z2
 214    class(t2), optional, allocatable :: z3, z5[:]
 215    class(t2), allocatable :: x
 216    class(t2), pointer :: y
 217    y => null()
 218    call s2(x)
 219    call s2(y)
 220    call s2(z)
 221    call s2(z2)
 222    call s2(z3)
 223    call s2(z4)
 224    call s2(z5)
 225    call s2p(y,psnt=.true.)
 226    call s2p(z2,psnt=.false.)
 227    call s2elem(x)
 228    call s2elem(y)
 229    call s2elem(z)
 230    call s2elem(z2)
 231    call s2elem(z3)
 232    call s2elem(z4)
 233    call s2elem(z5)
 234    call s2elem_t2(x)
 235 !   call s2elem_t2(y) ! FIXME: Segfault
 236 !   call s2elem_t2(z) ! FIXME: Segfault
 237 !   call s2elem_t2(z2) ! FIXME: Segfault
 238 !   call s2elem_t2(z3) ! FIXME: Segfault
 239 !   call s2elem_t2(z4) ! FIXME: Segfault
 240 !   call s2elem_t2(z5) ! FIXME: Segfault
 241    call s2caf(z4)
 242    call s2caf(z5)
 243    call ar(x)
 244    call ar(y)
 245    call ar(z)
 246    call ar(z2)
 247    call ar(z3)
 248    call ar(z4)
 249    call ar(z5)
 250    call arp(y,psnt=.true.)
 251    call arp(z2,psnt=.false.)
 252    call s2t2(x)
 253    call s2t2(y)
 254 !   call s2t2(z) ! FIXME: Segfault
 255 !   call s2t2(z2) ! FIXME: Segfault
 256 !   call s2t2(z3) ! FIXME: Segfault
 257 !   call s2t2(z4) ! FIXME: Segfault
 258 !   call s2t2(z5) ! FIXME: Segfault
 259    call s2t2p(y,psnt=.true.)
 260    call s2t2p(z2,psnt=.false.)
 261  end subroutine s1ac
 262
 263  subroutine s2(x)
 264    class(t), intent(in), optional :: x
 265    if (present (x)) STOP 1
 266    !print *, present(x)
 267  end subroutine s2
 268  subroutine s2p(x,psnt)
 269    class(t), intent(in), pointer, optional :: x
 270    logical psnt
 271    if (present (x).neqv. psnt) STOP 2
 272    !print *, present(x)
 273  end subroutine s2p
 274  subroutine s2caf(x)
 275    class(t), intent(in), optional :: x[*]
 276    if (present (x)) STOP 3
 277    !print *, present(x)
 278  end subroutine s2caf
 279  subroutine s2t(x)
 280    type(t), intent(in), optional :: x
 281    if (present (x)) STOP 4
 282    !print *, present(x)
 283  end subroutine s2t
 284  subroutine s2t2(x)
 285    type(t2), intent(in), optional :: x
 286    if (present (x)) STOP 5
 287    !print *, present(x)
 288  end subroutine s2t2
 289  subroutine s2tp(x, psnt)
 290    type(t), pointer, intent(in), optional :: x
 291    logical psnt
 292    if (present (x).neqv. psnt) STOP 6
 293    !print *, present(x)
 294  end subroutine s2tp
 295  subroutine s2t2p(x, psnt)
 296    type(t2), pointer, intent(in), optional :: x
 297    logical psnt
 298    if (present (x).neqv. psnt) STOP 7
 299    !print *, present(x)
 300  end subroutine s2t2p
 301  impure elemental subroutine s2elem(x)
 302    class(t), intent(in), optional :: x
 303    if (present (x)) STOP 8
 304    !print *, present(x)
 305  end subroutine s2elem
 306  impure elemental subroutine s2elem_t(x)
 307    type(t), intent(in), optional :: x
 308    if (present (x)) STOP 9
 309    !print *, present(x)
 310  end subroutine s2elem_t
 311  impure elemental subroutine s2elem_t2(x)
 312    type(t2), intent(in), optional :: x
 313    if (present (x)) STOP 10
 314    !print *, present(x)
 315  end subroutine s2elem_t2
 316
 317
 318  subroutine a1a1(z, z2, z3, z4, z5)
 319    type(t), optional :: z(:), z4(:)[*]
 320    type(t), optional, pointer :: z2(:)
 321    type(t), optional, allocatable :: z3(:), z5(:)[:]
 322    type(t), allocatable :: x(:)
 323    type(t), pointer :: y(:)
 324    y => null()
 325    call a2(x)
 326    call a2(y)
 327    call a2(z)
 328    call a2(z2)
 329    call a2(z3)
 330    call a2(z4)
 331    call a2(z5)
 332    call a2p(y,psnt=.true.)
 333    call a2p(z2,psnt=.false.)
 334    call a2caf(z4)
 335    call a2caf(z5)
 336    call ar(x)
 337    call ar(y)
 338    call ar(z)
 339    call ar(z2)
 340    call ar(z3)
 341    call ar(z4)
 342    call ar(z5)
 343    call arp(y,psnt=.true.)
 344    call arp(z2,psnt=.false.)
 345 !   call s2elem(x) ! FIXME: Segfault
 346 !   call s2elem(y) ! FIXME: Segfault
 347 !   call s2elem(z) ! FIXME: Segfault
 348 !   call s2elem(z2) ! FIXME: Segfault
 349 !   call s2elem(z3) ! FIXME: Segfault
 350 !   call s2elem(z4) ! FIXME: Segfault
 351 !   call s2elem(z5) ! FIXME: Segfault
 352 !   call s2elem_t(x) ! FIXME: Conditional jump or move depends on uninitialised value
 353 !   call s2elem_t(y) ! FIXME: Conditional jump or move depends on uninitialised value
 354 !   call s2elem_t(z) ! FIXME: Conditional jump or move depends on uninitialised value
 355 !   call s2elem_t(z2) ! FIXME: Segfault
 356 !   call s2elem_t(z3) ! FIXME: Segfault
 357 !   call s2elem_t(z4) ! FIXME: Segfault
 358 !   call s2elem_t(z5) ! FIXME: Segfault
 359  end subroutine a1a1
 360  subroutine a1a(z, z2, z3, z4, z5)
 361    type(t2), optional :: z(:), z4(:)[*]
 362    type(t2), optional, pointer :: z2(:)
 363    type(t2), optional, allocatable :: z3(:), z5(:)[:]
 364    type(t2), allocatable :: x(:)
 365    type(t2), pointer :: y(:)
 366    y => null()
 367    call a2(x)
 368    call a2(y)
 369    call a2(z)
 370    call a2(z2)
 371    call a2(z3)
 372    call a2(z4)
 373    call a2(z5)
 374    call a2p(y,psnt=.true.)
 375    call a2p(z2,psnt=.false.)
 376    call a2caf(z4)
 377    call a2caf(z5)
 378    call ar(x)
 379    call ar(y)
 380    call ar(z)
 381    call ar(z2)
 382    call ar(z3)
 383    call ar(z4)
 384    call ar(z5)
 385    call arp(y,psnt=.true.)
 386    call arp(z2,psnt=.false.)
 387 !   call s2elem(x) ! FIXME: Segfault
 388 !   call s2elem(y) ! FIXME: Segfault
 389 !   call s2elem(z) ! FIXME: Segfault
 390 !   call s2elem(z2) ! FIXME: Segfault
 391 !   call s2elem(z3) ! FIXME: Segfault
 392 !   call s2elem(z4) ! FIXME: Segfault
 393 !   call s2elem(z5) ! FIXME: Segfault
 394 !   call s2elem_t2(x) ! FIXME: Conditional jump or move depends on uninitialised value
 395 !   call s2elem_t2(y) ! FIXME: Conditional jump or move depends on uninitialised value
 396 !   call s2elem_t2(z) ! FIXME: Conditional jump or move depends on uninitialised value
 397 !   call s2elem_t2(z2) ! FIXME: Segfault
 398 !   call s2elem_t2(z3) ! FIXME: Segfault
 399 !   call s2elem_t2(z4) ! FIXME: Segfault
 400 !   call s2elem_t2(z5) ! FIXME: Segfault
 401  end subroutine a1a
 402  subroutine a1ac1(z, z2, z3, z4, z5)
 403    class(t), optional :: z(:), z4(:)[*]
 404    class(t), optional, pointer :: z2(:)
 405    class(t), optional, allocatable :: z3(:), z5(:)[:]
 406    class(t), allocatable :: x(:)
 407    class(t), pointer :: y(:)
 408    y => null()
 409    call a2(x)
 410    call a2(y)
 411    call a2(z)
 412    call a2(z2)
 413    call a2(z3)
 414    call a2(z4)
 415    call a2(z5)
 416    call a2p(y,psnt=.true.)
 417    call a2p(z2,psnt=.false.)
 418    call a2caf(z4)
 419    call a2caf(z5)
 420    call ar(x)
 421    call ar(y)
 422    call ar(z)
 423    call ar(z2)
 424    call ar(z3)
 425    call ar(z4)
 426    call ar(z5)
 427    call arp(y,psnt=.true.)
 428    call arp(z2,psnt=.false.)
 429 !   call s2elem(x) ! FIXME: Segfault
 430 !   call s2elem(y) ! FIXME: Segfault
 431 !   call s2elem(z) ! FIXME: Segfault
 432 !   call s2elem(z2) ! FIXME: Segfault
 433 !   call s2elem(z3) ! FIXME: Segfault
 434 !   call s2elem(z4) ! FIXME: Segfault
 435 !   call s2elem(z5) ! FIXME: Segfault
 436 !   call s2elem_t(x) ! FIXME: Segfault
 437 !   call s2elem_t(y) ! FIXME: Segfault
 438 !   call s2elem_t(z) ! FIXME: Segfault
 439 !   call s2elem_t(z2) ! FIXME: Segfault
 440 !   call s2elem_t(z3) ! FIXME: Segfault
 441 !   call s2elem_t(z4) ! FIXME: Segfault
 442 !   call s2elem_t(z5) ! FIXME: Segfault
 443  end subroutine a1ac1
 444  subroutine a1ac(z, z2, z3, z4, z5)
 445    class(t2), optional :: z(:), z4(:)[*]
 446    class(t2), optional, pointer :: z2(:)
 447    class(t2), optional, allocatable :: z3(:), z5(:)[:]
 448    class(t2), allocatable :: x(:)
 449    class(t2), pointer :: y(:)
 450    y => null()
 451    call a2(x)
 452    call a2(y)
 453    call a2(z)
 454    call a2(z2)
 455    call a2(z3)
 456    call a2(z4)
 457    call a2(z5)
 458    call a2p(y,psnt=.true.)
 459    call a2p(z2,psnt=.false.)
 460    call a2caf(z4)
 461    call a2caf(z5)
 462    call ar(x)
 463    call ar(y)
 464    call ar(z)
 465    call ar(z2)
 466    call ar(z3)
 467    call ar(z4)
 468    call ar(z5)
 469    call arp(y,psnt=.true.)
 470    call arp(z2,psnt=.false.)
 471 !   call s2elem(x) ! FIXME: Segfault
 472 !   call s2elem(y) ! FIXME: Segfault
 473 !   call s2elem(z) ! FIXME: Segfault
 474 !   call s2elem(z2) ! FIXME: Segfault
 475 !   call s2elem(z3) ! FIXME: Segfault
 476 !   call s2elem(z4) ! FIXME: Segfault
 477 !   call s2elem(z5) ! FIXME: Segfault
 478 !   call s2elem_t2(x) ! FIXME: Segfault
 479 !   call s2elem_t2(y) ! FIXME: Segfault
 480 !   call s2elem_t2(z) ! FIXME: Segfault
 481 !   call s2elem_t2(z2) ! FIXME: Segfault
 482 !   call s2elem_t2(z3) ! FIXME: Segfault
 483 !   call s2elem_t2(z4) ! FIXME: Segfault
 484 !   call s2elem_t2(z5) ! FIXME: Segfault
 485  end subroutine a1ac
 486
 487  subroutine a2(x)
 488    class(t), intent(in), optional :: x(:)
 489    if (present (x)) STOP 11
 490    ! print *, present(x)
 491  end subroutine a2
 492  subroutine a2p(x, psnt)
 493    class(t), pointer, intent(in), optional :: x(:)
 494    logical psnt
 495    if (present (x).neqv. psnt) STOP 12
 496    ! print *, present(x)
 497  end subroutine a2p
 498  subroutine a2caf(x)
 499    class(t), intent(in), optional :: x(:)[*]
 500    if (present (x)) STOP 13
 501    ! print *, present(x)
 502  end subroutine a2caf
 503
 504
 505  subroutine a3a1(z, z2, z3, z4, z5)
 506    type(t), optional :: z(4), z4(4)[*]
 507    type(t), optional, pointer :: z2(:)
 508    type(t), optional, allocatable :: z3(:), z5(:)[:]
 509    type(t), allocatable :: x(:)
 510    type(t), pointer :: y(:)
 511    y => null()
 512    call a4(x)
 513    call a4(y)
 514    call a4(z)
 515    call a4(z2)
 516    call a4(z3)
 517    call a4(z4)
 518    call a4(z5)
 519    call a4p(y,psnt=.true.)
 520    call a4p(z2,psnt=.false.)
 521    call a4t(x)
 522    call a4t(y)
 523    call a4t(z)
 524 !   call a4t(z2) ! FIXME: Segfault
 525 !   call a4t(z3) ! FIXME: Segfault
 526 !   call a4t(z4) ! FIXME: Segfault
 527 !   call a4t(z5) ! FIXME: Segfault
 528    call a4tp(y,psnt=.true.)
 529    call a4tp(z2,psnt=.false.)
 530    call a4caf(z4)
 531    call a4caf(z5)
 532    call ar(x)
 533    call ar(y)
 534    call ar(z)
 535    call ar(z2)
 536    call ar(z3)
 537    call ar(z4)
 538    call ar(z5)
 539    call arp(y,psnt=.true.)
 540    call arp(z2,psnt=.false.)
 541 !   call s2elem(x) ! FIXME: Segfault
 542 !   call s2elem(y) ! FIXME: Segfault
 543 !   call s2elem(z) ! FIXME: Segfault
 544 !   call s2elem(z2) ! FIXME: Segfault
 545 !   call s2elem(z3) ! FIXME: Segfault
 546 !   call s2elem(z4) ! FIXME: Segfault
 547 !   call s2elem(z5) ! FIXME: Segfault
 548 !   call s2elem_t(x) ! FIXME: Conditional jump or move depends on uninitialised value
 549 !   call s2elem_t(y) ! FIXME: Conditional jump or move depends on uninitialised value
 550    call s2elem_t(z)
 551 !   call s2elem_t(z2) ! FIXME: Segfault
 552 !   call s2elem_t(z3) ! FIXME: Segfault
 553 !   call s2elem_t(z4) ! FIXME: Segfault
 554 !   call s2elem_t(z5) ! FIXME: Segfault
 555  end subroutine a3a1
 556  subroutine a3a(z, z2, z3)
 557    type(t2), optional :: z(4)
 558    type(t2), optional, pointer :: z2(:)
 559    type(t2), optional, allocatable :: z3(:)
 560    type(t2), allocatable :: x(:)
 561    type(t2), pointer :: y(:)
 562    y => null()
 563    call a4(x)
 564    call a4(y)
 565    call a4(z)
 566    call a4(z2)
 567    call a4(z3)
 568    call a4p(y,psnt=.true.)
 569    call a4p(z2,psnt=.false.)
 570    call a4t2(x)
 571    call a4t2(y)
 572    call a4t2(z)
 573 !   call a4t2(z2) ! FIXME: Segfault
 574 !   call a4t2(z3) ! FIXME: Segfault
 575    call a4t2p(y,psnt=.true.)
 576    call a4t2p(z2,psnt=.false.)
 577    call ar(x)
 578    call ar(y)
 579    call ar(z)
 580    call ar(z2)
 581    call ar(z3)
 582    call arp(y,psnt=.true.)
 583    call arp(z2,psnt=.false.)
 584 !   call s2elem(x) ! FIXME: Segfault
 585 !   call s2elem(y) ! FIXME: Segfault
 586 !   call s2elem(z) ! FIXME: Segfault
 587 !   call s2elem(z2) ! FIXME: Segfault
 588 !   call s2elem(z3) ! FIXME: Segfault
 589 !   call s2elem(z4) ! FIXME: Segfault
 590 !   call s2elem(z5) ! FIXME: Segfault
 591 !   call s2elem_t2(x) ! FIXME: Conditional jump or move depends on uninitialised value
 592 !   call s2elem_t2(y) ! FIXME: Conditional jump or move depends on uninitialised value
 593    call s2elem_t2(z)
 594 !   call s2elem_t2(z2) ! FIXME: Segfault
 595 !   call s2elem_t2(z3) ! FIXME: Segfault
 596 !   call s2elem_t2(z4) ! FIXME: Segfault
 597 !   call s2elem_t2(z5) ! FIXME: Segfault
 598  end subroutine a3a
 599  subroutine a3ac1(z, z2, z3, z4, z5)
 600    class(t), optional :: z(4), z4(4)[*]
 601    class(t), optional, pointer :: z2(:)
 602    class(t), optional, allocatable :: z3(:), z5(:)[:]
 603    class(t), allocatable :: x(:)
 604    class(t), pointer :: y(:)
 605    y => null()
 606    call a4(x)
 607    call a4(y)
 608    call a4(z)
 609    call a4(z2)
 610    call a4(z3)
 611    call a4(z4)
 612    call a4(z5)
 613    call a4p(y,psnt=.true.)
 614    call a4p(z2,psnt=.false.)
 615 !   call a4t(x) ! FIXME: Segfault
 616 !   call a4t(y) ! FIXME: Segfault
 617 !   call a4t(z) ! FIXME: Segfault
 618 !   call a4t(z2) ! FIXME: Segfault
 619 !   call a4t(z3) ! FIXME: Segfault
 620 !   call a4t(z4) ! FIXME: Segfault
 621 !   call a4t(z5) ! FIXME: Segfault
 622 !   call a4tp(y,psnt=.true.) ! FIXME: Segfault
 623 !   call a4tp(z2,psnt=.false.) ! FIXME: Segfault
 624    call a4caf(z4)
 625    call a4caf(z5)
 626    call ar(x)
 627    call ar(y)
 628    call ar(z)
 629    call ar(z2)
 630    call ar(z3)
 631    call ar(z4)
 632    call ar(z5)
 633    call arp(y,psnt=.true.)
 634    call arp(z2,psnt=.false.)
 635 !   call s2elem(x) ! FIXME: Conditional jump or move depends on uninitialised value
 636 !   call s2elem(y) ! FIXME: Conditional jump or move depends on uninitialised value
 637 !   call s2elem(z) ! FIXME: Segfault
 638 !   call s2elem(z2) ! FIXME: Segfault
 639 !   call s2elem(z3) ! FIXME: Segfault
 640 !   call s2elem(z4) ! FIXME: Segfault
 641 !   call s2elem(z5) ! FIXME: Segfault
 642 !   call s2elem_t(x) ! FIXME: Conditional jump or move depends on uninitialised value
 643 !   call s2elem_t(y) ! FIXME: Conditional jump or move depends on uninitialised value
 644 !   call s2elem_t(z) ! FIXME: Segfault
 645 !   call s2elem_t(z2) ! FIXME: Segfault
 646 !   call s2elem_t(z3) ! FIXME: Segfault
 647 !   call s2elem_t(z4) ! FIXME: Segfault
 648 !   call s2elem_t(z5) ! FIXME: Segfault
 649  end subroutine a3ac1
 650  subroutine a3ac(z, z2, z3, z4, z5)
 651    class(t2), optional :: z(4), z4(4)[*]
 652    class(t2), optional, pointer :: z2(:)
 653    class(t2), optional, allocatable :: z3(:), z5(:)[:]
 654    class(t2), allocatable :: x(:)
 655    class(t2), pointer :: y(:)
 656    y => null()
 657    call a4(x)
 658    call a4(y)
 659    call a4(z)
 660    call a4(z2)
 661    call a4(z3)
 662    call a4(z4)
 663    call a4(z5)
 664    call a4p(y,psnt=.true.)
 665    call a4p(z2,psnt=.false.)
 666 !   call a4t2(x) ! FIXME: Segfault
 667 !   call a4t2(y) ! FIXME: Segfault
 668 !   call a4t2(z) ! FIXME: Segfault
 669 !   call a4t2(z2) ! FIXME: Segfault
 670 !   call a4t2(z3) ! FIXME: Segfault
 671 !   call a4t2(z4) ! FIXME: Segfault
 672 !   call a4t2(z5) ! FIXME: Segfault
 673 !   call a4t2p(y,psnt=.true.) ! FIXME: Segfault
 674 !   call a4t2p(z2,psnt=.false.) ! FIXME: Segfault
 675    call a4caf(z4)
 676    call a4caf(z5)
 677    call ar(x)
 678    call ar(y)
 679    call ar(z)
 680    call ar(z2)
 681    call ar(z3)
 682    call ar(z4)
 683    call ar(z5)
 684    call arp(y,psnt=.true.)
 685    call arp(z2,psnt=.false.)
 686  end subroutine a3ac
 687
 688  subroutine a4(x)
 689    class(t), intent(in), optional :: x(4)
 690    if (present (x)) STOP 14
 691    !print *, present(x)
 692  end subroutine a4
 693  subroutine a4p(x, psnt)
 694    class(t), pointer, intent(in), optional :: x(:)
 695    logical psnt
 696    if (present (x).neqv. psnt) STOP 15
 697    !print *, present(x)
 698  end subroutine a4p
 699  subroutine a4caf(x)
 700    class(t), intent(in), optional :: x(4)[*]
 701    if (present (x)) STOP 16
 702    !print *, present(x)
 703  end subroutine a4caf
 704  subroutine a4t(x)
 705    type(t), intent(in), optional :: x(4)
 706    if (present (x)) STOP 17
 707    !print *, present(x)
 708  end subroutine a4t
 709  subroutine a4t2(x)
 710    type(t2), intent(in), optional :: x(4)
 711    if (present (x)) STOP 18
 712    !print *, present(x)
 713  end subroutine a4t2
 714  subroutine a4tp(x, psnt)
 715    type(t), pointer, intent(in), optional :: x(:)
 716    logical psnt
 717    if (present (x).neqv. psnt) STOP 19
 718    !print *, present(x)
 719  end subroutine a4tp
 720  subroutine a4t2p(x, psnt)
 721    type(t2), pointer, intent(in), optional :: x(:)
 722    logical psnt
 723    if (present (x).neqv. psnt) STOP 20
 724    !print *, present(x)
 725  end subroutine a4t2p
 726
 727
 728  subroutine ar(x)
 729    class(t), intent(in), optional :: x(..)
 730    if (present (x)) STOP 21
 731    !print *, present(x)
 732  end subroutine ar
 733
 734  subroutine art(x)
 735    type(t), intent(in), optional :: x(..)
 736    if (present (x)) STOP 22
 737    !print *, present(x)
 738  end subroutine art
 739
 740  subroutine arp(x, psnt)
 741    class(t), pointer, intent(in), optional :: x(..)
 742    logical psnt
 743    if (present (x).neqv. psnt) STOP 23
 744    !print *, present(x)
 745  end subroutine arp
 746
 747  subroutine artp(x, psnt)
 748    type(t), intent(in), pointer, optional :: x(..)
 749    logical psnt
 750    if (present (x).neqv. psnt) STOP 24
 751    !print *, present(x)
 752  end subroutine artp
 753
 754
 755
 756  subroutine ar1a1(z, z2, z3)
 757    type(t), optional :: z(..)
 758    type(t), pointer, optional :: z2(..)
 759    type(t), allocatable, optional :: z3(..)
 760    call ar(z)
 761    call ar(z2)
 762    call ar(z3)
 763    call art(z)
 764    call art(z2)
 765    call art(z3)
 766    call arp(z2, .false.)
 767    call artp(z2, .false.)
 768  end subroutine ar1a1
 769  subroutine ar1a(z, z2, z3)
 770    type(t2), optional :: z(..)
 771    type(t2), optional, pointer :: z2(..)
 772    type(t2), optional, allocatable :: z3(..)
 773    call ar(z)
 774    call ar(z2)
 775    call ar(z3)
 776    call arp(z2, .false.)
 777  end subroutine ar1a
 778  subroutine ar1ac1(z, z2, z3)
 779    class(t), optional :: z(..)
 780    class(t), optional, pointer :: z2(..)
 781    class(t), optional, allocatable :: z3(..)
 782    call ar(z)
 783    call ar(z2)
 784    call ar(z3)
 785 !   call art(z) ! FIXME: ICE - This requires packing support for assumed-rank
 786 !   call art(z2)! FIXME: ICE - This requires packing support for assumed-rank
 787 !   call art(z3)! FIXME: ICE - This requires packing support for assumed-rank
 788    call arp(z2, .false.)
 789 !   call artp(z2, .false.) ! FIXME: ICE
 790  end subroutine ar1ac1
 791  subroutine ar1ac(z, z2, z3)
 792    class(t2), optional :: z(..)
 793    class(t2), optional, pointer :: z2(..)
 794    class(t2), optional, allocatable :: z3(..)
 795    call ar(z)
 796    call ar(z2)
 797    call ar(z3)
 798    call arp(z2, .false.)
 799  end subroutine ar1ac
 800 end