From patchwork Fri Oct 9 10:15:24 2015 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Thomas Schwinge X-Patchwork-Id: 528157 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 04957140D57 for ; Fri, 9 Oct 2015 21:15:53 +1100 (AEDT) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b=e2oaOOyV; 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 :to:cc:subject:in-reply-to:references:date:message-id :mime-version:content-type; q=dns; s=default; b=C3iSwgZDp7zvIN7u XotI4J22zOQv2RZFHz5Jvl0YgzRCvJvgZJtVYwsq/EC1Q/RfsE9SyUMVkRqxlgzW XlTIsDD6oQuB5yJJ6V84IB2sKPMf99DVW8p3uqruIyWSnCQCUwc/+zS3e/6vCNuO SwBZKnQxHvtO+kyDNntZ5II5GpI= 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 :to:cc:subject:in-reply-to:references:date:message-id :mime-version:content-type; s=default; bh=jPoh8T+hyEDWXFgc8C3h8I FVhts=; b=e2oaOOyVJ0ZR9EdpGTeva36l3Ra+xLVADb2Wq/Hf33p2EguJjrTsRv bB3dBZUgpvw34jTigAYBrlXcKfEwz2xvwIFsBws+Co85YPvJJTNL+41+5FfaY76P GgW3nEhD5KXH8L4Da57tm/UyYdVQjegTiZcgfnPUKAJz49AtJL6pk= Received: (qmail 90092 invoked by alias); 9 Oct 2015 10:15:44 -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 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, 9 Oct 2015 12:15:24 +0200 Message-ID: <878u7cny9v.fsf@kepler.schwinge.homeip.net> MIME-Version: 1.0 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). > > 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 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(-) Grüße, Thomas 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