From patchwork Wed Nov 25 14:33:47 2015 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Cesar Philippidis X-Patchwork-Id: 548597 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 7B9AF1402DD for ; Thu, 26 Nov 2015 01:34:04 +1100 (AEDT) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b=tHug1n1a; dkim-atps=neutral DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :subject:to:references:cc:message-id:date:mime-version :in-reply-to:content-type; q=dns; s=default; b=YV28O5aedgEGqzlgb addgfrJMkBCU7d3jma7Ui/Qk5Q7dt+Nb16Ud1Obp51SakQQvDVXW9z0g2a9soujI 86j+DQV3xcJH3g3E71xsb2az3LPqn4u+iCpNHqfHnawbLIq5XiEbQpSUaALSzcys bBfj80Rq9HXA9D77J0mjtKeHA0= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :subject:to:references:cc:message-id:date:mime-version :in-reply-to:content-type; s=default; bh=X8z96YJMK5hecslUIeGwtIy ZaQY=; b=tHug1n1atPqWU2LcbUmcHH4uwcSmS6KDbnNRXNnxrT2JQPQOWcnwz7Q 2SerXs+Wik2AiKDYB3A81/QVJnA/nkxIQj8NjPYN4qx0cS3xEbgqo67N2NzzpOmx n5JUasgkZWZWJUfAjxTdLc3nJIpL2/QofFzKz9bkVAz8dve4kx40= Received: (qmail 63139 invoked by alias); 25 Nov 2015 14:33:55 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 63111 invoked by uid 89); 25 Nov 2015 14:33:55 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-2.2 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; Wed, 25 Nov 2015 14:33:52 +0000 Received: from svr-orw-fem-06.mgc.mentorg.com ([147.34.97.120]) by relay1.mentorg.com with esmtp id 1a1b8m-0000lW-0R from Cesar_Philippidis@mentor.com ; Wed, 25 Nov 2015 06:33:48 -0800 Received: from [127.0.0.1] (147.34.91.1) by SVR-ORW-FEM-06.mgc.mentorg.com (147.34.97.120) with Microsoft SMTP Server id 14.3.224.2; Wed, 25 Nov 2015 06:33:47 -0800 From: Cesar Philippidis Subject: Re: [PR fortran/63858] Fix mix of OpenACC and OpenMP sentinels in continuations To: Jakub Jelinek , Thomas Schwinge 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> <20151020093733.GV478@tucnak.redhat.com> CC: , , , Ilmir Usmanov Message-ID: <5655C6CB.5020901@codesourcery.com> Date: Wed, 25 Nov 2015 06:33:47 -0800 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:38.0) Gecko/20100101 Thunderbird/38.3.0 MIME-Version: 1.0 In-Reply-To: <20151020093733.GV478@tucnak.redhat.com> On 10/20/2015 02:37 AM, Jakub Jelinek wrote: > 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. I've renamed those functions in this patch. The free variants are named skip_free_*_sentinel. >> +{ >> + 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? I think so. Without it, continuations won't work with -fopenmp-simd. Note how that function call is guarded by if ((flag_openmp || flag_openmp_simd) && !flag_openacc) > Looking around, we probably don't have a testcase coverage for say > fixed form: > > C*OMP+PARALLEL DO > do ... That's going to be tricky. In fixed mode, the only way that we can tell if there is an omp/acc continuation is by inspecting the character at position 6. So, there could be a comment like C*ACCELERATOR which would get picked up as an acc continuation. > (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). What type of error should this be reporting? Right now it does report an error because this gets expanded to something parallel That's clearly not correct. But at the same time, it would still be an error if the user placed !$omp/acc between a continuation. >> + while (gfc_is_whitespace (c)); >> + if (c != '\n' && c != '!') >> + { >> + /* Canonicalize to *$omp. */ > > The comment has a pasto, by storing * you canonicalize to *$acc. Fixed. >> - 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. I'll apply this patch shortly. Cesar 2015-11-24 Ilmir Usmanov Cesar Philippidis gcc/fortran/ PR fortran/63858 * scanner.c (skip_oacc_attribute): Remove continue_flag parameter. Rename as ... (skip_free_oacc_sentinel): ... this. (skip_omp_attribute): Remove continue_flag parameter. Rename as ... (skip_free_omp_sentinel): ... this. (skip_free_comments): Update to call skip_free_oacc_sentinel and skip_free_omp_sentinel. (skip_fixed_omp_sentinel): New function. (skip_fixed_oacc_sentinel): New function. (skip_fixed_comments): Fix mix of OpenACC and OpenMP sentinels in continuation. gcc/testsuite/ * goacc/omp-fixed.f: New test. * goacc/omp.f95: Add check for mis-matched omp and acc continuations. diff --git a/gcc/fortran/scanner.c b/gcc/fortran/scanner.c index bfb7d45..8644119 100644 --- a/gcc/fortran/scanner.c +++ b/gcc/fortran/scanner.c @@ -712,7 +712,7 @@ skip_gcc_attribute (locus start) /* Return true if CC was matched. */ static bool -skip_oacc_attribute (locus start, locus old_loc, bool continue_flag) +skip_free_oacc_sentinel (locus start, locus old_loc) { bool r = false; char c; @@ -752,7 +752,7 @@ skip_oacc_attribute (locus start, locus old_loc, bool continue_flag) /* Return true if MP was matched. */ static bool -skip_omp_attribute (locus start, locus old_loc, bool continue_flag) +skip_free_omp_sentinel (locus start, locus old_loc) { bool r = false; char c; @@ -841,7 +841,7 @@ skip_free_comments (void) c = next_char (); if (c == 'o' || c == 'O') { - if (skip_omp_attribute (start, old_loc, continue_flag)) + if (skip_free_omp_sentinel (start, old_loc)) return false; gfc_current_locus = old_loc; next_char (); @@ -849,7 +849,7 @@ skip_free_comments (void) } else if (c == 'a' || c == 'A') { - if (skip_oacc_attribute (start, old_loc, continue_flag)) + if (skip_free_oacc_sentinel (start, old_loc)) return false; gfc_current_locus = old_loc; next_char (); @@ -874,7 +874,7 @@ skip_free_comments (void) c = next_char (); if (c == 'o' || c == 'O') { - if (skip_omp_attribute (start, old_loc, continue_flag)) + if (skip_free_omp_sentinel (start, old_loc)) return false; gfc_current_locus = old_loc; next_char (); @@ -899,8 +899,7 @@ skip_free_comments (void) c = next_char (); if (c == 'a' || c == 'A') { - if (skip_oacc_attribute (start, old_loc, - continue_flag)) + if (skip_free_oacc_sentinel (start, old_loc)) return false; gfc_current_locus = old_loc; next_char(); @@ -935,6 +934,63 @@ skip_free_comments (void) return false; } +/* Return true if MP was matched in fixed form. */ +static bool +skip_fixed_omp_sentinel (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_fixed_oacc_sentinel (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 *$acc. */ + *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 +1059,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_fixed_omp_sentinel (&start)) + return; } else + goto check_for_digits; + } + gfc_current_locus = start; + } + + if (flag_openacc && !(flag_openmp || flag_openmp_simd)) + { + if (next_char () == '$') + { + c = next_char (); + if (c == 'a' || c == 'A') { - 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_fixed_oacc_sentinel (&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_fixed_oacc_sentinel (&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_fixed_omp_sentinel (&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 +1341,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 +1350,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 +1369,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 +1380,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 +1392,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 +1476,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 a/gcc/testsuite/gfortran.dg/goacc/omp-fixed.f b/gcc/testsuite/gfortran.dg/goacc/omp-fixed.f new file mode 100644 index 0000000..e715673 --- /dev/null +++ b/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 a/gcc/testsuite/gfortran.dg/goacc/omp.f95 b/gcc/testsuite/gfortran.dg/goacc/omp.f95 index 24f639f..339438a 100644 --- a/gcc/testsuite/gfortran.dg/goacc/omp.f95 +++ b/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