From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 90093 invoked by alias); 9 Oct 2015 10:15:45 -0000 Mailing-List: contact fortran-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Subscribe: List-Post: List-Help: , Sender: fortran-owner@gcc.gnu.org Received: (qmail 90072 invoked by uid 89); 9 Oct 2015 10:15:43 -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; Fri, 09 Oct 2015 10:15:40 +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 1ZkUi7-0001XR-Uq from Thomas_Schwinge@mentor.com ; Fri, 09 Oct 2015 03:15:36 -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; Fri, 9 Oct 2015 11:15:33 +0100 From: Thomas Schwinge To: , CC: , Ilmir Usmanov , , Subject: [PR fortran/63858] Fix mix of OpenACC and OpenMP sentinels in continuations In-Reply-To: <87r3ntr8li.fsf@kepler.schwinge.homeip.net> References: <3008431435623821@web14j.yandex.ru> <5591E54E.90509@ilmir.us> <5575ADD2.8030007@codesourcery.com> <87r3ntr8li.fsf@kepler.schwinge.homeip.net> User-Agent: Notmuch/0.9-125-g4686d11 (http://notmuchmail.org) Emacs/24.5.1 (i586-pc-linux-gnu) Date: Fri, 09 Oct 2015 10:15:00 -0000 Message-ID: <878u7cny9v.fsf@kepler.schwinge.homeip.net> MIME-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha1; protocol="application/pgp-signature" X-SW-Source: 2015-10/txt/msg00047.txt.bz2 --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Content-length: 12510 Hi! 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? Ping -- OK to commit the following (by Ilmir) to trunk: commit 38e62678ef11f349f029d42439668071f170e059 Author: Ilmir Usmanov Date: Sun Jul 26 12:10:36 2015 +0000 [PR fortran/63858] Fix mix of OpenACC and OpenMP sentinels in continuat= ions =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(-) 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 +/* 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 /* 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 - 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 - 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 - 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 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 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 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 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 - 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 + /* 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 /* 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_fla= g) { 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_f= lag) { openacc_flag =3D prev_openacc_flag; goto not_continuation; } =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/gfortr= an.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.d= g/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 iQEcBAEBAgAGBQJWF5O8AAoJEK3/DN1sMFFtr/UH/jkONHyOCYt9+h3HEsPHQFGX 873XG+hFNvdFZqeVDQyexOVLRXjbAEvHwkSCNKef6GHUyMZ1bAXV45Wy68apSrmz 4b5oFGKvuYO5D9lP27K2K+23kgE9plcjvJlAoQ/mx4fk2DOmdvVy6wwKWX+6lgiI gWtAsjA7uGoIdcSvlJGRc8HzlC5e+lSUwWH9Aik6TVOSnF4cJOWC4oDwdYFAjhcZ 5RUqE76df/caIccQdQQAs1dFArTV6TjxrCVn5ZXuVLx7hyw1BoabJKpFrvBtDTtF zSWPSd5pXk/5jSBczMCOL/MlaVCIJYQpvQGoE6GwPAm9XVcyxOtigf7yXzejWaw= =0WXb -----END PGP SIGNATURE----- --=-=-=--