gcc/testsuite/gfortran.dg/associate_18.f08

   1 ! { dg-do run }
   2 !
   3 ! Contributed by Antony Lewis  <antony@cosmologist.info>
   4 !                Andre Vehreschild  <vehre@gcc.gnu.org>
   5 ! Check that associating array-sections/scalars is working
   6 ! with class arrays.
   7 !
   8
   9 program associate_18
  10   Type T
  11     integer :: map = 1
  12   end Type T
  13
  14   class(T), allocatable :: av(:)
  15   class(T), allocatable :: am(:,:)
  16   class(T), pointer :: pv(:)
  17   class(T), pointer :: pm(:,:)
  18
  19   integer :: iv(5) = 17
  20   integer :: im(4,5) = 23
  21   integer :: expect(20) = 23
  22   integer :: c
  23
  24   allocate(av(2))
  25   associate(i => av(1))
  26     i%map = 2
  27   end associate
  28   if (any (av%map /= [2,1])) call abort()
  29   deallocate(av)
  30
  31   allocate(am(3,4))
  32   associate(pam => am(2:3, 2:3))
  33     pam%map = 7
  34     pam(1,2)%map = 8
  35   end associate
  36   if (any (reshape(am%map, [12]) /= [1,1,1, 1,7,7, 1,8,7, 1,1,1])) call abort()
  37   deallocate(am)
  38
  39   allocate(pv(2))
  40   associate(i => pv(1))
  41     i%map = 2
  42   end associate
  43   if (any (pv%map /= [2,1])) call abort()
  44   deallocate(pv)
  45
  46   allocate(pm(3,4))
  47   associate(ppm => pm(2:3, 2:3))
  48     ppm%map = 7
  49     ppm(1,2)%map = 8
  50   end associate
  51   if (any (reshape(pm%map, [12]) /= [1,1,1, 1,7,7, 1,8,7, 1,1,1])) call abort()
  52   deallocate(pm)
  53
  54   associate(i => iv(1))
  55     i = 7
  56   end associate
  57   if (any (iv /= [7, 17, 17, 17, 17])) call abort()
  58
  59   associate(pam => im(2:3, 2:3))
  60     pam = 9
  61     pam(1,2) = 10
  62     do c = 1, 2
  63         pam(2, c) = 0
  64     end do
  65   end associate
  66   if (any (reshape(im, [20]) /= [23,23,23,23, 23,9,0,23, &
  67         23,10,0,23, 23,23,23,23, 23,23,23,23])) call abort()
  68
  69   expect(2:3) = 9
  70   do c = 1, 5
  71     im = 23
  72     associate(pam => im(:, c))
  73       pam(2:3) = 9
  74     end associate
  75     if (any (reshape(im, [20]) /= expect)) call abort()
  76     ! Shift expect
  77     expect = [expect(17:), expect(:16)]
  78   end do
  79 end program
  80