Message ID | 878u7cny9v.fsf@kepler.schwinge.homeip.net |
---|---|
State | New |
Headers | show |
Hi! Ping... On Fri, 9 Oct 2015 12:15:24 +0200, I wrote: > On Mon, 27 Jul 2015 16:14:17 +0200, I wrote: > > On Tue, 30 Jun 2015 03:39:42 +0300, Ilmir Usmanov <me@ilmir.us> wrote: > > > 08.06.2015, 17:59, "Cesar Philippidis" <cesar@codesourcery.com>: > > > > On 06/07/2015 02:05 PM, Ilmir Usmanov wrote: > > > >> 08.06.2015, 00:01, "Ilmir Usmanov" <me@ilmir.us>: > > > >>>> This patch fixes checks of OpenMP and OpenACC continuations in > > > >>>> case if someone mixes them (i.e. continues OpenMP directive with > > > >>>> !$ACC sentinel or vice versa). > > > > Thanks for working on this! > > > > > >>>> OK for gomp branch? > > > > The same applies to GCC trunk, as far as I can tell -- any reason not to > > apply the patch to trunk? > > Ping -- OK to commit the following (by Ilmir) to trunk: > > commit 38e62678ef11f349f029d42439668071f170e059 > Author: Ilmir Usmanov <me@ilmir.us> > Date: Sun Jul 26 12:10:36 2015 +0000 > > [PR fortran/63858] Fix mix of OpenACC and OpenMP sentinels in continuations > > gcc/fortran/ > PR fortran/63858 > * scanner.c (skip_omp_attribute_fixed, skip_oacc_attribute_fixed): > New functions. > (skip_fixed_comments, gfc_next_char_literal): Fix mix of OpenACC > and OpenMP sentinels in continuation. > gcc/testsuite/ > PR fortran/63858 > * gfortran.dg/goacc/omp-fixed.f: New file. > * gfortran.dg/goacc/omp.f95: Extend. > --- > gcc/fortran/scanner.c | 258 +++++++++++++++++----------- > gcc/testsuite/gfortran.dg/goacc/omp-fixed.f | 32 ++++ > gcc/testsuite/gfortran.dg/goacc/omp.f95 | 10 +- > 3 files changed, 199 insertions(+), 101 deletions(-) > > diff --git gcc/fortran/scanner.c gcc/fortran/scanner.c > index bfb7d45..1e1ea84 100644 > --- gcc/fortran/scanner.c > +++ gcc/fortran/scanner.c > @@ -935,6 +935,63 @@ skip_free_comments (void) > return false; > } > > +/* Return true if MP was matched in fixed form. */ > +static bool > +skip_omp_attribute_fixed (locus *start) > +{ > + gfc_char_t c; > + if (((c = next_char ()) == 'm' || c == 'M') > + && ((c = next_char ()) == 'p' || c == 'P')) > + { > + c = next_char (); > + if (c != '\n' > + && (continue_flag > + || c == ' ' || c == '\t' || c == '0')) > + { > + do > + c = next_char (); > + while (gfc_is_whitespace (c)); > + if (c != '\n' && c != '!') > + { > + /* Canonicalize to *$omp. */ > + *start->nextc = '*'; > + openmp_flag = 1; > + gfc_current_locus = *start; > + return true; > + } > + } > + } > + return false; > +} > + > +/* Return true if CC was matched in fixed form. */ > +static bool > +skip_oacc_attribute_fixed (locus *start) > +{ > + gfc_char_t c; > + if (((c = next_char ()) == 'c' || c == 'C') > + && ((c = next_char ()) == 'c' || c == 'C')) > + { > + c = next_char (); > + if (c != '\n' > + && (continue_flag > + || c == ' ' || c == '\t' || c == '0')) > + { > + do > + c = next_char (); > + while (gfc_is_whitespace (c)); > + if (c != '\n' && c != '!') > + { > + /* Canonicalize to *$omp. */ > + *start->nextc = '*'; > + openacc_flag = 1; > + gfc_current_locus = *start; > + return true; > + } > + } > + } > + return false; > +} > > /* Skip comment lines in fixed source mode. We have the same rules as > in skip_free_comment(), except that we can have a 'c', 'C' or '*' > @@ -1003,128 +1060,92 @@ skip_fixed_comments (void) > && continue_line < gfc_linebuf_linenum (gfc_current_locus.lb)) > continue_line = gfc_linebuf_linenum (gfc_current_locus.lb); > > - if (flag_openmp || flag_openmp_simd) > + if ((flag_openmp || flag_openmp_simd) && !flag_openacc) > { > if (next_char () == '$') > { > c = next_char (); > if (c == 'o' || c == 'O') > { > - if (((c = next_char ()) == 'm' || c == 'M') > - && ((c = next_char ()) == 'p' || c == 'P')) > - { > - c = next_char (); > - if (c != '\n' > - && ((openmp_flag && continue_flag) > - || c == ' ' || c == '\t' || c == '0')) > - { > - do > - c = next_char (); > - while (gfc_is_whitespace (c)); > - if (c != '\n' && c != '!') > - { > - /* Canonicalize to *$omp. */ > - *start.nextc = '*'; > - openmp_flag = 1; > - gfc_current_locus = start; > - return; > - } > - } > - } > + if (skip_omp_attribute_fixed (&start)) > + return; > } > else > - { > - int digit_seen = 0; > - > - for (col = 3; col < 6; col++, c = next_char ()) > - if (c == ' ') > - continue; > - else if (c == '\t') > - { > - col = 6; > - break; > - } > - else if (c < '0' || c > '9') > - break; > - else > - digit_seen = 1; > + goto check_for_digits; > + } > + gfc_current_locus = start; > + } > > - if (col == 6 && c != '\n' > - && ((continue_flag && !digit_seen) > - || c == ' ' || c == '\t' || c == '0')) > - { > - gfc_current_locus = start; > - start.nextc[0] = ' '; > - start.nextc[1] = ' '; > - continue; > - } > + if (flag_openacc && !(flag_openmp || flag_openmp_simd)) > + { > + if (next_char () == '$') > + { > + c = next_char (); > + if (c == 'a' || c == 'A') > + { > + if (skip_oacc_attribute_fixed (&start)) > + return; > } > + else > + goto check_for_digits; > } > gfc_current_locus = start; > } > > - if (flag_openacc) > + if (flag_openacc || (flag_openmp || flag_openmp_simd)) > { > if (next_char () == '$') > { > c = next_char (); > if (c == 'a' || c == 'A') > { > - if (((c = next_char ()) == 'c' || c == 'C') > - && ((c = next_char ()) == 'c' || c == 'C')) > - { > - c = next_char (); > - if (c != '\n' > - && ((openacc_flag && continue_flag) > - || c == ' ' || c == '\t' || c == '0')) > - { > - do > - c = next_char (); > - while (gfc_is_whitespace (c)); > - if (c != '\n' && c != '!') > - { > - /* Canonicalize to *$acc. */ > - *start.nextc = '*'; > - openacc_flag = 1; > - gfc_current_locus = start; > - return; > - } > - } > - } > + if (skip_oacc_attribute_fixed (&start)) > + return; > } > - else > + else if (c == 'o' || c == 'O') > { > - int digit_seen = 0; > - > - for (col = 3; col < 6; col++, c = next_char ()) > - if (c == ' ') > - continue; > - else if (c == '\t') > - { > - col = 6; > - break; > - } > - else if (c < '0' || c > '9') > - break; > - else > - digit_seen = 1; > - > - if (col == 6 && c != '\n' > - && ((continue_flag && !digit_seen) > - || c == ' ' || c == '\t' || c == '0')) > - { > - gfc_current_locus = start; > - start.nextc[0] = ' '; > - start.nextc[1] = ' '; > - continue; > - } > + if (skip_omp_attribute_fixed (&start)) > + return; > } > + else > + goto check_for_digits; > } > gfc_current_locus = start; > } > > skip_comment_line (); > continue; > + > + gcc_unreachable (); > +check_for_digits: > + { > + int digit_seen = 0; > + > + for (col = 3; col < 6; col++, c = next_char ()) > + if (c == ' ') > + continue; > + else if (c == '\t') > + { > + col = 6; > + break; > + } > + else if (c < '0' || c > '9') > + break; > + else > + digit_seen = 1; > + > + if (col == 6 && c != '\n' > + && ((continue_flag && !digit_seen) > + || c == ' ' || c == '\t' || c == '0')) > + { > + gfc_current_locus = start; > + start.nextc[0] = ' '; > + start.nextc[1] = ' '; > + continue; > + } > + } > + skip_comment_line (); > + continue; > } > > if (gfc_option.flag_d_lines != -1 && (c == 'd' || c == 'D')) > @@ -1321,7 +1342,7 @@ restart: > continue_line = gfc_linebuf_linenum (gfc_current_locus.lb); > > if (flag_openmp) > - if (prev_openmp_flag != openmp_flag) > + if (prev_openmp_flag != openmp_flag && !openacc_flag) > { > gfc_current_locus = old_loc; > openmp_flag = prev_openmp_flag; > @@ -1330,7 +1351,7 @@ restart: > } > > if (flag_openacc) > - if (prev_openacc_flag != openacc_flag) > + if (prev_openacc_flag != openacc_flag && !openmp_flag) > { > gfc_current_locus = old_loc; > openacc_flag = prev_openacc_flag; > @@ -1349,7 +1370,7 @@ restart: > while (gfc_is_whitespace (c)) > c = next_char (); > > - if (openmp_flag) > + if (openmp_flag && !openacc_flag) > { > for (i = 0; i < 5; i++, c = next_char ()) > { > @@ -1360,7 +1381,7 @@ restart: > while (gfc_is_whitespace (c)) > c = next_char (); > } > - if (openacc_flag) > + if (openacc_flag && !openmp_flag) > { > for (i = 0; i < 5; i++, c = next_char ()) > { > @@ -1372,6 +1393,26 @@ restart: > c = next_char (); > } > > + /* In case we have an OpenMP directive continued by OpenACC > + sentinel, or vice versa, we get both openmp_flag and > + openacc_flag on. */ > + > + if (openacc_flag && openmp_flag) > + { > + int is_openmp = 0; > + for (i = 0; i < 5; i++, c = next_char ()) > + { > + if (gfc_wide_tolower (c) != (unsigned char) "!$acc"[i]) > + is_openmp = 1; > + if (i == 4) > + old_loc = gfc_current_locus; > + } > + gfc_error (is_openmp ? "Wrong OpenACC continuation at %C: " > + "expected !$ACC, got !$OMP" > + : "Wrong OpenMP continuation at %C: " > + "expected !$OMP, got !$ACC"); > + } > + > if (c != '&') > { > if (in_string) > @@ -1436,18 +1477,35 @@ restart: > skip_fixed_comments (); > > /* See if this line is a continuation line. */ > - if (flag_openmp && openmp_flag != prev_openmp_flag) > + if (flag_openmp && openmp_flag != prev_openmp_flag && !openacc_flag) > { > openmp_flag = prev_openmp_flag; > goto not_continuation; > } > - if (flag_openacc && openacc_flag != prev_openacc_flag) > + if (flag_openacc && openacc_flag != prev_openacc_flag && !openmp_flag) > { > openacc_flag = prev_openacc_flag; > goto not_continuation; > } > > - if (!openmp_flag && !openacc_flag) > + /* In case we have an OpenMP directive continued by OpenACC > + sentinel, or vice versa, we get both openmp_flag and > + openacc_flag on. */ > + if (openacc_flag && openmp_flag) > + { > + int is_openmp = 0; > + for (i = 0; i < 5; i++) > + { > + c = next_char (); > + if (gfc_wide_tolower (c) != (unsigned char) "*$acc"[i]) > + is_openmp = 1; > + } > + gfc_error (is_openmp ? "Wrong OpenACC continuation at %C: " > + "expected !$ACC, got !$OMP" > + : "Wrong OpenMP continuation at %C: " > + "expected !$OMP, got !$ACC"); > + } > + else if (!openmp_flag && !openacc_flag) > for (i = 0; i < 5; i++) > { > c = next_char (); > diff --git gcc/testsuite/gfortran.dg/goacc/omp-fixed.f gcc/testsuite/gfortran.dg/goacc/omp-fixed.f > new file mode 100644 > index 0000000..e715673 > --- /dev/null > +++ gcc/testsuite/gfortran.dg/goacc/omp-fixed.f > @@ -0,0 +1,32 @@ > +! { dg-do compile } > +! { dg-additional-options "-fopenmp" } > + SUBROUTINE ICHI > + INTEGER :: ARGC > + ARGC = COMMAND_ARGUMENT_COUNT () > + > +!$OMP PARALLEL > +!$ACC PARALLEL & > +!$ACC& COPYIN(ARGC) ! { dg-error "directive cannot be specified within" } > + IF (ARGC .NE. 0) THEN > + CALL ABORT > + END IF > +!$ACC END PARALLEL > +!$OMP END PARALLEL > + > + END SUBROUTINE ICHI > + > + > + SUBROUTINE NI > + IMPLICIT NONE > + INTEGER :: I > + > +!$ACC PARALLEL & > +!$OMP& DO ! { dg-error "Wrong OpenACC continuation" } > + DO I = 1, 10 > + ENDDO > + > +!$OMP PARALLEL & > +!$ACC& LOOP ! { dg-error "Wrong OpenMP continuation" } > + DO I = 1, 10 > + ENDDO > + END SUBROUTINE NI > diff --git gcc/testsuite/gfortran.dg/goacc/omp.f95 gcc/testsuite/gfortran.dg/goacc/omp.f95 > index 24f639f..339438a 100644 > --- gcc/testsuite/gfortran.dg/goacc/omp.f95 > +++ gcc/testsuite/gfortran.dg/goacc/omp.f95 > @@ -63,4 +63,12 @@ contains > !$omp end parallel > !$acc end data > end subroutine roku > -end module test > \ No newline at end of file > + > + subroutine nana > + !$acc parallel & > + !$omp do ! { dg-error "Wrong OpenACC continuation" } > + > + !$omp parallel & > + !$acc loop ! { dg-error "Wrong OpenMP continuation" } > + end subroutine nana > +end module test Grüße Thomas
On Fri, Oct 09, 2015 at 12:15:24PM +0200, Thomas Schwinge wrote: > diff --git gcc/fortran/scanner.c gcc/fortran/scanner.c > index bfb7d45..1e1ea84 100644 > --- gcc/fortran/scanner.c > +++ gcc/fortran/scanner.c > @@ -935,6 +935,63 @@ skip_free_comments (void) > return false; > } > > +/* Return true if MP was matched in fixed form. */ > +static bool > +skip_omp_attribute_fixed (locus *start) Technically, this isn't attribute, but sentinel. So, skip_fixed_omp_sentinel? I know the free functions are called attribute, perhaps we should rename them too, patch to do so preapproved. > +{ > + gfc_char_t c; > + if (((c = next_char ()) == 'm' || c == 'M') > + && ((c = next_char ()) == 'p' || c == 'P')) > + { > + c = next_char (); > + if (c != '\n' > + && (continue_flag The original code checked here (openmp_flag && continue_flag) instead. Is that change intentional? Looking around, we probably don't have a testcase coverage for say fixed form: C*OMP+PARALLEL DO do ... (i.e. where it starts with an OpenMP (or OpenACC) continuation, without non-continued line first), or for free form where: something & !$omp & parallel (ditto for OpenACC). > + while (gfc_is_whitespace (c)); > + if (c != '\n' && c != '!') > + { > + /* Canonicalize to *$omp. */ The comment has a pasto, by storing * you canonicalize to *$acc. > - if (flag_openacc) > + if (flag_openacc || (flag_openmp || flag_openmp_simd)) I'd just write if (flag_openacc || flag_openmp || flag_openmp_simd) the ()s around are just misleading. Anyway, if the removal of "openmp_flag &&" is intentional, then the patch is ok with the above mentioned changes. We can deal with the cases I've mentioned up above in a follow-up. Jakub
diff --git gcc/fortran/scanner.c gcc/fortran/scanner.c index bfb7d45..1e1ea84 100644 --- gcc/fortran/scanner.c +++ gcc/fortran/scanner.c @@ -935,6 +935,63 @@ skip_free_comments (void) return false; } +/* Return true if MP was matched in fixed form. */ +static bool +skip_omp_attribute_fixed (locus *start) +{ + gfc_char_t c; + if (((c = next_char ()) == 'm' || c == 'M') + && ((c = next_char ()) == 'p' || c == 'P')) + { + c = next_char (); + if (c != '\n' + && (continue_flag + || c == ' ' || c == '\t' || c == '0')) + { + do + c = next_char (); + while (gfc_is_whitespace (c)); + if (c != '\n' && c != '!') + { + /* Canonicalize to *$omp. */ + *start->nextc = '*'; + openmp_flag = 1; + gfc_current_locus = *start; + return true; + } + } + } + return false; +} + +/* Return true if CC was matched in fixed form. */ +static bool +skip_oacc_attribute_fixed (locus *start) +{ + gfc_char_t c; + if (((c = next_char ()) == 'c' || c == 'C') + && ((c = next_char ()) == 'c' || c == 'C')) + { + c = next_char (); + if (c != '\n' + && (continue_flag + || c == ' ' || c == '\t' || c == '0')) + { + do + c = next_char (); + while (gfc_is_whitespace (c)); + if (c != '\n' && c != '!') + { + /* Canonicalize to *$omp. */ + *start->nextc = '*'; + openacc_flag = 1; + gfc_current_locus = *start; + return true; + } + } + } + return false; +} /* Skip comment lines in fixed source mode. We have the same rules as in skip_free_comment(), except that we can have a 'c', 'C' or '*' @@ -1003,128 +1060,92 @@ skip_fixed_comments (void) && continue_line < gfc_linebuf_linenum (gfc_current_locus.lb)) continue_line = gfc_linebuf_linenum (gfc_current_locus.lb); - if (flag_openmp || flag_openmp_simd) + if ((flag_openmp || flag_openmp_simd) && !flag_openacc) { if (next_char () == '$') { c = next_char (); if (c == 'o' || c == 'O') { - if (((c = next_char ()) == 'm' || c == 'M') - && ((c = next_char ()) == 'p' || c == 'P')) - { - c = next_char (); - if (c != '\n' - && ((openmp_flag && continue_flag) - || c == ' ' || c == '\t' || c == '0')) - { - do - c = next_char (); - while (gfc_is_whitespace (c)); - if (c != '\n' && c != '!') - { - /* Canonicalize to *$omp. */ - *start.nextc = '*'; - openmp_flag = 1; - gfc_current_locus = start; - return; - } - } - } + if (skip_omp_attribute_fixed (&start)) + return; } else - { - int digit_seen = 0; - - for (col = 3; col < 6; col++, c = next_char ()) - if (c == ' ') - continue; - else if (c == '\t') - { - col = 6; - break; - } - else if (c < '0' || c > '9') - break; - else - digit_seen = 1; + goto check_for_digits; + } + gfc_current_locus = start; + } - if (col == 6 && c != '\n' - && ((continue_flag && !digit_seen) - || c == ' ' || c == '\t' || c == '0')) - { - gfc_current_locus = start; - start.nextc[0] = ' '; - start.nextc[1] = ' '; - continue; - } + if (flag_openacc && !(flag_openmp || flag_openmp_simd)) + { + if (next_char () == '$') + { + c = next_char (); + if (c == 'a' || c == 'A') + { + if (skip_oacc_attribute_fixed (&start)) + return; } + else + goto check_for_digits; } gfc_current_locus = start; } - if (flag_openacc) + if (flag_openacc || (flag_openmp || flag_openmp_simd)) { if (next_char () == '$') { c = next_char (); if (c == 'a' || c == 'A') { - if (((c = next_char ()) == 'c' || c == 'C') - && ((c = next_char ()) == 'c' || c == 'C')) - { - c = next_char (); - if (c != '\n' - && ((openacc_flag && continue_flag) - || c == ' ' || c == '\t' || c == '0')) - { - do - c = next_char (); - while (gfc_is_whitespace (c)); - if (c != '\n' && c != '!') - { - /* Canonicalize to *$acc. */ - *start.nextc = '*'; - openacc_flag = 1; - gfc_current_locus = start; - return; - } - } - } + if (skip_oacc_attribute_fixed (&start)) + return; } - else + else if (c == 'o' || c == 'O') { - int digit_seen = 0; - - for (col = 3; col < 6; col++, c = next_char ()) - if (c == ' ') - continue; - else if (c == '\t') - { - col = 6; - break; - } - else if (c < '0' || c > '9') - break; - else - digit_seen = 1; - - if (col == 6 && c != '\n' - && ((continue_flag && !digit_seen) - || c == ' ' || c == '\t' || c == '0')) - { - gfc_current_locus = start; - start.nextc[0] = ' '; - start.nextc[1] = ' '; - continue; - } + if (skip_omp_attribute_fixed (&start)) + return; } + else + goto check_for_digits; } gfc_current_locus = start; } skip_comment_line (); continue; + + gcc_unreachable (); +check_for_digits: + { + int digit_seen = 0; + + for (col = 3; col < 6; col++, c = next_char ()) + if (c == ' ') + continue; + else if (c == '\t') + { + col = 6; + break; + } + else if (c < '0' || c > '9') + break; + else + digit_seen = 1; + + if (col == 6 && c != '\n' + && ((continue_flag && !digit_seen) + || c == ' ' || c == '\t' || c == '0')) + { + gfc_current_locus = start; + start.nextc[0] = ' '; + start.nextc[1] = ' '; + continue; + } + } + skip_comment_line (); + continue; } if (gfc_option.flag_d_lines != -1 && (c == 'd' || c == 'D')) @@ -1321,7 +1342,7 @@ restart: continue_line = gfc_linebuf_linenum (gfc_current_locus.lb); if (flag_openmp) - if (prev_openmp_flag != openmp_flag) + if (prev_openmp_flag != openmp_flag && !openacc_flag) { gfc_current_locus = old_loc; openmp_flag = prev_openmp_flag; @@ -1330,7 +1351,7 @@ restart: } if (flag_openacc) - if (prev_openacc_flag != openacc_flag) + if (prev_openacc_flag != openacc_flag && !openmp_flag) { gfc_current_locus = old_loc; openacc_flag = prev_openacc_flag; @@ -1349,7 +1370,7 @@ restart: while (gfc_is_whitespace (c)) c = next_char (); - if (openmp_flag) + if (openmp_flag && !openacc_flag) { for (i = 0; i < 5; i++, c = next_char ()) { @@ -1360,7 +1381,7 @@ restart: while (gfc_is_whitespace (c)) c = next_char (); } - if (openacc_flag) + if (openacc_flag && !openmp_flag) { for (i = 0; i < 5; i++, c = next_char ()) { @@ -1372,6 +1393,26 @@ restart: c = next_char (); } + /* In case we have an OpenMP directive continued by OpenACC + sentinel, or vice versa, we get both openmp_flag and + openacc_flag on. */ + + if (openacc_flag && openmp_flag) + { + int is_openmp = 0; + for (i = 0; i < 5; i++, c = next_char ()) + { + if (gfc_wide_tolower (c) != (unsigned char) "!$acc"[i]) + is_openmp = 1; + if (i == 4) + old_loc = gfc_current_locus; + } + gfc_error (is_openmp ? "Wrong OpenACC continuation at %C: " + "expected !$ACC, got !$OMP" + : "Wrong OpenMP continuation at %C: " + "expected !$OMP, got !$ACC"); + } + if (c != '&') { if (in_string) @@ -1436,18 +1477,35 @@ restart: skip_fixed_comments (); /* See if this line is a continuation line. */ - if (flag_openmp && openmp_flag != prev_openmp_flag) + if (flag_openmp && openmp_flag != prev_openmp_flag && !openacc_flag) { openmp_flag = prev_openmp_flag; goto not_continuation; } - if (flag_openacc && openacc_flag != prev_openacc_flag) + if (flag_openacc && openacc_flag != prev_openacc_flag && !openmp_flag) { openacc_flag = prev_openacc_flag; goto not_continuation; } - if (!openmp_flag && !openacc_flag) + /* In case we have an OpenMP directive continued by OpenACC + sentinel, or vice versa, we get both openmp_flag and + openacc_flag on. */ + if (openacc_flag && openmp_flag) + { + int is_openmp = 0; + for (i = 0; i < 5; i++) + { + c = next_char (); + if (gfc_wide_tolower (c) != (unsigned char) "*$acc"[i]) + is_openmp = 1; + } + gfc_error (is_openmp ? "Wrong OpenACC continuation at %C: " + "expected !$ACC, got !$OMP" + : "Wrong OpenMP continuation at %C: " + "expected !$OMP, got !$ACC"); + } + else if (!openmp_flag && !openacc_flag) for (i = 0; i < 5; i++) { c = next_char (); diff --git gcc/testsuite/gfortran.dg/goacc/omp-fixed.f gcc/testsuite/gfortran.dg/goacc/omp-fixed.f new file mode 100644 index 0000000..e715673 --- /dev/null +++ gcc/testsuite/gfortran.dg/goacc/omp-fixed.f @@ -0,0 +1,32 @@ +! { dg-do compile } +! { dg-additional-options "-fopenmp" } + SUBROUTINE ICHI + INTEGER :: ARGC + ARGC = COMMAND_ARGUMENT_COUNT () + +!$OMP PARALLEL +!$ACC PARALLEL & +!$ACC& COPYIN(ARGC) ! { dg-error "directive cannot be specified within" } + IF (ARGC .NE. 0) THEN + CALL ABORT + END IF +!$ACC END PARALLEL +!$OMP END PARALLEL + + END SUBROUTINE ICHI + + + SUBROUTINE NI + IMPLICIT NONE + INTEGER :: I + +!$ACC PARALLEL & +!$OMP& DO ! { dg-error "Wrong OpenACC continuation" } + DO I = 1, 10 + ENDDO + +!$OMP PARALLEL & +!$ACC& LOOP ! { dg-error "Wrong OpenMP continuation" } + DO I = 1, 10 + ENDDO + END SUBROUTINE NI diff --git gcc/testsuite/gfortran.dg/goacc/omp.f95 gcc/testsuite/gfortran.dg/goacc/omp.f95 index 24f639f..339438a 100644 --- gcc/testsuite/gfortran.dg/goacc/omp.f95 +++ gcc/testsuite/gfortran.dg/goacc/omp.f95 @@ -63,4 +63,12 @@ contains !$omp end parallel !$acc end data end subroutine roku -end module test \ No newline at end of file + + subroutine nana + !$acc parallel & + !$omp do ! { dg-error "Wrong OpenACC continuation" } + + !$omp parallel & + !$acc loop ! { dg-error "Wrong OpenMP continuation" } + end subroutine nana +end module test