From: Jakub Jelinek <jakub@redhat.com>
To: gcc-patches@gcc.gnu.org, fortran@gcc.gnu.org
Cc: Cesar Philippidis <cesar@codesourcery.com>
Subject: [committed] Fix OpenMP parsing of the specification part in functions (PR fortran/71704)
Date: Thu, 30 Jun 2016 17:47:00 -0000 [thread overview]
Message-ID: <20160630174728.GQ7387@tucnak.redhat.com> (raw)
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 <jakub@redhat.com>
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
next reply other threads:[~2016-06-30 17:47 UTC|newest]
Thread overview: 9+ messages / expand[flat|nested] mbox.gz Atom feed top
2016-06-30 17:47 Jakub Jelinek [this message]
2016-07-08 16:13 ` Cesar Philippidis
2016-07-08 16:18 ` Jakub Jelinek
2016-07-08 16:19 ` Cesar Philippidis
2016-07-08 16:31 ` Jakub Jelinek
2016-07-08 16:59 ` Cesar Philippidis
2016-07-08 17:25 ` Jakub Jelinek
2016-07-08 18:26 ` Cesar Philippidis
2016-07-08 18:31 ` Jakub Jelinek
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20160630174728.GQ7387@tucnak.redhat.com \
--to=jakub@redhat.com \
--cc=cesar@codesourcery.com \
--cc=fortran@gcc.gnu.org \
--cc=gcc-patches@gcc.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).