From patchwork Sat Oct 15 09:02:12 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Thomas Koenig X-Patchwork-Id: 119960 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 7A61CB70FF for ; Sat, 15 Oct 2011 20:02:52 +1100 (EST) Received: (qmail 8071 invoked by alias); 15 Oct 2011 09:02:42 -0000 Received: (qmail 8050 invoked by uid 22791); 15 Oct 2011 09:02:40 -0000 X-SWARE-Spam-Status: No, hits=-1.5 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_NONE, RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from cc-smtpout1.netcologne.de (HELO cc-smtpout1.netcologne.de) (89.1.8.211) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Sat, 15 Oct 2011 09:02:17 +0000 Received: from cc-smtpin1.netcologne.de (cc-smtpin1.netcologne.de [89.1.8.201]) by cc-smtpout1.netcologne.de (Postfix) with ESMTP id B456A128ED; Sat, 15 Oct 2011 11:02:14 +0200 (CEST) Received: from [192.168.0.105] (xdsl-78-35-172-51.netcologne.de [78.35.172.51]) by cc-smtpin1.netcologne.de (Postfix) with ESMTPSA id 85DC111DB9; Sat, 15 Oct 2011 11:02:13 +0200 (CEST) Message-ID: <4E994C14.30008@netcologne.de> Date: Sat, 15 Oct 2011 11:02:12 +0200 From: Thomas Koenig User-Agent: Mozilla/5.0 (X11; U; Linux x86_64; de; rv:1.9.2.17) Gecko/20110414 SUSE/3.1.10 Thunderbird/3.1.10 MIME-Version: 1.0 To: "fortran@gcc.gnu.org" , gcc-patches Subject: [patch, Fortran] Fix PR 50690 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 Hello world, here is a fix for PR 50690, pretty self-explanatory. Regression-tested. OK for trunk? Thomas 2011-10-15 Thomas Koenig PR fortran/50690 * frontend-passes.c (omp_level): New variable. (create_var): If we are within an OMP block, put the variable in the enclosing namespace and set the threadprivate attribute. (optimize_namespace): Initialize omp_level. (gfc_code_walker): Keep track of omp level. 2011-10-15 Thomas Koenig PR fortran/50690 * gfortran.dg/gomp/workshare2.f90: New test. ! { dg-do run } ! { dg-options "-ffrontend-optimize" } ! PR 50690 - this used to ICE because workshare could not handle ! BLOCKs. program foo implicit none real, parameter :: eps = 3e-7 integer :: i real :: A(10), B(5), C(10) B(1) = 3.344 call random_number(a) c = a !$omp parallel default(shared) !$omp workshare A(:) = A(:)*cos(B(1))+A(:)*cos(B(1)) !$omp end workshare nowait !$omp end parallel ! sync is implied here c = c*cos(b(1)) + c*cos(b(1)) if (any(abs(a-c) > eps)) call abort end program foo Index: frontend-passes.c =================================================================== --- frontend-passes.c (Revision 179770) +++ frontend-passes.c (Arbeitskopie) @@ -66,6 +66,11 @@ gfc_namespace *current_ns; static int forall_level; +/* Keep track of the OMP statements, to make sure we can + mark variables introduced by optimizations as threadprivate. */ + +static int omp_level; + /* Entry point - run all passes for a namespace. So far, only an optimization pass is run. */ @@ -245,9 +250,17 @@ create_var (gfc_expr * e) gfc_namespace *ns; int i; - /* If the block hasn't already been created, do so. */ - if (inserted_block == NULL) + /* If the block hasn't already been created, do so. If we are within + an OMP construct, create the temporary variable in the current block. + This is to avoid problems with OMP workshare. */ + + if (omp_level > 0) { + ns = current_ns; + changed_statement = current_code; + } + else if (inserted_block == NULL) + { inserted_block = XCNEW (gfc_code); inserted_block->op = EXEC_BLOCK; inserted_block->loc = (*current_code)->loc; @@ -308,6 +321,9 @@ create_var (gfc_expr * e) symbol->attr.flavor = FL_VARIABLE; symbol->attr.referenced = 1; symbol->attr.dimension = e->rank > 0; + if (omp_level > 0) + symbol->attr.threadprivate = 1; + gfc_commit_symbol (symbol); result = gfc_get_expr (); @@ -504,6 +520,7 @@ optimize_namespace (gfc_namespace *ns) current_ns = ns; forall_level = 0; + omp_level = 0; gfc_code_walker (&ns->code, convert_do_while, dummy_expr_callback, NULL); gfc_code_walker (&ns->code, cfe_code, cfe_expr_0, NULL); @@ -1143,11 +1160,13 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t code gfc_code *b; gfc_actual_arglist *a; gfc_code *co; + bool in_omp; /* There might be statement insertions before the current code, which must not affect the expression walker. */ co = *c; + in_omp = false; switch (co->op) { @@ -1326,6 +1345,9 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t code case EXEC_OMP_WORKSHARE: case EXEC_OMP_END_SINGLE: case EXEC_OMP_TASK: + + in_omp = 1; + omp_level ++; if (co->ext.omp_clauses) { WALK_SUBEXPR (co->ext.omp_clauses->if_expr); @@ -1352,6 +1374,9 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t code if (co->op == EXEC_FORALL) forall_level --; + if (in_omp) + omp_level --; + } } return 0;