From: Cesar Philippidis Date: Fri, 8 Jul 2016 18:34:55 +0000 (-0700) Subject: parse.c (matcha): Define. X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=642bcbdf1d63f4c20070bfa7f15998f5b833a527;p=gcc.git parse.c (matcha): Define. 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. From-SVN: r238171 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index c9df4270bb3..4faf79780ab 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2016-07-08 Cesar Philippidis + + * 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. + 2016-07-08 Martin Liska * invoke.texi (Wundefined-do-loop): Enhance documentation. diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index d795225b711..0aa736c7089 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -589,11 +589,25 @@ decode_statement (void) return ST_NONE; } +/* Like match and if spec_only, goto do_spec_only without actually + matching. */ +#define matcha(keyword, subr, st) \ + do { \ + 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); + static gfc_statement decode_oacc_directive (void) { locus old_locus; char c; + bool spec_only = false; gfc_enforce_clean_symbol_state (); @@ -608,6 +622,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; @@ -621,49 +639,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; } @@ -678,6 +699,13 @@ 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 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 4f107b1af51..5245fdd44df 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2016-07-08 Cesar Philippidis + + * gfortran.dg/goacc/pr71704.f90: New test. + 2016-07-08 Bill Schmidt PR target/71297 diff --git a/gcc/testsuite/gfortran.dg/goacc/pr71704.f90 b/gcc/testsuite/gfortran.dg/goacc/pr71704.f90 new file mode 100644 index 00000000000..0235e85d42a --- /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