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 data, enter data, exit data, host_data, parallel, kernels, update and wait directives. Return ST_GET_FCN_CHARACTERISTICS if a non-declarative directive could be matched. gcc/testsuite/ * gfortran.dg/goacc/pr71704.f90: New test. diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index d795225..39fdd90 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; @@ -627,7 +645,7 @@ decode_oacc_directive (void) match ("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': @@ -639,19 +657,19 @@ decode_oacc_directive (void) 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 ("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", 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", gfc_match_oacc_kernels, ST_OACC_KERNELS); break; case 'l': match ("loop", gfc_match_oacc_loop, ST_OACC_LOOP); @@ -660,10 +678,10 @@ decode_oacc_directive (void) 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 +696,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/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