1! Verify column location information.
2
3! See also 'c-c++-common/goacc/pr92793-1.c'.
4
5! { dg-additional-options "-fdump-tree-original-lineno" }
6! { dg-additional-options "-fdump-tree-gimple-lineno" }
7
8! No tabs.  Funny indentation/spacing for a reason.
9
10
11subroutine check ()
12  implicit none (type, external)
13  integer :: i, j, sum, diff
14
15 !$acc    parallel &
16     !$acc & & ! Fortran location information points to the last line, and last character of the directive.
17!$acc  && ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:18:123\\\] #pragma acc parallel" 1 "original" } }
18  !$acc & ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:18:123\\\] #pragma omp target oacc_parallel" 1 "gimple" } }
19      !$acc loop &
20    !$acc & & ! Fortran location information points to the last line, and last character of the directive.
21      !$acc  &   & ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:26:22\\\] #pragma acc loop" 1 "original" } }
22     !$acc &     & ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:26:22\\\] #pragma acc loop" 1 "gimple" } }
23    !$acc&       reduction  ( +    : sum ) & ! { dg-line sum1 }
24 !$acc && ! Fortran location information points to the ':' in 'reduction(+:sum)'.
25   !$acc   &    &  ! { dg-message "36: location of the previous reduction for 'sum'" "" { target *-*-* } sum1 }
26!$acc&     independent
27  do i = 1, 10
28      !$acc loop &
29!$acc & & ! Fortran location information points to the last line, and last character of the directive.
30   !$acc & & ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:36:34\\\] #pragma acc loop" 1 "original" } }
31    !$acc & & ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:36:34\\\] #pragma acc loop" 1 "gimple" } }
32  !$acc & reduction(-: diff     ) &
33             !$acc&reduction(- :    sum) & ! { dg-line sum2 }
34            !$acc & & ! Fortran location information points to the ':' in 'reduction(-:sum)'.
35          !$acc& & ! { dg-warning "32: conflicting reduction operations for 'sum'" "" { target *-*-* } sum2 }
36          !$acc       &independent
37     do j = 1, 10
38           sum &
39   & = &
40      & 1
41        ! Fortran location information points to the last line, and last character of the statement.
42        ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:40:9\\\] sum = 1" 1 "original" } }
43        ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:40:9\\\] sum = 1" 1 "gimple" } }
44     end do
45  end do
46!$acc end  parallel
47end subroutine check
48
49
50subroutine gwv_sl_1 ()
51  implicit none (type, external)
52  integer :: i
53
54  !$acc serial loop &
55  !$acc &       gang(num:5) & ! { dg-error "25: argument not permitted on 'gang' clause" }
56  !$acc &    worker(num:5) & ! { dg-error "24: argument not permitted on 'worker' clause" }
57  !$acc &     vector(length:5) ! { dg-error "28: argument not permitted on 'vector' clause" }
58  ! { dg-message "93: enclosing parent compute construct" "" { target *-*-* } .-1 }
59  do i = 0, 10
60  end do
61  !$acc end serial loop
62end subroutine gwv_sl_1
63
64subroutine gwv_sl_2 ()
65  implicit none (type, external)
66  integer :: i, j, k
67
68  !$acc serial loop ! { dg-message "77: enclosing parent compute construct" }
69  do i = 0, 10
70     !$acc loop ! { dg-bogus "enclosing parent compute construct" }
71     do j = 0, 10
72        !$acc loop &
73        !$acc &           gang(num:5) & ! { dg-error "35: argument not permitted on 'gang' clause" }
74        !$acc &      worker(num:5) & ! { dg-error "32: argument not permitted on 'worker' clause" }
75        !$acc &    vector(length:5) ! { dg-error "33: argument not permitted on 'vector' clause" }
76        do k = 0, 10
77        end do
78     end do
79  end do
80  !$acc end serial loop
81end subroutine gwv_sl_2
82
83subroutine gwv_s_l ()
84  implicit none (type, external)
85  integer :: i, j, k
86
87  !$acc serial ! { dg-message "72: enclosing parent compute construct" }
88  !$acc loop &
89  !$acc &         gang(num:5) & ! { dg-error "27: argument not permitted on 'gang' clause" }
90  !$acc &   worker(num:5) & ! { dg-error "23: argument not permitted on 'worker' clause" }
91  !$acc &      vector(length:5) ! { dg-error "29: argument not permitted on 'vector' clause" }
92  do i = 0, 10
93  end do
94
95  !$acc loop
96  do i = 0, 10
97     !$acc loop ! { dg-bogus "enclosing parent compute construct" }
98     do j = 0, 10
99        !$acc loop &
100        !$acc &           gang(num:5) & ! { dg-error "35: argument not permitted on 'gang' clause" }
101        !$acc &      worker(num:5) & ! { dg-error "32: argument not permitted on 'worker' clause" }
102        !$acc &        vector(length:5) ! { dg-error "37: argument not permitted on 'vector' clause" }
103        do k = 0, 10
104        end do
105     end do
106  end do
107!$acc end serial
108end subroutine gwv_s_l
109
110subroutine gwv_r () ! { dg-message "16: enclosing routine" }
111  implicit none (type, external)
112  integer :: i, j, k
113
114  !$acc routine(gwv_r)
115
116  !$acc loop &
117  !$acc &     gang(num:5) & ! { dg-error "23: argument not permitted on 'gang' clause" }
118  !$acc &      worker(num:5) & ! { dg-error "26: argument not permitted on 'worker' clause" }
119  !$acc &    vector(length:5) ! { dg-error "27: argument not permitted on 'vector' clause" }
120  do i = 0, 10
121  end do
122
123  !$acc loop
124  do i = 0, 10
125     !$acc loop
126     do j = 0, 10
127        !$acc loop &
128        !$acc &       gang(num:5) & ! { dg-error "31: argument not permitted on 'gang' clause" }
129        !$acc &     worker(num:5) & ! { dg-error "31: argument not permitted on 'worker' clause" }
130        !$acc &       vector(length:5) ! { dg-error "36: argument not permitted on 'vector' clause" }
131        do k = 0, 10
132        end do
133     end do
134  end do
135end subroutine gwv_r
136