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 9program 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])) STOP 1 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])) STOP 2 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])) STOP 3 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])) STOP 4 52 deallocate(pm) 53 54 associate(i => iv(1)) 55 i = 7 56 end associate 57 if (any (iv /= [7, 17, 17, 17, 17])) STOP 5 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])) STOP 6 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)) STOP 7 76 ! Shift expect 77 expect = [expect(17:), expect(:16)] 78 end do 79end program 80 81