From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 30217 invoked by alias); 19 Oct 2015 17:09:11 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Received: (qmail 30162 invoked by uid 89); 19 Oct 2015 17:09:11 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-2.3 required=5.0 tests=AWL,BAYES_00,RCVD_IN_DNSWL_LOW,SPF_PASS autolearn=ham version=3.3.2 X-Spam-User: qpsmtpd, 2 recipients X-HELO: relay1.mentorg.com Received: from relay1.mentorg.com (HELO relay1.mentorg.com) (192.94.38.131) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Mon, 19 Oct 2015 17:09:09 +0000 Received: from nat-ies.mentorg.com ([192.94.31.2] helo=SVR-IES-FEM-01.mgc.mentorg.com) by relay1.mentorg.com with esmtp id 1ZoDvf-0007G7-IK from Thomas_Schwinge@mentor.com ; Mon, 19 Oct 2015 10:09:00 -0700 Received: from feldtkeller.schwinge.homeip.net (137.202.0.76) by SVR-IES-FEM-01.mgc.mentorg.com (137.202.0.104) with Microsoft SMTP Server id 14.3.224.2; Mon, 19 Oct 2015 18:08:58 +0100 From: Thomas Schwinge To: , , CC: , Ilmir Usmanov , Subject: Re: [PR fortran/63858] Fix mix of OpenACC and OpenMP sentinels in continuations In-Reply-To: <878u7cny9v.fsf@kepler.schwinge.homeip.net> References: <3008431435623821@web14j.yandex.ru> <5591E54E.90509@ilmir.us> <5575ADD2.8030007@codesourcery.com> <87r3ntr8li.fsf@kepler.schwinge.homeip.net> <878u7cny9v.fsf@kepler.schwinge.homeip.net> User-Agent: Notmuch/0.9-101-g81dad07 (http://notmuchmail.org) Emacs/24.4.1 (x86_64-pc-linux-gnu) Date: Mon, 19 Oct 2015 17:12:00 -0000 Message-ID: <87k2qi9465.fsf@schwinge.name> MIME-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha1; protocol="application/pgp-signature" X-SW-Source: 2015-10/txt/msg01775.txt.bz2 --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Content-length: 13504 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 wrote: > > > 08.06.2015, 17:59, "Cesar Philippidis" : > > > > On 06/07/2015 02:05 PM, Ilmir Usmanov wrote: > > > >> 08.06.2015, 00:01, "Ilmir Usmanov" : > > > >>>> 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). > >=20 > > Thanks for working on this! > >=20 > > > >>>> OK for gomp branch? > >=20 > > The same applies to GCC trunk, as far as I can tell -- any reason not to > > apply the patch to trunk? >=20 > Ping -- OK to commit the following (by Ilmir) to trunk: >=20 > commit 38e62678ef11f349f029d42439668071f170e059 > Author: Ilmir Usmanov > Date: Sun Jul 26 12:10:36 2015 +0000 >=20 > [PR fortran/63858] Fix mix of OpenACC and OpenMP sentinels in continu= ations >=20=20=20=20=20 > 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(-) >=20 > 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; > } >=20=20 > +/* Return true if MP was matched in fixed form. */ > +static bool > +skip_omp_attribute_fixed (locus *start) > +{ > + gfc_char_t c; > + if (((c =3D next_char ()) =3D=3D 'm' || c =3D=3D 'M') > + && ((c =3D next_char ()) =3D=3D 'p' || c =3D=3D 'P')) > + { > + c =3D next_char (); > + if (c !=3D '\n' > + && (continue_flag > + || c =3D=3D ' ' || c =3D=3D '\t' || c =3D=3D '0')) > + { > + do > + c =3D next_char (); > + while (gfc_is_whitespace (c)); > + if (c !=3D '\n' && c !=3D '!') > + { > + /* Canonicalize to *$omp. */ > + *start->nextc =3D '*'; > + openmp_flag =3D 1; > + gfc_current_locus =3D *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 =3D next_char ()) =3D=3D 'c' || c =3D=3D 'C') > + && ((c =3D next_char ()) =3D=3D 'c' || c =3D=3D 'C')) > + { > + c =3D next_char (); > + if (c !=3D '\n' > + && (continue_flag > + || c =3D=3D ' ' || c =3D=3D '\t' || c =3D=3D '0')) > + { > + do > + c =3D next_char (); > + while (gfc_is_whitespace (c)); > + if (c !=3D '\n' && c !=3D '!') > + { > + /* Canonicalize to *$omp. */ > + *start->nextc =3D '*'; > + openacc_flag =3D 1; > + gfc_current_locus =3D *start; > + return true; > + } > + } > + } > + return false; > +} >=20=20 > /* 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 =3D gfc_linebuf_linenum (gfc_current_locus.lb); >=20=20 > - if (flag_openmp || flag_openmp_simd) > + if ((flag_openmp || flag_openmp_simd) && !flag_openacc) > { > if (next_char () =3D=3D '$') > { > c =3D next_char (); > if (c =3D=3D 'o' || c =3D=3D 'O') > { > - if (((c =3D next_char ()) =3D=3D 'm' || c =3D=3D 'M') > - && ((c =3D next_char ()) =3D=3D 'p' || c =3D=3D 'P')) > - { > - c =3D next_char (); > - if (c !=3D '\n' > - && ((openmp_flag && continue_flag) > - || c =3D=3D ' ' || c =3D=3D '\t' || c =3D=3D '0')) > - { > - do > - c =3D next_char (); > - while (gfc_is_whitespace (c)); > - if (c !=3D '\n' && c !=3D '!') > - { > - /* Canonicalize to *$omp. */ > - *start.nextc =3D '*'; > - openmp_flag =3D 1; > - gfc_current_locus =3D start; > - return; > - } > - } > - } > + if (skip_omp_attribute_fixed (&start)) > + return; > } > else > - { > - int digit_seen =3D 0; > - > - for (col =3D 3; col < 6; col++, c =3D next_char ()) > - if (c =3D=3D ' ') > - continue; > - else if (c =3D=3D '\t') > - { > - col =3D 6; > - break; > - } > - else if (c < '0' || c > '9') > - break; > - else > - digit_seen =3D 1; > + goto check_for_digits; > + } > + gfc_current_locus =3D start; > + } >=20=20 > - if (col =3D=3D 6 && c !=3D '\n' > - && ((continue_flag && !digit_seen) > - || c =3D=3D ' ' || c =3D=3D '\t' || c =3D=3D '0')) > - { > - gfc_current_locus =3D start; > - start.nextc[0] =3D ' '; > - start.nextc[1] =3D ' '; > - continue; > - } > + if (flag_openacc && !(flag_openmp || flag_openmp_simd)) > + { > + if (next_char () =3D=3D '$') > + { > + c =3D next_char (); > + if (c =3D=3D 'a' || c =3D=3D 'A') > + { > + if (skip_oacc_attribute_fixed (&start)) > + return; > } > + else > + goto check_for_digits; > } > gfc_current_locus =3D start; > } >=20=20 > - if (flag_openacc) > + if (flag_openacc || (flag_openmp || flag_openmp_simd)) > { > if (next_char () =3D=3D '$') > { > c =3D next_char (); > if (c =3D=3D 'a' || c =3D=3D 'A') > { > - if (((c =3D next_char ()) =3D=3D 'c' || c =3D=3D 'C') > - && ((c =3D next_char ()) =3D=3D 'c' || c =3D=3D 'C')) > - { > - c =3D next_char (); > - if (c !=3D '\n' > - && ((openacc_flag && continue_flag) > - || c =3D=3D ' ' || c =3D=3D '\t' || c =3D=3D '0')) > - { > - do > - c =3D next_char (); > - while (gfc_is_whitespace (c)); > - if (c !=3D '\n' && c !=3D '!') > - { > - /* Canonicalize to *$acc. */ > - *start.nextc =3D '*'; > - openacc_flag =3D 1; > - gfc_current_locus =3D start; > - return; > - } > - } > - } > + if (skip_oacc_attribute_fixed (&start)) > + return; > } > - else > + else if (c =3D=3D 'o' || c =3D=3D 'O') > { > - int digit_seen =3D 0; > - > - for (col =3D 3; col < 6; col++, c =3D next_char ()) > - if (c =3D=3D ' ') > - continue; > - else if (c =3D=3D '\t') > - { > - col =3D 6; > - break; > - } > - else if (c < '0' || c > '9') > - break; > - else > - digit_seen =3D 1; > - > - if (col =3D=3D 6 && c !=3D '\n' > - && ((continue_flag && !digit_seen) > - || c =3D=3D ' ' || c =3D=3D '\t' || c =3D=3D '0')) > - { > - gfc_current_locus =3D start; > - start.nextc[0] =3D ' '; > - start.nextc[1] =3D ' '; > - continue; > - } > + if (skip_omp_attribute_fixed (&start)) > + return; > } > + else > + goto check_for_digits; > } > gfc_current_locus =3D start; > } >=20=20 > skip_comment_line (); > continue; > + > + gcc_unreachable (); > +check_for_digits: > + { > + int digit_seen =3D 0; > + > + for (col =3D 3; col < 6; col++, c =3D next_char ()) > + if (c =3D=3D ' ') > + continue; > + else if (c =3D=3D '\t') > + { > + col =3D 6; > + break; > + } > + else if (c < '0' || c > '9') > + break; > + else > + digit_seen =3D 1; > + > + if (col =3D=3D 6 && c !=3D '\n' > + && ((continue_flag && !digit_seen) > + || c =3D=3D ' ' || c =3D=3D '\t' || c =3D=3D '0')) > + { > + gfc_current_locus =3D start; > + start.nextc[0] =3D ' '; > + start.nextc[1] =3D ' '; > + continue; > + } > + } > + skip_comment_line (); > + continue; > } >=20=20 > if (gfc_option.flag_d_lines !=3D -1 && (c =3D=3D 'd' || c =3D=3D '= D')) > @@ -1321,7 +1342,7 @@ restart: > continue_line =3D gfc_linebuf_linenum (gfc_current_locus.lb); >=20=20 > if (flag_openmp) > - if (prev_openmp_flag !=3D openmp_flag) > + if (prev_openmp_flag !=3D openmp_flag && !openacc_flag) > { > gfc_current_locus =3D old_loc; > openmp_flag =3D prev_openmp_flag; > @@ -1330,7 +1351,7 @@ restart: > } >=20=20 > if (flag_openacc) > - if (prev_openacc_flag !=3D openacc_flag) > + if (prev_openacc_flag !=3D openacc_flag && !openmp_flag) > { > gfc_current_locus =3D old_loc; > openacc_flag =3D prev_openacc_flag; > @@ -1349,7 +1370,7 @@ restart: > while (gfc_is_whitespace (c)) > c =3D next_char (); >=20=20 > - if (openmp_flag) > + if (openmp_flag && !openacc_flag) > { > for (i =3D 0; i < 5; i++, c =3D next_char ()) > { > @@ -1360,7 +1381,7 @@ restart: > while (gfc_is_whitespace (c)) > c =3D next_char (); > } > - if (openacc_flag) > + if (openacc_flag && !openmp_flag) > { > for (i =3D 0; i < 5; i++, c =3D next_char ()) > { > @@ -1372,6 +1393,26 @@ restart: > c =3D next_char (); > } >=20=20 > + /* 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 =3D 0; > + for (i =3D 0; i < 5; i++, c =3D next_char ()) > + { > + if (gfc_wide_tolower (c) !=3D (unsigned char) "!$acc"[i]) > + is_openmp =3D 1; > + if (i =3D=3D 4) > + old_loc =3D 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 !=3D '&') > { > if (in_string) > @@ -1436,18 +1477,35 @@ restart: > skip_fixed_comments (); >=20=20 > /* See if this line is a continuation line. */ > - if (flag_openmp && openmp_flag !=3D prev_openmp_flag) > + if (flag_openmp && openmp_flag !=3D prev_openmp_flag && !openacc_f= lag) > { > openmp_flag =3D prev_openmp_flag; > goto not_continuation; > } > - if (flag_openacc && openacc_flag !=3D prev_openacc_flag) > + if (flag_openacc && openacc_flag !=3D prev_openacc_flag && !openmp= _flag) > { > openacc_flag =3D prev_openacc_flag; > goto not_continuation; > } >=20=20 > - 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 =3D 0; > + for (i =3D 0; i < 5; i++) > + { > + c =3D next_char (); > + if (gfc_wide_tolower (c) !=3D (unsigned char) "*$acc"[i]) > + is_openmp =3D 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 =3D 0; i < 5; i++) > { > c =3D next_char (); > diff --git gcc/testsuite/gfortran.dg/goacc/omp-fixed.f gcc/testsuite/gfor= tran.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 =3D 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 =3D 1, 10 > + ENDDO > + > +!$OMP PARALLEL & > +!$ACC& LOOP ! { dg-error "Wrong OpenMP continuation" } > + DO I =3D 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=C3=BC=C3=9Fe Thomas --=-=-= Content-Type: application/pgp-signature; name="signature.asc" Content-length: 472 -----BEGIN PGP SIGNATURE----- Version: GnuPG v1 iQEcBAEBAgAGBQJWJSOiAAoJEPoxNhtoi6COm8sH/2l8G1zTyt3jPfuRILK8+jZn 70DAv63E+FQcHK72ay9L112fH9lC2juPR8NnaKB48DmmSHu78B5VNt19R9vexR1f scB+VOn9L475f5oIvE3lisCr/MUewGsh4DWYmlIkhUKa0o/ZQnAKG4O+MeEHx9vS qkhKSyVrNR6gJY3HQ8nj8DqvV9wOh6TBQ6egUPhlPm0ya7XI67Plmrqig/B3kEgg zAfwVDwoWqcvVIQ/kIubx3FtTn8K1rIH+dHjxyWK/KOqanHYUaoPjhQgiZ5K9Kj5 d1Nga+6Dml17XRBeJ4lKmlwhBqD258OPOiGE8K92z3d5+45BSu4C9+mNqaUhCd0= =8nxK -----END PGP SIGNATURE----- --=-=-=--