From patchwork Tue Jul 12 20:03:43 2016 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Cesar Philippidis X-Patchwork-Id: 647603 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]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 3rptG05L0Tz9s9W for ; Wed, 13 Jul 2016 06:04:08 +1000 (AEST) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b=OwFLREMN; dkim-atps=neutral DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :subject:to:message-id:date:mime-version:content-type; q=dns; s= default; b=FHgDvjWp90DEO157vsYwiVmsZtzZX9fTTtumAG32IbIUtkPiadKwo W0Z9LL7A4xO6chDZn9i2nmLsHo8jMDQnMOtVuq8Mb0guRKkDu29jwkWng39Pv5BG gWk2sTmJd9zxjLMs/DwhctQyXb7VtGSO/fnup4iagc8H+3CKiiFF8Q= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :subject:to:message-id:date:mime-version:content-type; s= default; bh=i70ByqsmzYdBgfF2rGuEFDQSSLQ=; b=OwFLREMNVgwR0drpcWg+ Nk7NmNPdiwbA2qbB8i5SFmC796/a85LGsmCj+z+4bE5lqCQvqLp2vdPRL4b+9SrY erTvEth90Z09cfhQfSAV8v2X2AXc5fix0AMleWPXQpuBCcpt3IFZz+tVvXRfGAYo suiWWjjQN8J7MtYlLz/UYz0= Received: (qmail 30587 invoked by alias); 12 Jul 2016 20:03:59 -0000 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 Received: (qmail 30567 invoked by uid 89); 12 Jul 2016 20:03:58 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-1.7 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.2 spammy=8956, 71704, goacc, pr71704.f90 X-HELO: relay1.mentorg.com Received: from relay1.mentorg.com (HELO relay1.mentorg.com) (192.94.38.131) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES256-GCM-SHA384 encrypted) ESMTPS; Tue, 12 Jul 2016 20:03:48 +0000 Received: from svr-orw-fem-06.mgc.mentorg.com ([147.34.97.120]) by relay1.mentorg.com with esmtp id 1bN3uC-0007Z8-Fl from Cesar_Philippidis@mentor.com for gcc-patches@gcc.gnu.org; Tue, 12 Jul 2016 13:03:44 -0700 Received: from [127.0.0.1] (147.34.91.1) by SVR-ORW-FEM-06.mgc.mentorg.com (147.34.97.120) with Microsoft SMTP Server id 14.3.224.2; Tue, 12 Jul 2016 13:03:44 -0700 From: Cesar Philippidis Subject: [gomp4] backport fixes for PR71704 To: "gcc-patches@gcc.gnu.org" Message-ID: <57854D1F.3080000@codesourcery.com> Date: Tue, 12 Jul 2016 13:03:43 -0700 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:38.0) Gecko/20100101 Thunderbird/38.8.0 MIME-Version: 1.0 This patch contains both Jakub's OpenMP and my OpenACC fixes for PR71704. For reference, the discussion for the original patches can be found here . I'll apply this patch to gomp-4_0-branch shortly. Cesar 2016-07-12 Cesar Philippidis Backport from trunk: 2016-07-08 Cesar Philippidis gcc/fortran/ * parse.c (matcha): Define. (decode_oacc_directive): Add spec_only local var and set it. Use matcha to parse acc directives except for routine and declare. Return ST_GET_FCN_CHARACTERISTICS if a non-declarative directive could be matched. gcc/testsuite/ * gfortran.dg/goacc/pr71704.f90: New test. 2016-06-01 Jakub Jelinek gcc/fortran/ * parse.c (case_decl): Move ST_OMP_* to ... (case_omp_decl): ... here, new macro. (verify_st_order): For case_omp_decl, complain about p->state >= ORDER_EXEC, but don't change p->state otherwise. gcc/testsuite * gfortran.dg/gomp/order-1.f90: New test. * gfortran.dg/gomp/order-2.f90: New test. diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 7bce47f..ccc5d6c 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -585,21 +585,12 @@ decode_statement (void) return ST_NONE; } -/* Like match, but set a flag simd_matched if keyword matched. */ -#define matchs(keyword, subr, st) \ +/* Like match and if spec_only, goto do_spec_only without actually + matching. */ +#define matcha(keyword, subr, st) \ do { \ - if (match_word_omp_simd (keyword, subr, &old_locus, \ - &simd_matched) == MATCH_YES) \ - return st; \ - else \ - undo_new_statement (); \ - } while (0); - -/* Like match, but don't match anything if not -fopenmp. */ -#define matcho(keyword, subr, st) \ - do { \ - if (!flag_openmp) \ - ; \ + if (spec_only && gfc_match (keyword) == MATCH_YES) \ + goto do_spec_only; \ else if (match_word (keyword, subr, &old_locus) \ == MATCH_YES) \ return st; \ @@ -612,6 +603,7 @@ decode_oacc_directive (void) { locus old_locus; char c; + bool spec_only = false; gfc_enforce_clean_symbol_state (); @@ -626,6 +618,10 @@ decode_oacc_directive (void) return ST_NONE; } + if (gfc_current_state () == COMP_FUNCTION + && gfc_current_block ()->result->ts.kind == -1) + spec_only = true; + gfc_unset_implicit_pure (NULL); old_locus = gfc_current_locus; @@ -639,49 +635,52 @@ decode_oacc_directive (void) switch (c) { case 'a': - match ("atomic", gfc_match_oacc_atomic, ST_OACC_ATOMIC); + matcha ("atomic", gfc_match_oacc_atomic, ST_OACC_ATOMIC); break; case 'c': - match ("cache", gfc_match_oacc_cache, ST_OACC_CACHE); + matcha ("cache", gfc_match_oacc_cache, ST_OACC_CACHE); break; case 'd': - match ("data", gfc_match_oacc_data, ST_OACC_DATA); + matcha ("data", gfc_match_oacc_data, ST_OACC_DATA); match ("declare", gfc_match_oacc_declare, ST_OACC_DECLARE); break; case 'e': - match ("end atomic", gfc_match_omp_eos, ST_OACC_END_ATOMIC); - match ("end data", gfc_match_omp_eos, ST_OACC_END_DATA); - match ("end host_data", gfc_match_omp_eos, ST_OACC_END_HOST_DATA); - match ("end kernels loop", gfc_match_omp_eos, ST_OACC_END_KERNELS_LOOP); - match ("end kernels", gfc_match_omp_eos, ST_OACC_END_KERNELS); - match ("end loop", gfc_match_omp_eos, ST_OACC_END_LOOP); - match ("end parallel loop", gfc_match_omp_eos, ST_OACC_END_PARALLEL_LOOP); - match ("end parallel", gfc_match_omp_eos, ST_OACC_END_PARALLEL); - match ("enter data", gfc_match_oacc_enter_data, ST_OACC_ENTER_DATA); - match ("exit data", gfc_match_oacc_exit_data, ST_OACC_EXIT_DATA); + matcha ("end atomic", gfc_match_omp_eos, ST_OACC_END_ATOMIC); + matcha ("end data", gfc_match_omp_eos, ST_OACC_END_DATA); + matcha ("end host_data", gfc_match_omp_eos, ST_OACC_END_HOST_DATA); + matcha ("end kernels loop", gfc_match_omp_eos, ST_OACC_END_KERNELS_LOOP); + matcha ("end kernels", gfc_match_omp_eos, ST_OACC_END_KERNELS); + matcha ("end loop", gfc_match_omp_eos, ST_OACC_END_LOOP); + matcha ("end parallel loop", gfc_match_omp_eos, + ST_OACC_END_PARALLEL_LOOP); + matcha ("end parallel", gfc_match_omp_eos, ST_OACC_END_PARALLEL); + matcha ("enter data", gfc_match_oacc_enter_data, ST_OACC_ENTER_DATA); + matcha ("exit data", gfc_match_oacc_exit_data, ST_OACC_EXIT_DATA); break; case 'h': - match ("host_data", gfc_match_oacc_host_data, ST_OACC_HOST_DATA); + matcha ("host_data", gfc_match_oacc_host_data, ST_OACC_HOST_DATA); break; case 'p': - match ("parallel loop", gfc_match_oacc_parallel_loop, ST_OACC_PARALLEL_LOOP); - match ("parallel", gfc_match_oacc_parallel, ST_OACC_PARALLEL); + matcha ("parallel loop", gfc_match_oacc_parallel_loop, + ST_OACC_PARALLEL_LOOP); + matcha ("parallel", gfc_match_oacc_parallel, ST_OACC_PARALLEL); break; case 'k': - match ("kernels loop", gfc_match_oacc_kernels_loop, ST_OACC_KERNELS_LOOP); - match ("kernels", gfc_match_oacc_kernels, ST_OACC_KERNELS); + matcha ("kernels loop", gfc_match_oacc_kernels_loop, + ST_OACC_KERNELS_LOOP); + matcha ("kernels", gfc_match_oacc_kernels, ST_OACC_KERNELS); break; case 'l': - match ("loop", gfc_match_oacc_loop, ST_OACC_LOOP); + matcha ("loop", gfc_match_oacc_loop, ST_OACC_LOOP); break; case 'r': match ("routine", gfc_match_oacc_routine, ST_OACC_ROUTINE); break; case 'u': - match ("update", gfc_match_oacc_update, ST_OACC_UPDATE); + matcha ("update", gfc_match_oacc_update, ST_OACC_UPDATE); break; case 'w': - match ("wait", gfc_match_oacc_wait, ST_OACC_WAIT); + matcha ("wait", gfc_match_oacc_wait, ST_OACC_WAIT); break; } @@ -696,14 +695,72 @@ decode_oacc_directive (void) gfc_error_recovery (); return ST_NONE; + + do_spec_only: + reject_statement (); + gfc_clear_error (); + gfc_buffer_error (false); + gfc_current_locus = old_locus; + return ST_GET_FCN_CHARACTERISTICS; } +/* Like match, but set a flag simd_matched if keyword matched + and if spec_only, goto do_spec_only without actually matching. */ +#define matchs(keyword, subr, st) \ + do { \ + if (spec_only && gfc_match (keyword) == MATCH_YES) \ + goto do_spec_only; \ + if (match_word_omp_simd (keyword, subr, &old_locus, \ + &simd_matched) == MATCH_YES) \ + return st; \ + else \ + undo_new_statement (); \ + } while (0); + +/* Like match, but don't match anything if not -fopenmp + and if spec_only, goto do_spec_only without actually matching. */ +#define matcho(keyword, subr, st) \ + do { \ + if (!flag_openmp) \ + ; \ + else if (spec_only && gfc_match (keyword) == MATCH_YES) \ + goto do_spec_only; \ + else if (match_word (keyword, subr, &old_locus) \ + == MATCH_YES) \ + return st; \ + else \ + undo_new_statement (); \ + } while (0); + +/* Like match, but set a flag simd_matched if keyword matched. */ +#define matchds(keyword, subr, st) \ + do { \ + if (match_word_omp_simd (keyword, subr, &old_locus, \ + &simd_matched) == MATCH_YES) \ + return st; \ + else \ + undo_new_statement (); \ + } while (0); + +/* Like match, but don't match anything if not -fopenmp. */ +#define matchdo(keyword, subr, st) \ + do { \ + if (!flag_openmp) \ + ; \ + else if (match_word (keyword, subr, &old_locus) \ + == MATCH_YES) \ + return st; \ + else \ + undo_new_statement (); \ + } while (0); + static gfc_statement decode_omp_directive (void) { locus old_locus; char c; bool simd_matched = false; + bool spec_only = false; gfc_enforce_clean_symbol_state (); @@ -718,6 +775,10 @@ decode_omp_directive (void) return ST_NONE; } + if (gfc_current_state () == COMP_FUNCTION + && gfc_current_block ()->result->ts.kind == -1) + spec_only = true; + gfc_unset_implicit_pure (NULL); old_locus = gfc_current_locus; @@ -746,12 +807,12 @@ decode_omp_directive (void) matcho ("critical", gfc_match_omp_critical, ST_OMP_CRITICAL); break; case 'd': - matchs ("declare reduction", gfc_match_omp_declare_reduction, - ST_OMP_DECLARE_REDUCTION); - matchs ("declare simd", gfc_match_omp_declare_simd, - ST_OMP_DECLARE_SIMD); - matcho ("declare target", gfc_match_omp_declare_target, - ST_OMP_DECLARE_TARGET); + matchds ("declare reduction", gfc_match_omp_declare_reduction, + ST_OMP_DECLARE_REDUCTION); + matchds ("declare simd", gfc_match_omp_declare_simd, + ST_OMP_DECLARE_SIMD); + matchdo ("declare target", gfc_match_omp_declare_target, + ST_OMP_DECLARE_TARGET); matchs ("distribute parallel do simd", gfc_match_omp_distribute_parallel_do_simd, ST_OMP_DISTRIBUTE_PARALLEL_DO_SIMD); @@ -871,8 +932,8 @@ decode_omp_directive (void) matcho ("teams distribute", gfc_match_omp_teams_distribute, ST_OMP_TEAMS_DISTRIBUTE); matcho ("teams", gfc_match_omp_teams, ST_OMP_TEAMS); - matcho ("threadprivate", gfc_match_omp_threadprivate, - ST_OMP_THREADPRIVATE); + matchdo ("threadprivate", gfc_match_omp_threadprivate, + ST_OMP_THREADPRIVATE); break; case 'w': matcho ("workshare", gfc_match_omp_workshare, ST_OMP_WORKSHARE); @@ -895,6 +956,13 @@ decode_omp_directive (void) gfc_error_recovery (); return ST_NONE; + + do_spec_only: + reject_statement (); + gfc_clear_error (); + gfc_buffer_error (false); + gfc_current_locus = old_locus; + return ST_GET_FCN_CHARACTERISTICS; } static gfc_statement @@ -1315,10 +1383,13 @@ next_statement (void) gfc_buffer_error (false); - if (st == ST_GET_FCN_CHARACTERISTICS && gfc_statement_label != NULL) + if (st == ST_GET_FCN_CHARACTERISTICS) { - gfc_free_st_label (gfc_statement_label); - gfc_statement_label = NULL; + if (gfc_statement_label != NULL) + { + gfc_free_st_label (gfc_statement_label); + gfc_statement_label = NULL; + } gfc_current_locus = old_locus; } diff --git a/gcc/testsuite/gfortran.dg/goacc/pr71704.f90 b/gcc/testsuite/gfortran.dg/goacc/pr71704.f90 new file mode 100644 index 0000000..0235e85 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/pr71704.f90 @@ -0,0 +1,60 @@ +! PR fortran/71704 +! { dg-do compile } + +real function f1 () +!$acc routine (f1) + f1 = 1 +end + +real function f2 (a) + integer a + !$acc enter data copyin(a) + f2 = 1 +end + +real function f3 (a) + integer a +!$acc enter data copyin(a) + f3 = 1 +end + +real function f4 () +!$acc wait + f4 = 1 +end + +real function f5 (a) + integer a +!$acc update device(a) + f5 = 1 +end + +real function f6 () +!$acc parallel +!$acc end parallel + f6 = 1 +end + +real function f7 () +!$acc kernels +!$acc end kernels + f7 = 1 +end + +real function f8 () +!$acc data +!$acc end data + f8 = 1 +end + +real function f9 () +!$acc host_data +!$acc end host_data + f8 = 1 +end + +real function f10 (a) + integer a +!$acc declare present (a) + f8 = 1 +end diff --git a/gcc/testsuite/gfortran.dg/gomp/pr71704.f90 b/gcc/testsuite/gfortran.dg/gomp/pr71704.f90 new file mode 100644 index 0000000..5c1c003 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/pr71704.f90 @@ -0,0 +1,58 @@ +! PR fortran/71704 +! { dg-do compile } + +real function f0 () +!$omp declare simd (f0) + f0 = 1 +end + +real function f1 () +!$omp declare target (f1) + f1 = 1 +end + +real function f2 () +!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) & +!$omp & initializer (omp_priv = 0) + f2 = 1 +end + +real function f3 () + real, save :: t +!$omp threadprivate (t) + f3 = 1 +end + +real function f4 () +!$omp taskwait + f4 = 1 +end + +real function f5 () +!$omp barrier + f5 = 1 +end + +real function f6 () +!$omp parallel +!$omp end parallel + f6 = 1 +end + +real function f7 () +!$omp single +!$omp end single + f7 = 1 +end + +real function f8 () +!$omp critical +!$omp end critical + f8 = 1 +end + +real function f9 () +!$omp critical +!$omp end critical + f9 = 1 +end