From patchwork Thu Jul 8 17:40:00 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Jakub Jelinek X-Patchwork-Id: 58267 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id 60670B6EF0 for ; Fri, 9 Jul 2010 03:38:57 +1000 (EST) Received: (qmail 5907 invoked by alias); 8 Jul 2010 17:38:54 -0000 Received: (qmail 5878 invoked by uid 22791); 8 Jul 2010 17:38:49 -0000 X-SWARE-Spam-Status: No, hits=-6.1 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_HI, SPF_HELO_PASS, T_RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from mx1.redhat.com (HELO mx1.redhat.com) (209.132.183.28) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Thu, 08 Jul 2010 17:38:39 +0000 Received: from int-mx03.intmail.prod.int.phx2.redhat.com (int-mx03.intmail.prod.int.phx2.redhat.com [10.5.11.16]) by mx1.redhat.com (8.13.8/8.13.8) with ESMTP id o68HcblA000408 (version=TLSv1/SSLv3 cipher=DHE-RSA-AES256-SHA bits=256 verify=OK); Thu, 8 Jul 2010 13:38:37 -0400 Received: from tyan-ft48-01.lab.bos.redhat.com (tyan-ft48-01.lab.bos.redhat.com [10.16.42.4]) by int-mx03.intmail.prod.int.phx2.redhat.com (8.13.8/8.13.8) with ESMTP id o68HcaqE008948 (version=TLSv1/SSLv3 cipher=DHE-RSA-AES256-SHA bits=256 verify=NO); Thu, 8 Jul 2010 13:38:37 -0400 Received: from tyan-ft48-01.lab.bos.redhat.com (tyan-ft48-01.lab.bos.redhat.com [127.0.0.1]) by tyan-ft48-01.lab.bos.redhat.com (8.14.4/8.14.4) with ESMTP id o68He0nc006229; Thu, 8 Jul 2010 19:40:00 +0200 Received: (from jakub@localhost) by tyan-ft48-01.lab.bos.redhat.com (8.14.4/8.14.4/Submit) id o68He0QT006228; Thu, 8 Jul 2010 19:40:00 +0200 Date: Thu, 8 Jul 2010 19:40:00 +0200 From: Jakub Jelinek To: gcc-patches@gcc.gnu.org Cc: fortran@gcc.gnu.org Subject: [committed] Fix exit and cycle handling in collapsed !$omp do (PR fortran/44847) Message-ID: <20100708174000.GN20208@tyan-ft48-01.lab.bos.redhat.com> Reply-To: Jakub Jelinek MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.20 (2009-12-10) X-IsSubscribed: yes Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Hi! The following patch fixes match_exit_cycle diagnostics for collapsed omp do loops. Bootstrapped/regtested on x86_64-linux and i686-linux, applied to trunk/4.5/4.4. 2010-07-08 Jakub Jelinek PR fortran/44847 * match.c (match_exit_cycle): Error on EXIT also from collapsed !$omp do loops. Error on CYCLE to non-innermost collapsed !$omp do loops. * gfortran.dg/gomp/pr44847.f90: New test. Jakub --- gcc/fortran/match.c.jj 2010-07-08 12:33:29.000000000 +0200 +++ gcc/fortran/match.c 2010-07-08 12:41:06.000000000 +0200 @@ -2000,6 +2000,7 @@ match_exit_cycle (gfc_statement st, gfc_ gfc_state_data *p, *o; gfc_symbol *sym; match m; + int cnt; if (gfc_match_eos () == MATCH_YES) sym = NULL; @@ -2022,7 +2023,7 @@ match_exit_cycle (gfc_statement st, gfc_ } } - /* 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; @@ -2053,17 +2054,34 @@ match_exit_cycle (gfc_statement st, gfc_ 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. */ --- gcc/testsuite/gfortran.dg/gomp/pr44847.f90.jj 2010-07-08 12:36:38.000000000 +0200 +++ gcc/testsuite/gfortran.dg/gomp/pr44847.f90 2010-07-08 12:38:06.000000000 +0200 @@ -0,0 +1,86 @@ +! 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