libgomp/testsuite/libgomp.fortran/associate2.f90

   1 ! { dg-do run }
   2
   3 program associate2
   4   type dl
   5     integer :: i
   6   end type
   7   type dt
   8     integer :: i
   9     real :: a(3, 3)
  10     type(dl) :: c(3, 3)
  11   end type
  12   integer :: v(4), i, j, k, l
  13   type (dt) :: a(3, 3)
  14   v = 15
  15   forall (k = 1:3, l = 1:3) a(k, l)%a(:,:) = 4.5
  16   a(2,1)%a(1,2) = 3.5
  17   i = 2
  18   j = 1
  19   associate(u => v, b => a(i, j)%a)
  20 !$omp parallel private(v, a) default(none)
  21   v = -1
  22   forall (k = 1:3, l = 1:3) a(k, l)%a(:,:) = 2.5
  23   if (v(3) /= -1 .or. u(3) /= 15) call abort
  24   if (a(2,1)%a(1,2) /= 2.5 .or. b(1,2) /= 3.5) call abort
  25   associate(u => v, b => a(2, 1)%a)
  26   if (u(3) /= -1 .or. b(1,2) /= 2.5) call abort
  27   end associate
  28   if (u(3) /= 15 .or. b(1,2) /= 3.5) call abort
  29 !$omp end parallel
  30   end associate
  31   forall (k = 1:3, l = 1:3) a(k, l)%c(:,:)%i = 7
  32   a(1,2)%c(2,1)%i = 9
  33   i = 1
  34   j = 2
  35   associate(d => a(i, j)%c(2,:)%i)
  36 !$omp parallel private(a) default(none)
  37   forall (k = 1:3, l = 1:3) a(k, l)%c(:,:)%i = 15
  38   if (a(1,2)%c(2,1)%i /= 15 .or. d(1) /= 9) call abort
  39   if (a(1,2)%c(2,2)%i /= 15 .or. d(2) /= 7) call abort
  40   associate(d => a(2,1)%c(2,:)%i)
  41   if (d(1) /= 15 .or. d(2) /= 15) call abort
  42   end associate
  43   if (d(1) /= 9 .or. d(2) /= 7) call abort
  44 !$omp end parallel
  45   end associate
  46 end program