gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_associated_2.f90

   1 ! Program to test the ASSOCIATED intrinsic with cross-kinds
   2 program intrinsic_associated_2
   3    logical*4 :: t4, L44, L48
   4    logical*8 :: t8, L84, L88
   5    real*4, pointer :: a4p(:, :)
   6    real*8, pointer :: a8p(:, :)
   7    real*4, target  :: a4(10, 10)
   8    real*8, target  :: a8(10, 10)
   9
  10    t4 = .true.
  11    t8 = .true.
  12    t8 = t4
  13    a4p => a4
  14    a8p => a8
  15    L44 = t4 .and. associated (a4p, a4)
  16    L84 = t8 .and. associated (a4p, a4)
  17    L48 = t4 .and. associated (a8p, a8)
  18    L88 = t8 .and. associated (a8p, a8)
  19    if (.not. (L44 .and. L84 .and. L48 .and. L88)) call abort ()
  20
  21    nullify (a4p, a8p)
  22    L44 = t4 .and. associated (a4p, a4)
  23    L84 = t8 .and. associated (a4p, a4)
  24    L48 = t4 .and. associated (a8p, a8)
  25    L88 = t8 .and. associated (a8p, a8)
  26    if (L44 .and. L84 .and. L48 .and. L88) call abort ()
  27
  28    a4p => a4(1:10:2, 1:10:2)
  29    a8p => a8(1:4, 1:4)
  30    L44 = t4 .and. associated (a4p, a4(1:10:2, 1:10:2))
  31    L84 = t8 .and. associated (a4p, a4(1:10:2, 1:10:2))
  32    L48 = t4 .and. associated (a8p, a8(1:4, 1:4))
  33    L88 = t8 .and. associated (a8p, a8(1:4, 1:4))
  34    if (.not. (L44 .and. L84 .and. L48 .and. L88)) call abort ()
  35 end
  36