From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 19719 invoked by alias); 30 Jun 2016 17:47:36 -0000 Mailing-List: contact fortran-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Subscribe: List-Post: List-Help: , Sender: fortran-owner@gcc.gnu.org Received: (qmail 19697 invoked by uid 89); 30 Jun 2016 17:47:35 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-3.2 required=5.0 tests=BAYES_00,RP_MATCHES_RCVD,SPF_HELO_PASS autolearn=ham version=3.3.2 spammy=teams, queued X-Spam-User: qpsmtpd, 2 recipients X-HELO: mx1.redhat.com Received: from mx1.redhat.com (HELO mx1.redhat.com) (209.132.183.28) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES256-GCM-SHA384 encrypted) ESMTPS; Thu, 30 Jun 2016 17:47:34 +0000 Received: from int-mx09.intmail.prod.int.phx2.redhat.com (int-mx09.intmail.prod.int.phx2.redhat.com [10.5.11.22]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by mx1.redhat.com (Postfix) with ESMTPS id 156B47F340; Thu, 30 Jun 2016 17:47:33 +0000 (UTC) Received: from tucnak.zalov.cz (ovpn-116-51.ams2.redhat.com [10.36.116.51]) by int-mx09.intmail.prod.int.phx2.redhat.com (8.14.4/8.14.4) with ESMTP id u5UHlVqb032370 (version=TLSv1/SSLv3 cipher=DHE-RSA-AES256-GCM-SHA384 bits=256 verify=NO); Thu, 30 Jun 2016 13:47:32 -0400 Received: from tucnak.zalov.cz (localhost [127.0.0.1]) by tucnak.zalov.cz (8.15.2/8.15.2) with ESMTP id u5UHlT37027485; Thu, 30 Jun 2016 19:47:30 +0200 Received: (from jakub@localhost) by tucnak.zalov.cz (8.15.2/8.15.2/Submit) id u5UHlSFb027484; Thu, 30 Jun 2016 19:47:28 +0200 Date: Thu, 30 Jun 2016 17:47:00 -0000 From: Jakub Jelinek To: gcc-patches@gcc.gnu.org, fortran@gcc.gnu.org Cc: Cesar Philippidis Subject: [committed] Fix OpenMP parsing of the specification part in functions (PR fortran/71704) Message-ID: <20160630174728.GQ7387@tucnak.redhat.com> Reply-To: Jakub Jelinek MIME-Version: 1.0 Content-Type: text/plain; charset=us-ascii Content-Disposition: inline User-Agent: Mutt/1.5.24 (2015-08-30) X-SW-Source: 2016-06/txt/msg00127.txt.bz2 Hi! The Fortran parser apparently relies in functions that have still undecided kind of the result that ST_GET_FCN_CHARACTERISTICS artificial statement is returned before any executable statements in the function. In normal statements that is ensured through decode_statement calling decode_specification_statement, which parses just a subset of statements, but for OpenMP we need to do something similar. If we figure out we want only the case_omp_decl statements, for any other we just try to gfc_match the keyword and if we match it, it means we'd be about to return an OpenMP executable statement, so instead return ST_GET_FCN_CHARACTERISTICS. Bootstrapped/regtested on x86_64-linux and i686-linux, committed to trunk, queued for 6.2 backport. Cesar, note OpenACC will need something similar (though, decode_acc_statement uses just the match macro, so you'll need another one for the executable statements). 2016-06-30 Jakub Jelinek PR fortran/71704 * parse.c (matchs, matcho): Move right before decode_omp_directive. If spec_only, only gfc_match the keyword and if successful, goto do_spec_only. (matchds, matchdo): Define. (decode_omp_directive): Add spec_only local var and set it. Use matchds or matchdo macros instead of matchs or matcho for declare target, declare simd, declare reduction and threadprivate directives. Return ST_GET_FCN_CHARACTERISTICS if a non-declarative directive could be matched. (next_statement): For ST_GET_FCN_CHARACTERISTICS restore gfc_current_locus from old_locus even if there is no label. * gfortran.dg/gomp/pr71704.f90: New test. --- gcc/fortran/parse.c.jj 2016-06-01 14:20:51.000000000 +0200 +++ gcc/fortran/parse.c 2016-06-30 15:32:20.003410398 +0200 @@ -589,28 +589,6 @@ decode_statement (void) return ST_NONE; } -/* Like match, but set a flag simd_matched if keyword matched. */ -#define matchs(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) \ - ; \ - else if (match_word (keyword, subr, &old_locus) \ - == MATCH_YES) \ - return st; \ - else \ - undo_new_statement (); \ - } while (0); - static gfc_statement decode_oacc_directive (void) { @@ -702,12 +680,63 @@ decode_oacc_directive (void) return ST_NONE; } +/* 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 (); @@ -722,6 +751,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; @@ -750,12 +783,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); @@ -875,8 +908,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); @@ -899,6 +932,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 @@ -1319,10 +1359,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; } --- gcc/testsuite/gfortran.dg/gomp/pr71704.f90.jj 2016-06-30 15:26:45.920563584 +0200 +++ gcc/testsuite/gfortran.dg/gomp/pr71704.f90 2016-06-30 15:26:23.000000000 +0200 @@ -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 Jakub