gfc_state_data *p, *o;
gfc_symbol *sym;
match m;
+ int cnt;
if (gfc_match_eos () == MATCH_YES)
sym = NULL;
}
}
- /* Find the loop mentioned specified by the label (or lack of a label). */
+ /* Find the loop specified by the label (or lack of a label). */
for (o = NULL, p = gfc_state_stack; p; p = p->previous)
if (p->state == COMP_DO && (sym == NULL || sym == p->sym))
break;
gfc_ascii_statement (st));
return MATCH_ERROR;
}
- else if (st == ST_EXIT
- && p->previous != NULL
- && p->previous->state == COMP_OMP_STRUCTURED_BLOCK
- && (p->previous->head->op == EXEC_OMP_DO
- || p->previous->head->op == EXEC_OMP_PARALLEL_DO))
- {
- gcc_assert (p->previous->head->next != NULL);
- gcc_assert (p->previous->head->next->op == EXEC_DO
- || p->previous->head->next->op == EXEC_DO_WHILE);
- gfc_error ("EXIT statement at %C terminating !$OMP DO loop");
- return MATCH_ERROR;
+
+ for (o = p, cnt = 0; o->state == COMP_DO && o->previous != NULL; cnt++)
+ o = o->previous;
+ if (cnt > 0
+ && o != NULL
+ && o->state == COMP_OMP_STRUCTURED_BLOCK
+ && (o->head->op == EXEC_OMP_DO
+ || o->head->op == EXEC_OMP_PARALLEL_DO))
+ {
+ int collapse = 1;
+ gcc_assert (o->head->next != NULL
+ && (o->head->next->op == EXEC_DO
+ || o->head->next->op == EXEC_DO_WHILE)
+ && o->previous != NULL
+ && o->previous->tail->op == o->head->op);
+ if (o->previous->tail->ext.omp_clauses != NULL
+ && o->previous->tail->ext.omp_clauses->collapse > 1)
+ collapse = o->previous->tail->ext.omp_clauses->collapse;
+ if (st == ST_EXIT && cnt <= collapse)
+ {
+ gfc_error ("EXIT statement at %C terminating !$OMP DO loop");
+ return MATCH_ERROR;
+ }
+ if (st == ST_CYCLE && cnt < collapse)
+ {
+ gfc_error ("CYCLE statement at %C to non-innermost collapsed !$OMP DO loop");
+ return MATCH_ERROR;
+ }
}
/* Save the first statement in the loop - needed by the backend. */
--- /dev/null
+! PR fortran/44847
+! { dg-do compile }
+! { dg-options "-fopenmp" }
+
+subroutine pr44847_1
+ integer :: i, j
+!$omp parallel do collapse(2)
+l:do i = 1, 2
+ do j = 1, 2
+ cycle l ! { dg-error "CYCLE statement" }
+ end do
+ end do l
+end subroutine
+subroutine pr44847_2
+ integer :: i, j, k
+!$omp parallel do collapse(3)
+ do i = 1, 2
+ l:do j = 1, 2
+ do k = 1, 2
+ cycle l ! { dg-error "CYCLE statement" }
+ end do
+ end do l
+ end do
+end subroutine
+subroutine pr44847_3
+ integer :: i, j
+!$omp parallel do
+l:do i = 1, 2
+ do j = 1, 2
+ cycle l
+ end do
+ end do l
+end subroutine
+subroutine pr44847_4
+ integer :: i, j, k
+!$omp parallel do collapse(2)
+ do i = 1, 2
+ l:do j = 1, 2
+ do k = 1, 2
+ cycle l
+ end do
+ end do l
+ end do
+end subroutine
+subroutine pr44847_5
+ integer :: i, j
+!$omp parallel do collapse(2)
+l:do i = 1, 2
+ do j = 1, 2
+ exit l ! { dg-error "EXIT statement" }
+ end do
+ end do l
+end subroutine
+subroutine pr44847_6
+ integer :: i, j, k
+!$omp parallel do collapse(3)
+ do i = 1, 2
+ l:do j = 1, 2
+ do k = 1, 2
+ exit l ! { dg-error "EXIT statement" }
+ end do
+ end do l
+ end do
+end subroutine
+subroutine pr44847_7
+ integer :: i, j, k
+!$omp parallel do collapse(2)
+ do i = 1, 2
+ l:do j = 1, 2
+ do k = 1, 2
+ exit l ! { dg-error "EXIT statement" }
+ end do
+ end do l
+ end do
+end subroutine
+subroutine pr44847_8
+ integer :: i, j, k
+!$omp parallel do
+ do i = 1, 2
+ l:do j = 1, 2
+ do k = 1, 2
+ exit l
+ end do
+ end do l
+ end do
+end subroutine