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 <m...@ilmir.us> wrote:
> > > 08.06.2015, 17:59, "Cesar Philippidis" <ce...@codesourcery.com>:
> > > > On 06/07/2015 02:05 PM, Ilmir Usmanov wrote:
> > > >> 08.06.2015, 00:01, "Ilmir Usmanov" <m...@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 <m...@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
signature.asc
Description: PGP signature
