From patchwork Sun Oct 2 17:47:18 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 1634 Return-Path: Delivered-To: ouuuleilei@gmail.com Received: by 2002:a5d:4ac7:0:0:0:0:0 with SMTP id y7csp654731wrs; Sun, 2 Oct 2022 10:48:24 -0700 (PDT) X-Google-Smtp-Source: AMsMyM4jF3DnTAKBZ23hgG2wRhzOCTNExQD3LrKj87zP0gWDNQCXwaD1888lcYLTRvIVSsQhD4Tu X-Received: by 2002:a17:907:708:b0:77e:ff47:34b1 with SMTP id xb8-20020a170907070800b0077eff4734b1mr12093830ejb.493.1664732904080; Sun, 02 Oct 2022 10:48:24 -0700 (PDT) ARC-Seal: i=1; a=rsa-sha256; t=1664732904; cv=none; d=google.com; s=arc-20160816; b=lNAPnY+Fhiz8MRW41kG2AST4LuaGI4OM0LZAvau5cLHo63mCpsEKAWydWBFt2I53HI ZaZ39IpVq1RSEvtRPQzu247HUker/S0FklKKBhZ6iGKazcxsChQOtPtbBGRYq/0LhCgB KU4HrNmcg6AXVC5RFb1rGtKrQsSbiEg3YhAOfNm64SNcuM4n550oCryV+3vOZEPjIS6e vdjsFI0JnkNk5DunATWxrPk/viyLkvORPv56EjLOWkaN/KBz0hExVsrDe4PtNOwCnjlq jMLdmQG0+tD1PREa0n0Y4LDYMZsEQNK0ilemjm6QqOQ3x4fa0GcaMRzpk57Gk5IEN5Bg vdJQ== ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=google.com; s=arc-20160816; h=sender:errors-to:list-subscribe:list-help:list-post:list-archive :list-unsubscribe:list-id:precedence:subject:from:to :content-language:user-agent:mime-version:date:message-id :ironport-sdr:dmarc-filter:delivered-to; bh=OvJKfqHkUCl3jdwzfzzO7ZSD98MRdgZ4cQxXQ80xWxQ=; b=SA93yNw8RlXyh3Sx8aRhQUDBM1K7Z0kkobA8PENLkvJMPkBLZuytpH6sNzT3HWnlpq KlIG4O/eeqeKCFX/tu0sYInr6ZptqjMP59637zK39PEBn6K1dDVm3mjo6AZc6jhZfzvu 3YwS/u9x/sfrJm6khMPsYbeYpSG3jR8v64k23r+KBorH1YYKehTHgVTdVek0jjiVRW6u SZlIAD40XTLgKvsYD47c8+lAsl+FLOtfNZ9ZIHPzVjzL8ffzpt/H96lNWJ09wSlUwpJJ F0TEuOE85jJ9WMZrq2AarSk4pGuZ5pZ/jctG9v9kkVQvO6M2zce1HV69VXH2T5JVoq3y eJlA== ARC-Authentication-Results: i=1; mx.google.com; spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 2620:52:3:1:0:246e:9693:128c as permitted sender) smtp.mailfrom="gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org" Received: from sourceware.org (server2.sourceware.org. [2620:52:3:1:0:246e:9693:128c]) by mx.google.com with ESMTPS id k25-20020a056402049900b0045903f0af9dsi503156edv.111.2022.10.02.10.48.23 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Sun, 02 Oct 2022 10:48:24 -0700 (PDT) Received-SPF: pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 2620:52:3:1:0:246e:9693:128c as permitted sender) client-ip=2620:52:3:1:0:246e:9693:128c; Authentication-Results: mx.google.com; spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 2620:52:3:1:0:246e:9693:128c as permitted sender) smtp.mailfrom="gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org" Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 014A0385E020 for ; Sun, 2 Oct 2022 17:47:59 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from esa3.mentor.iphmx.com (esa3.mentor.iphmx.com [68.232.137.180]) by sourceware.org (Postfix) with ESMTPS id 906FC3858D32; Sun, 2 Oct 2022 17:47:27 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 906FC3858D32 Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=mentor.com X-IronPort-AV: E=Sophos;i="5.93,363,1654588800"; d="diff'?scan'208,217";a="83874911" Received: from orw-gwy-02-in.mentorg.com ([192.94.38.167]) by esa3.mentor.iphmx.com with ESMTP; 02 Oct 2022 09:47:26 -0800 IronPort-SDR: YZ6q1PAOZpG8EFwbtaJiytYw0phOJdSB8cxtReT1nXL1JwdHU8Kl/UPPzMj+c7HqsP6t6tmRqI CATELFA/+InyYlDlidufKZk5mZcpcAEO3PhAhOdf5XMrD87awIWv0GbWWG8shJgC9LLHZ+VWuU 54V2IN+HFVKCByQxR7m+3A3gAb937ZxxNoPPDJ3rwTmttVl786jJOfY6z/Tbb6V/jAA5U0opGz D2NoGfhEODtfZ+er3bW9obKXyrawpW2EoXROZQBrA56m3QuKwnGB7dkS3Rvf9GmeQ/iVDRb0Az ipA= Message-ID: Date: Sun, 2 Oct 2022 19:47:18 +0200 MIME-Version: 1.0 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:102.0) Gecko/20100101 Thunderbird/102.3.1 Content-Language: en-US To: gcc-patches , fortran , Jakub Jelinek From: Tobias Burnus Subject: [Patch] Fortran: Add OpenMP's assume(s) directives X-Originating-IP: [137.202.0.90] X-ClientProxiedBy: svr-ies-mbx-12.mgc.mentorg.com (139.181.222.12) To svr-ies-mbx-12.mgc.mentorg.com (139.181.222.12) X-Spam-Status: No, score=-11.4 required=5.0 tests=BAYES_00, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, HTML_MESSAGE, KAM_DMARC_STATUS, KAM_SHORT, SPF_HELO_PASS, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-Content-Filtered-By: Mailman/MimeDel 2.1.29 X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org Sender: "Gcc-patches" X-getmail-retrieved-from-mailbox: =?utf-8?q?INBOX?= X-GMAIL-THRID: =?utf-8?q?1745598969779345406?= X-GMAIL-MSGID: =?utf-8?q?1745598969779345406?= This patch adds '!$omp assume' and '!$omp assumes' support. None of the directives is used after resolution. When we actually start using for 'assumes', it has to be stored in .mod files. The other question is how to handle 'holds()' expressions with 'assumes'. -fopenmp-simd: I used a longer wording to imply that not only the 'simd' but all SIMD directives are enabled. OK for mainline? Tobias PS: For 'assume' with holds clause, the same applies as for Jakub's commit/patch: "openmp: Add OpenMP assume, assumes and begin/end assumes support" https://gcc.gnu.org/r13-3020-gd01bd0b0f3b8f4c33c437ff10f0b949200627f56 Namely, it requires that the following - now half-approved - patch is committed: "[PATCH] c++, c: Implement C++23 P1774R8 - Portable assumptions [PR106654]" https://gcc.gnu.org/pipermail/gcc-patches/2022-September/601991.html PPS: I intent to take care in a separate patch the new rules for where OpenMP specification part directives be placed (i.e. after USE/INTENT/IMPORT) for all delarative + informational routines, the latter includes the 'assumes' directive. ----------------- Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955 Fortran: Add OpenMP's assume(s) directives gcc/ChangeLog: * doc/invoke.texi (-fopenmp-simd): Document that also 'assume' is enabled. libgomp/ChangeLog: * libgomp.texi (OpenMP 5.1 Impl. Status): Mark 'assume' as 'Y'. gcc/fortran/ChangeLog: * dump-parse-tree.cc (show_omp_assumes): New. (show_omp_clauses, show_namespace): Call it. (show_omp_node, show_code_node): Handle OpenMP ASSUME. * gfortran.h (enum gfc_statement): Add ST_OMP_ASSUME, ST_OMP_END_ASSUME and ST_OMP_ASSUMES. (gfc_exec_op): Add EXEC_OMP_ASSUME. (gfc_omp_assumptions): New struct. (gfc_get_omp_assumptions): New XCNEW #define. (gfc_omp_clauses, gfc_namespace): Add assume member. (gfc_resolve_omp_assumptions): New prototype. * match.h (gfc_match_omp_assume, gfc_match_omp_assumes): New. * openmp.cc (omp_code_to_statement): Declare. (gfc_free_omp_clauses): Free assume member and its struct data. (enum omp_mask2): Add OMP_CLAUSE_ASSUMPTIONS. (gfc_omp_absent_contains_clause): New. (gfc_match_omp_clauses): Call it; optionally use passed omp_clauses argument. (gfc_match_omp_assume, gfc_match_omp_assumes): New. (gfc_resolve_omp_assumptions): New. (resolve_omp_clauses): Call it. (gfc_resolve_omp_directive, omp_code_to_statement): Handle EXEC_OMP_ASSUME. * parse.cc (decode_omp_directive): Parse OpenMP ASSUME(S). (next_statement, parse_executable, parse_omp_structured_block): Handle ST_OMP_ASSUME. (case_omp_decl): Add ST_OMP_ASSUMES. (gfc_ascii_statement): Handle Assumes, optional return string without '!$OMP '/'!$ACC ' prefix. (is_omp_declarative_stmt, is_omp_informational_stmt): New. * parse.h (gfc_ascii_statement): Add optional bool arg to prototype. (is_omp_declarative_stmt, is_omp_informational_stmt): New prototype. * resolve.cc (gfc_resolve_blocks, gfc_resolve_code): Add EXEC_OMP_ASSUME. (gfc_resolve): Resolve ASSUMES directive. * symbol.cc (gfc_free_namespace): Free omp_assumes member. * st.cc (gfc_free_statement): Handle EXEC_OMP_ASSUME. * trans-openmp.cc (gfc_trans_omp_directive): Likewise. * trans.cc (trans_code): Likewise. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/assume-1.f90: New test. * gfortran.dg/gomp/assume-2.f90: New test. * gfortran.dg/gomp/assumes-1.f90: New test. * gfortran.dg/gomp/assumes-2.f90: New test. gcc/doc/invoke.texi | 6 +- gcc/fortran/dump-parse-tree.cc | 42 ++++ gcc/fortran/gfortran.h | 22 +- gcc/fortran/match.h | 2 + gcc/fortran/openmp.cc | 331 ++++++++++++++++++++++++++- gcc/fortran/parse.cc | 53 ++++- gcc/fortran/parse.h | 4 +- gcc/fortran/resolve.cc | 6 + gcc/fortran/st.cc | 1 + gcc/fortran/symbol.cc | 8 +- gcc/fortran/trans-openmp.cc | 2 + gcc/fortran/trans.cc | 1 + gcc/testsuite/gfortran.dg/gomp/assume-1.f90 | 24 ++ gcc/testsuite/gfortran.dg/gomp/assume-2.f90 | 27 +++ gcc/testsuite/gfortran.dg/gomp/assumes-1.f90 | 84 +++++++ gcc/testsuite/gfortran.dg/gomp/assumes-2.f90 | 7 + libgomp/libgomp.texi | 2 +- 17 files changed, 608 insertions(+), 14 deletions(-) diff --git a/gcc/doc/invoke.texi b/gcc/doc/invoke.texi index a5dc6377835..e3701555f12 100644 --- a/gcc/doc/invoke.texi +++ b/gcc/doc/invoke.texi @@ -2749,9 +2749,9 @@ have support for @option{-pthread}. @option{-fopenmp} implies @opindex fopenmp-simd @cindex OpenMP SIMD @cindex SIMD -Enable handling of OpenMP's SIMD directives with @code{#pragma omp} -in C/C++ and @code{!$omp} in Fortran. Other OpenMP directives -are ignored. +Enable handling of OpenMP's SIMD directives and OPENMP's @code{assume} directive +with @code{#pragma omp} in C/C++ and @code{!$omp} in Fortran. Other OpenMP +directives are ignored. @item -fpermitted-flt-eval-methods=@var{style} @opindex fpermitted-flt-eval-methods diff --git a/gcc/fortran/dump-parse-tree.cc b/gcc/fortran/dump-parse-tree.cc index 40c690c9ae8..bd1fb4bdfd4 100644 --- a/gcc/fortran/dump-parse-tree.cc +++ b/gcc/fortran/dump-parse-tree.cc @@ -36,6 +36,7 @@ along with GCC; see the file COPYING3. If not see #include "gfortran.h" #include "constructor.h" #include "version.h" +#include "parse.h" /* For gfc_ascii_statement. */ /* Keep track of indentation for symbol tree dumps. */ static int show_level = 0; @@ -1458,6 +1459,34 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n) gfc_current_ns = ns_curr; } +static void +show_omp_assumes (gfc_omp_assumptions *assume) +{ + for (int i = 0; i < assume->n_absent; i++) + { + fputs (" ABSENT (", dumpfile); + fputs (gfc_ascii_statement (assume->absent[i], true), dumpfile); + fputc (')', dumpfile); + } + for (int i = 0; i < assume->n_contains; i++) + { + fputs (" CONTAINS (", dumpfile); + fputs (gfc_ascii_statement (assume->contains[i], true), dumpfile); + fputc (')', dumpfile); + } + for (gfc_expr_list *el = assume->holds; el; el = el->next) + { + fputs (" HOLDS (", dumpfile); + show_expr (el->expr); + fputc (')', dumpfile); + } + if (assume->no_openmp) + fputs (" NO_OPENMP", dumpfile); + if (assume->no_openmp_routines) + fputs (" NO_OPENMP_ROUTINES", dumpfile); + if (assume->no_parallelism) + fputs (" NO_PARALLELISM", dumpfile); +} /* Show OpenMP or OpenACC clauses. */ @@ -1998,6 +2027,8 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses) show_expr (omp_clauses->message); fputc (')', dumpfile); } + if (omp_clauses->assume) + show_omp_assumes (omp_clauses->assume); } /* Show a single OpenMP or OpenACC directive node and everything underneath it @@ -2027,6 +2058,7 @@ show_omp_node (int level, gfc_code *c) case EXEC_OACC_CACHE: name = "CACHE"; is_oacc = true; break; case EXEC_OACC_ENTER_DATA: name = "ENTER DATA"; is_oacc = true; break; case EXEC_OACC_EXIT_DATA: name = "EXIT DATA"; is_oacc = true; break; + case EXEC_OMP_ASSUME: name = "ASSUME"; break; case EXEC_OMP_ATOMIC: name = "ATOMIC"; break; case EXEC_OMP_BARRIER: name = "BARRIER"; break; case EXEC_OMP_CANCEL: name = "CANCEL"; break; @@ -2128,6 +2160,7 @@ show_omp_node (int level, gfc_code *c) case EXEC_OACC_CACHE: case EXEC_OACC_ENTER_DATA: case EXEC_OACC_EXIT_DATA: + case EXEC_OMP_ASSUME: case EXEC_OMP_CANCEL: case EXEC_OMP_CANCELLATION_POINT: case EXEC_OMP_DISTRIBUTE: @@ -3353,6 +3386,7 @@ show_code_node (int level, gfc_code *c) case EXEC_OACC_CACHE: case EXEC_OACC_ENTER_DATA: case EXEC_OACC_EXIT_DATA: + case EXEC_OMP_ASSUME: case EXEC_OMP_ATOMIC: case EXEC_OMP_CANCEL: case EXEC_OMP_CANCELLATION_POINT: @@ -3531,6 +3565,14 @@ show_namespace (gfc_namespace *ns) } } + if (ns->omp_assumes) + { + show_indent (); + fprintf (dumpfile, "!$OMP ASSUMES"); + show_omp_assumes (ns->omp_assumes); + } + + fputc ('\n', dumpfile); show_indent (); fputs ("code:", dumpfile); diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 4babd77924b..29a443dcd44 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -316,7 +316,7 @@ enum gfc_statement ST_OMP_END_PARALLEL_MASKED_TASKLOOP_SIMD, ST_OMP_MASKED_TASKLOOP, ST_OMP_END_MASKED_TASKLOOP, ST_OMP_MASKED_TASKLOOP_SIMD, ST_OMP_END_MASKED_TASKLOOP_SIMD, ST_OMP_SCOPE, ST_OMP_END_SCOPE, - ST_OMP_ERROR, ST_NONE + ST_OMP_ERROR, ST_OMP_ASSUME, ST_OMP_END_ASSUME, ST_OMP_ASSUMES, ST_NONE }; /* Types of interfaces that we can have. Assignment interfaces are @@ -1506,6 +1506,19 @@ enum gfc_omp_bind_type OMP_BIND_THREAD }; +typedef struct gfc_omp_assumptions +{ + int n_absent, n_contains; + enum gfc_statement *absent, *contains; + gfc_expr_list *holds; + locus where; + bool no_openmp:1, no_openmp_routines:1, no_parallelism:1; +} +gfc_omp_assumptions; + +#define gfc_get_omp_assumptions() XCNEW (gfc_omp_assumptions) + + typedef struct gfc_omp_clauses { gfc_omp_namelist *lists[OMP_LIST_NUM]; @@ -1529,6 +1542,7 @@ typedef struct gfc_omp_clauses struct gfc_expr *if_exprs[OMP_IF_LAST]; struct gfc_expr *dist_chunk_size; struct gfc_expr *message; + struct gfc_omp_assumptions *assume; const char *critical_name; enum gfc_omp_default_sharing default_sharing; enum gfc_omp_atomic_op atomic_op; @@ -2145,6 +2159,9 @@ typedef struct gfc_namespace /* Linked list of !$omp declare variant constructs. */ struct gfc_omp_declare_variant *omp_declare_variant; + /* OpenMP assumptions. */ + struct gfc_omp_assumptions *omp_assumes; + /* A hash set for the gfc expressions that have already been finalized in this namespace. */ @@ -2913,7 +2930,7 @@ enum gfc_exec_op EXEC_OMP_ORDERED, EXEC_OMP_PARALLEL, EXEC_OMP_PARALLEL_DO, EXEC_OMP_PARALLEL_SECTIONS, EXEC_OMP_PARALLEL_WORKSHARE, EXEC_OMP_SECTIONS, EXEC_OMP_SINGLE, EXEC_OMP_WORKSHARE, - EXEC_OMP_ATOMIC, EXEC_OMP_BARRIER, EXEC_OMP_END_NOWAIT, + EXEC_OMP_ASSUME, EXEC_OMP_ATOMIC, EXEC_OMP_BARRIER, EXEC_OMP_END_NOWAIT, EXEC_OMP_END_SINGLE, EXEC_OMP_TASK, EXEC_OMP_TASKWAIT, EXEC_OMP_TASKYIELD, EXEC_OMP_CANCEL, EXEC_OMP_CANCELLATION_POINT, EXEC_OMP_TASKGROUP, EXEC_OMP_SIMD, EXEC_OMP_DO_SIMD, @@ -3576,6 +3593,7 @@ void gfc_free_omp_declare_simd (gfc_omp_declare_simd *); void gfc_free_omp_declare_simd_list (gfc_omp_declare_simd *); void gfc_free_omp_udr (gfc_omp_udr *); gfc_omp_udr *gfc_omp_udr_find (gfc_symtree *, gfc_typespec *); +void gfc_resolve_omp_assumptions (gfc_omp_assumptions *, const char *, locus *); void gfc_resolve_omp_directive (gfc_code *, gfc_namespace *); void gfc_resolve_do_iterator (gfc_code *, gfc_symbol *, bool); void gfc_resolve_omp_local_vars (gfc_namespace *); diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h index 1f53e0cb67d..2a805815d9c 100644 --- a/gcc/fortran/match.h +++ b/gcc/fortran/match.h @@ -149,6 +149,8 @@ match gfc_match_oacc_routine (void); /* OpenMP directive matchers. */ match gfc_match_omp_eos_error (void); +match gfc_match_omp_assume (void); +match gfc_match_omp_assumes (void); match gfc_match_omp_atomic (void); match gfc_match_omp_barrier (void); match gfc_match_omp_cancel (void); diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc index ce719bd5d92..df1f046170d 100644 --- a/gcc/fortran/openmp.cc +++ b/gcc/fortran/openmp.cc @@ -30,6 +30,9 @@ along with GCC; see the file COPYING3. If not see #include "gomp-constants.h" #include "target-memory.h" /* For gfc_encode_character. */ + +static gfc_statement omp_code_to_statement (gfc_code *); + /* Match an end of OpenMP directive. End of OpenMP directive is optional whitespace, followed by '\n' or comment '!'. */ @@ -111,6 +114,13 @@ gfc_free_omp_clauses (gfc_omp_clauses *c) gfc_free_expr_list (c->wait_list); gfc_free_expr_list (c->tile_list); free (CONST_CAST (char *, c->critical_name)); + if (c->assume) + { + free (c->assume->absent); + free (c->assume->contains); + gfc_free_expr_list (c->assume->holds); + free (c->assume); + } free (c); } @@ -992,6 +1002,7 @@ enum omp_mask2 OMP_CLAUSE_HAS_DEVICE_ADDR, /* OpenMP 5.1 */ OMP_CLAUSE_ENTER, /* OpenMP 5.2 */ OMP_CLAUSE_DOACROSS, /* OpenMP 5.2 */ + OMP_CLAUSE_ASSUMPTIONS, /* OpenMP 5.1. */ /* This must come last. */ OMP_MASK2_LAST }; @@ -1407,6 +1418,167 @@ gfc_match_omp_clause_reduction (char pc, gfc_omp_clauses *c, bool openacc, return MATCH_YES; } +static match +gfc_omp_absent_contains_clause (gfc_omp_assumptions **assume, bool is_absent) +{ + if (*assume == NULL) + *assume = gfc_get_omp_assumptions (); + do + { + gfc_statement st = ST_NONE; + gfc_gobble_whitespace (); + locus old_loc = gfc_current_locus; + switch (gfc_peek_ascii_char ()) + { + case 'a': + if (gfc_match ("assumes") == MATCH_YES) + st = ST_OMP_ASSUMES; + else if (gfc_match ("assume") == MATCH_YES) + st = ST_OMP_ASSUME; + else if (gfc_match ("atomic") == MATCH_YES) + st = ST_OMP_ATOMIC; + break; + case 'b': + if (gfc_match ("barrier") == MATCH_YES) + st = ST_OMP_BARRIER; + break; + case 'c': + if (gfc_match ("cancel") == MATCH_YES) + st = ST_OMP_CANCEL; + else if (gfc_match ("cancellation point") == MATCH_YES) + st = ST_OMP_CANCELLATION_POINT; + else if (gfc_match ("critical") == MATCH_YES) + st = ST_OMP_CRITICAL; + break; + case 'd': + if (gfc_match ("declare reduction") == MATCH_YES) + st = ST_OMP_DECLARE_REDUCTION; + else if (gfc_match ("declare simd") == MATCH_YES) + st = ST_OMP_DECLARE_SIMD; + else if (gfc_match ("declare target") == MATCH_YES) + st = ST_OMP_DECLARE_TARGET; + else if (gfc_match ("declare variant") == MATCH_YES) + st = ST_OMP_DECLARE_VARIANT; + else if (gfc_match ("depobj") == MATCH_YES) + st = ST_OMP_DEPOBJ; + else if (gfc_match ("distribute") == MATCH_YES) + st = ST_OMP_DISTRIBUTE; + else if (gfc_match ("do") == MATCH_YES) + st = ST_OMP_DO; + break; + case 'e': + if (gfc_match ("error") == MATCH_YES) + st = ST_OMP_ERROR; + break; + case 'f': + if (gfc_match ("flush") == MATCH_YES) + st = ST_OMP_FLUSH; + break; + case 'l': + if (gfc_match ("loop") == MATCH_YES) + st = ST_OMP_LOOP; + break; + case 'm': + if (gfc_match ("masked") == MATCH_YES) + st = ST_OMP_MASKED; + break; + case 'p': + if (gfc_match ("parallel") == MATCH_YES) + st = ST_OMP_PARALLEL; + break; + case 'r': + if (gfc_match ("requires") == MATCH_YES) + st = ST_OMP_REQUIRES; + break; + case 's': + if (gfc_match ("scan") == MATCH_YES) + st = ST_OMP_SCAN; + else if (gfc_match ("scope") == MATCH_YES) + st = ST_OMP_SCOPE; + else if (gfc_match ("sections") == MATCH_YES) + st = ST_OMP_SECTIONS; + else if (gfc_match ("section") == MATCH_YES) + st = ST_OMP_SECTION; + else if (gfc_match ("simd") == MATCH_YES) + st = ST_OMP_SIMD; + else if (gfc_match ("single") == MATCH_YES) + st = ST_OMP_SINGLE; + break; + case 't': + if (gfc_match ("target data") == MATCH_YES) + st = ST_OMP_TARGET_DATA; + if (gfc_match ("target enter data") == MATCH_YES) + st = ST_OMP_TARGET_ENTER_DATA; + if (gfc_match ("target exit data") == MATCH_YES) + st = ST_OMP_TARGET_EXIT_DATA; + if (gfc_match ("target update") == MATCH_YES) + st = ST_OMP_TARGET_UPDATE; + if (gfc_match ("target") == MATCH_YES) + st = ST_OMP_TARGET; + if (gfc_match ("taskgroup") == MATCH_YES) + st = ST_OMP_TASKGROUP; + if (gfc_match ("taskloop") == MATCH_YES) + st = ST_OMP_TASKLOOP; + if (gfc_match ("task") == MATCH_YES) + st = ST_OMP_TASK; + if (gfc_match ("taskwait") == MATCH_YES) + st = ST_OMP_TASKWAIT; + if (gfc_match ("taskyield") == MATCH_YES) + st = ST_OMP_TASKYIELD; + if (gfc_match ("teams") == MATCH_YES) + st = ST_OMP_TEAMS; + if (gfc_match ("threadprivate") == MATCH_YES) + st = ST_OMP_THREADPRIVATE; + break; + case 'w': + if (gfc_match ("workshare") == MATCH_YES) + st = ST_OMP_WORKSHARE; + default: + break; + } + if (st == ST_NONE) + { + gfc_error ("Unknown directive at %L", &old_loc); + return MATCH_ERROR; + } + if (is_omp_declarative_stmt (st) || is_omp_informational_stmt (st)) + { + gfc_error ("Invalid %qs directive at %L in %s clause: declarative, " + "informational and meta directives not permitted", + gfc_ascii_statement (st, true), &old_loc, + is_absent ? "ABSENT" : "CONTAINS"); + return MATCH_ERROR; + } + if (is_absent) + { + (*assume)->n_absent++; + (*assume)->absent + = (gfc_statement *) xrealloc ((*assume)->absent, + sizeof (gfc_statement) + * (*assume)->n_absent); + (*assume)->absent[(*assume)->n_absent - 1] = st; + } + else + { + (*assume)->n_contains++; + (*assume)->contains + = (gfc_statement *) xrealloc ((*assume)->contains, + sizeof (gfc_statement) + * (*assume)->n_contains); + (*assume)->contains[(*assume)->n_contains - 1] = st; + } + gfc_gobble_whitespace (); + if (gfc_match(",") == MATCH_YES) + continue; + if (gfc_match(")") == MATCH_YES) + break; + gfc_error ("Expected %<,%> or %<)%> at %C"); + return MATCH_ERROR; + } + while (true); + + return MATCH_YES; +} /* Match with duplicate check. Matches 'name'. If expr != NULL, it then matches '(expr)', otherwise, if open_parens is true, @@ -1472,10 +1644,10 @@ static match gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, bool first = true, bool needs_space = true, bool openacc = false, bool context_selector = false, - bool openmp_target = false) + bool openmp_target = false, bool alloc_cp = true) { bool error = false; - gfc_omp_clauses *c = gfc_get_omp_clauses (); + gfc_omp_clauses *c; locus old_loc; /* Determine whether we're dealing with an OpenACC directive that permits derived type member accesses. This in particular disallows @@ -1487,7 +1659,13 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, || (mask & OMP_CLAUSE_HOST_SELF))); gcc_checking_assert (OMP_MASK1_LAST <= 64 && OMP_MASK2_LAST <= 64); - *cp = NULL; + if (alloc_cp) + { + c = gfc_get_omp_clauses (); + *cp = NULL; + } + else + c = *cp; while (1) { match m = MATCH_NO; @@ -1511,6 +1689,14 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, case 'a': end_colon = false; head = NULL; + if ((mask & OMP_CLAUSE_ASSUMPTIONS) + && gfc_match ("absent ( ") == MATCH_YES) + { + if (gfc_omp_absent_contains_clause (&c->assume, true) + != MATCH_YES) + goto error; + continue; + } if ((mask & OMP_CLAUSE_ALIGNED) && gfc_match_omp_variable_list ("aligned (", &c->lists[OMP_LIST_ALIGNED], @@ -1743,6 +1929,14 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, needs_space = true; continue; } + if ((mask & OMP_CLAUSE_ASSUMPTIONS) + && gfc_match ("contains ( ") == MATCH_YES) + { + if (gfc_omp_absent_contains_clause (&c->assume, false) + != MATCH_YES) + goto error; + continue; + } if ((mask & OMP_CLAUSE_COPY) && gfc_match ("copy ( ") == MATCH_YES && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], @@ -2277,6 +2471,20 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, goto error; continue; } + if ((mask & OMP_CLAUSE_ASSUMPTIONS) + && gfc_match ("holds ( ") == MATCH_YES) + { + gfc_expr *e; + if (gfc_match ("%e )", &e) != MATCH_YES) + goto error; + if (c->assume == NULL) + c->assume = gfc_get_omp_assumptions (); + gfc_expr_list *el = XCNEW (gfc_expr_list); + el->expr = e; + el->next = c->assume->holds; + c->assume->holds = el; + continue; + } if ((mask & OMP_CLAUSE_HOST_SELF) && gfc_match ("host ( ") == MATCH_YES && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], @@ -2664,6 +2872,41 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, OMP_MAP_IF_PRESENT, true, allow_derived)) continue; + if ((mask & OMP_CLAUSE_ASSUMPTIONS) + && (m = gfc_match_dupl_check (!c->assume + || !c->assume->no_openmp_routines, + "no_openmp_routines")) == MATCH_YES) + { + if (m == MATCH_ERROR) + goto error; + if (c->assume == NULL) + c->assume = gfc_get_omp_assumptions (); + c->assume->no_openmp_routines = needs_space = true; + continue; + } + if ((mask & OMP_CLAUSE_ASSUMPTIONS) + && (m = gfc_match_dupl_check (!c->assume || !c->assume->no_openmp, + "no_openmp")) == MATCH_YES) + { + if (m == MATCH_ERROR) + goto error; + if (c->assume == NULL) + c->assume = gfc_get_omp_assumptions (); + c->assume->no_openmp = needs_space = true; + continue; + } + if ((mask & OMP_CLAUSE_ASSUMPTIONS) + && (m = gfc_match_dupl_check (!c->assume + || !c->assume->no_parallelism, + "no_parallelism")) == MATCH_YES) + { + if (m == MATCH_ERROR) + goto error; + if (c->assume == NULL) + c->assume = gfc_get_omp_assumptions (); + c->assume->no_parallelism = needs_space = true; + continue; + } if ((mask & OMP_CLAUSE_NOGROUP) && (m = gfc_match_dupl_check (!c->nogroup, "nogroup")) != MATCH_NO) @@ -3941,6 +4184,42 @@ match_omp (gfc_exec_op op, const omp_mask mask) } +match +gfc_match_omp_assume (void) +{ + return match_omp (EXEC_OMP_ASSUME, omp_mask (OMP_CLAUSE_ASSUMPTIONS)); +} + + +match +gfc_match_omp_assumes (void) +{ + locus loc = gfc_current_locus; + gfc_omp_clauses *c = gfc_get_omp_clauses (); + c->assume = gfc_current_ns->omp_assumes; + if (!gfc_current_ns->proc_name + || (gfc_current_ns->proc_name->attr.flavor != FL_MODULE + && !gfc_current_ns->proc_name->attr.subroutine + && !gfc_current_ns->proc_name->attr.function)) + { + gfc_error ("!OMP ASSUMES at %C must be in the specification part of a " + "subprogram or module"); + return MATCH_ERROR; + } + if (gfc_match_omp_clauses (&c, omp_mask (OMP_CLAUSE_ASSUMPTIONS), true, true, + false, false, false, false) != MATCH_YES) + { + gfc_current_ns->omp_assumes = NULL; + return MATCH_ERROR; + } + c->assume->where = loc; + gfc_current_ns->omp_assumes = c->assume; + c->assume = NULL; + gfc_free_omp_clauses (c); + return MATCH_YES; +} + + match gfc_match_omp_critical (void) { @@ -6505,6 +6784,42 @@ resolve_omp_udr_clause (gfc_omp_namelist *n, gfc_namespace *ns, return copy; } + +/* Resolve ASSUME's and ASSUMES' assumption clauses. */ + +void +gfc_resolve_omp_assumptions (gfc_omp_assumptions *assume, const char *directive, + locus *loc) +{ + for (gfc_expr_list *el = assume->holds; el; el = el->next) + if (!gfc_resolve_expr (el->expr) || el->expr->ts.type != BT_LOGICAL) + gfc_error ("HOLDS expression at %L must be a logical expression", + &el->expr->where); + for (int i = 0; i < assume->n_absent; i++) + { + for (int j = i + 1; j < assume->n_absent; j++) + if (assume->absent[i] == assume->absent[j]) + gfc_error ("%qs directive mentioned multiple times in %s clause in %s" + " directive at %L", + gfc_ascii_statement (assume->absent[i], true), + "ABSENT", directive, loc); + for (int j = 0; j < assume->n_contains; j++) + if (assume->absent[i] == assume->contains[j]) + gfc_error ("%qs directive mentioned both times in ABSENT and CONTAINS" + " clauses in %s directive at %L", + gfc_ascii_statement (assume->absent[i], true), + directive, loc); + } + for (int i = 0; i < assume->n_contains; i++) + for (int j = i + 1; j < assume->n_contains; j++) + if (assume->contains[i] == assume->contains[j]) + gfc_error ("%qs directive mentioned multiple times in %s clause in %s " + "directive at %L", + gfc_ascii_statement (assume->contains[i], true), + "CONTAINS", directive, loc); +} + + /* OpenMP directive resolving routines. */ static void @@ -7888,6 +8203,13 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, gfc_error ("% clause at %L must not be used together with " "% clause", &omp_clauses->detach->where); } + + if (omp_clauses->assume) + { + const char *name = gfc_ascii_statement (omp_code_to_statement (code), + true); + gfc_resolve_omp_assumptions (omp_clauses->assume, name, &code->loc); + } } @@ -9116,6 +9438,8 @@ omp_code_to_statement (gfc_code *code) return ST_OMP_DO; case EXEC_OMP_LOOP: return ST_OMP_LOOP; + case EXEC_OMP_ASSUME: + return ST_OMP_ASSUME; case EXEC_OMP_ATOMIC: return ST_OMP_ATOMIC; case EXEC_OMP_BARRIER: @@ -9635,6 +9959,7 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns) case EXEC_OMP_TEAMS_LOOP: resolve_omp_do (code); break; + case EXEC_OMP_ASSUME: case EXEC_OMP_CANCEL: case EXEC_OMP_ERROR: case EXEC_OMP_MASKED: diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc index 5b13441912a..cb5d917b886 100644 --- a/gcc/fortran/parse.cc +++ b/gcc/fortran/parse.cc @@ -885,6 +885,8 @@ decode_omp_directive (void) switch (c) { case 'a': + matcho ("assumes", gfc_match_omp_assumes, ST_OMP_ASSUMES); + matchs ("assume", gfc_match_omp_assume, ST_OMP_ASSUME); matcho ("atomic", gfc_match_omp_atomic, ST_OMP_ATOMIC); break; case 'b': @@ -913,6 +915,7 @@ decode_omp_directive (void) break; case 'e': matcho ("error", gfc_match_omp_error, ST_OMP_ERROR); + matchs ("end assume", gfc_match_omp_eos_error, ST_OMP_END_ASSUME); matcho ("end atomic", gfc_match_omp_eos_error, ST_OMP_END_ATOMIC); matcho ("end critical", gfc_match_omp_end_critical, ST_OMP_END_CRITICAL); matchs ("end distribute parallel do simd", gfc_match_omp_eos_error, @@ -1716,6 +1719,7 @@ next_statement (void) case ST_OMP_TARGET_SIMD: case ST_OMP_TASKLOOP: case ST_OMP_TASKLOOP_SIMD: \ case ST_OMP_LOOP: case ST_OMP_PARALLEL_LOOP: case ST_OMP_TEAMS_LOOP: \ case ST_OMP_TARGET_PARALLEL_LOOP: case ST_OMP_TARGET_TEAMS_LOOP: \ + case ST_OMP_ASSUME: \ case ST_CRITICAL: \ case ST_OACC_PARALLEL_LOOP: case ST_OACC_PARALLEL: case ST_OACC_KERNELS: \ case ST_OACC_DATA: case ST_OACC_HOST_DATA: case ST_OACC_LOOP: \ @@ -1733,7 +1737,7 @@ next_statement (void) #define case_omp_decl case ST_OMP_THREADPRIVATE: case ST_OMP_DECLARE_SIMD: \ case ST_OMP_DECLARE_TARGET: case ST_OMP_DECLARE_REDUCTION: \ - case ST_OMP_DECLARE_VARIANT: \ + case ST_OMP_DECLARE_VARIANT: case ST_OMP_ASSUMES: \ case ST_OMP_REQUIRES: case ST_OACC_ROUTINE: case ST_OACC_DECLARE /* Block end statements. Errors associated with interchanging these @@ -1925,10 +1929,11 @@ gfc_enclosing_unit (gfc_compile_state * result) } -/* Translate a statement enum to a string. */ +/* Translate a statement enum to a string. If strip_sentinel is true, + the !$OMP/!$ACC sentinel is excluded. */ const char * -gfc_ascii_statement (gfc_statement st) +gfc_ascii_statement (gfc_statement st, bool strip_sentinel) { const char *p; @@ -2353,6 +2358,12 @@ gfc_ascii_statement (gfc_statement st) case ST_OACC_END_ATOMIC: p = "!$ACC END ATOMIC"; break; + case ST_OMP_ASSUME: + p = "!$OMP ASSUME"; + break; + case ST_OMP_ASSUMES: + p = "!$OMP ASSUMES"; + break; case ST_OMP_ATOMIC: p = "!$OMP ATOMIC"; break; @@ -2401,6 +2412,9 @@ gfc_ascii_statement (gfc_statement st) case ST_OMP_DO_SIMD: p = "!$OMP DO SIMD"; break; + case ST_OMP_END_ASSUME: + p = "!$OMP END ASSUME"; + break; case ST_OMP_END_ATOMIC: p = "!$OMP END ATOMIC"; break; @@ -2751,6 +2765,8 @@ gfc_ascii_statement (gfc_statement st) gfc_internal_error ("gfc_ascii_statement(): Bad statement code"); } + if (strip_sentinel && p[0] == '!') + return p + strlen ("!$OMP "); return p; } @@ -5518,6 +5534,9 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only) switch (omp_st) { + case ST_OMP_ASSUME: + omp_end_st = ST_OMP_END_ASSUME; + break; case ST_OMP_PARALLEL: omp_end_st = ST_OMP_END_PARALLEL; break; @@ -5651,6 +5670,7 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only) parse_forall_block (); break; + case ST_OMP_ASSUME: case ST_OMP_PARALLEL: case ST_OMP_PARALLEL_MASKED: case ST_OMP_PARALLEL_MASTER: @@ -5874,6 +5894,7 @@ parse_executable (gfc_statement st) parse_oacc_structured_block (st); break; + case ST_OMP_ASSUME: case ST_OMP_PARALLEL: case ST_OMP_PARALLEL_MASKED: case ST_OMP_PARALLEL_MASTER: @@ -6996,6 +7017,32 @@ duplicate_main: return true; } +bool +is_omp_declarative_stmt (gfc_statement st) +{ + switch (st) + { + case_omp_decl: + return true; + default: + return false; + } +} + +bool +is_omp_informational_stmt (gfc_statement st) +{ + switch (st) + { + case ST_OMP_ASSUME: + case ST_OMP_ASSUMES: + case ST_OMP_REQUIRES: + return true; + default: + return false; + } +} + /* Return true if this state data represents an OpenACC region. */ bool is_oacc (gfc_state_data *sd) diff --git a/gcc/fortran/parse.h b/gcc/fortran/parse.h index 7ddea10237f..5bca09d0315 100644 --- a/gcc/fortran/parse.h +++ b/gcc/fortran/parse.h @@ -66,11 +66,13 @@ extern gfc_state_data *gfc_state_stack; int gfc_check_do_variable (gfc_symtree *); bool gfc_find_state (gfc_compile_state); gfc_state_data *gfc_enclosing_unit (gfc_compile_state *); -const char *gfc_ascii_statement (gfc_statement); +const char *gfc_ascii_statement (gfc_statement, bool strip_sentinel = false) ; match gfc_match_enum (void); match gfc_match_enumerator_def (void); void gfc_free_enum_history (void); extern bool gfc_matching_function; match gfc_match_prefix (gfc_typespec *); +bool is_omp_declarative_stmt (gfc_statement); +bool is_omp_informational_stmt (gfc_statement); bool is_oacc (gfc_state_data *); #endif /* GFC_PARSE_H */ diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index ae7ebb624e4..1e011ee74fc 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -10902,6 +10902,7 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns) case EXEC_OACC_ENTER_DATA: case EXEC_OACC_EXIT_DATA: case EXEC_OACC_ROUTINE: + case EXEC_OMP_ASSUME: case EXEC_OMP_CRITICAL: case EXEC_OMP_DISTRIBUTE: case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: @@ -12376,6 +12377,7 @@ start: gfc_resolve_oacc_directive (code, ns); break; + case EXEC_OMP_ASSUME: case EXEC_OMP_ATOMIC: case EXEC_OMP_BARRIER: case EXEC_OMP_CANCEL: @@ -17651,6 +17653,10 @@ gfc_resolve (gfc_namespace *ns) component_assignment_level = 0; resolve_codes (ns); + if (ns->omp_assumes) + gfc_resolve_omp_assumptions (ns->omp_assumes, "ASSUMES", + &ns->omp_assumes->where); + gfc_current_ns = old_ns; cs_base = old_cs_base; ns->resolved = 1; diff --git a/gcc/fortran/st.cc b/gcc/fortran/st.cc index 73f30c2137f..3c8ca66554d 100644 --- a/gcc/fortran/st.cc +++ b/gcc/fortran/st.cc @@ -214,6 +214,7 @@ gfc_free_statement (gfc_code *p) case EXEC_OACC_ENTER_DATA: case EXEC_OACC_EXIT_DATA: case EXEC_OACC_ROUTINE: + case EXEC_OMP_ASSUME: case EXEC_OMP_ATOMIC: case EXEC_OMP_CANCEL: case EXEC_OMP_CANCELLATION_POINT: diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc index 7a80dfd063b..6050359d521 100644 --- a/gcc/fortran/symbol.cc +++ b/gcc/fortran/symbol.cc @@ -4071,7 +4071,13 @@ gfc_free_namespace (gfc_namespace *&ns) f = f->next; free (current); } - + if (ns->omp_assumes) + { + free (ns->omp_assumes->absent); + free (ns->omp_assumes->contains); + gfc_free_expr_list (ns->omp_assumes->holds); + free (ns->omp_assumes); + } p = ns->contained; free (ns); ns = NULL; diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc index 8e9d5346b05..21053694f81 100644 --- a/gcc/fortran/trans-openmp.cc +++ b/gcc/fortran/trans-openmp.cc @@ -7487,6 +7487,8 @@ gfc_trans_omp_directive (gfc_code *code) { switch (code->op) { + case EXEC_OMP_ASSUME: + return gfc_trans_omp_code (code->block->next, true); case EXEC_OMP_ATOMIC: return gfc_trans_omp_atomic (code); case EXEC_OMP_BARRIER: diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc index 912a206f2ed..8a64882ea9e 100644 --- a/gcc/fortran/trans.cc +++ b/gcc/fortran/trans.cc @@ -2174,6 +2174,7 @@ trans_code (gfc_code * code, tree cond) res = gfc_trans_dt_end (code); break; + case EXEC_OMP_ASSUME: case EXEC_OMP_ATOMIC: case EXEC_OMP_BARRIER: case EXEC_OMP_CANCEL: diff --git a/gcc/testsuite/gfortran.dg/gomp/assume-1.f90 b/gcc/testsuite/gfortran.dg/gomp/assume-1.f90 new file mode 100644 index 00000000000..8bd5c723051 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/assume-1.f90 @@ -0,0 +1,24 @@ +subroutine foo (i, a) + implicit none + integer, value :: i + integer :: a(:) + integer :: j + + j = 7 + !$omp assume no_openmp, absent (target, teams) holds (i < 32) holds (i < 32_2) + !$omp end assume + + !$omp assume no_openmp_routines, contains (simd) + block + !$omp simd + do j = 1, i + a(i) = j + end do + end block + + !$omp assume no_parallelism, contains (error) + if (i >= 32) then + !$omp error at (execution) message ("Should not happen") + end if + !$omp end assume +end diff --git a/gcc/testsuite/gfortran.dg/gomp/assume-2.f90 b/gcc/testsuite/gfortran.dg/gomp/assume-2.f90 new file mode 100644 index 00000000000..cb800676020 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/assume-2.f90 @@ -0,0 +1,27 @@ +subroutine foo (i, a) + implicit none + integer, value :: i + integer :: a(:) + integer :: j + + j = 7 + !$omp assume no_openmp, absent (target, teams,target) holds (i < 32) holds (i < 32_2) ! { dg-error "'TARGET' directive mentioned multiple times in ABSENT clause in ASSUME directive" } + !$omp end assume + + !$omp assume no_openmp_routines, contains (simd) contains ( simd ) ! { dg-error "'SIMD' directive mentioned multiple times in CONTAINS clause in ASSUME directive" } + block + !$omp simd + do j = 1, i + a(i) = j + end do + end block + + !$omp assume no_parallelism, contains (error) absent (error) ! { dg-error "'ERROR' directive mentioned both times in ABSENT and CONTAINS clauses in ASSUME directive" } + if (i >= 32) then + !$omp error at (execution) message ("Should not happen") + end if + !$omp end assume + + !$omp assume holds (1.0) ! { dg-error "HOLDS expression at .1. must be a logical expression" } + !$omp end assume +end diff --git a/gcc/testsuite/gfortran.dg/gomp/assumes-1.f90 b/gcc/testsuite/gfortran.dg/gomp/assumes-1.f90 new file mode 100644 index 00000000000..6a50914f185 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/assumes-1.f90 @@ -0,0 +1,84 @@ +! All of the following (up to PROGRAM) are okay: +! +subroutine sub + interface + subroutine sub_iterface() + !$omp assumes no_openmp_routines absent(simd) ! OK inferface of an external subroutine/subprogram + end + end interface + !$omp assumes no_openmp_routines absent(simd) ! OK external subroutine/subprogram +contains + subroutine inner_sub + !$omp assumes no_parallelism absent(teams) ! OK internal subroutine/subprogram + end +end + +integer function func () + !$omp assumes no_openmp_routines absent(simd) ! OK external function/subprogram + interface + integer function func_iterface() + !$omp assumes no_openmp_routines absent(simd) ! OK inferface of an external function/subprogram + end + end interface + func = 0 +contains + integer function inner_func() + !$omp assumes no_parallelism absent(teams) ! OK internal function/subprogram + inner_sub2 = 0 + end +end + +module m + integer ::x + !$omp assumes contains(target) holds(x > 0.0) + + interface + subroutine mod_mod_sub_iterface() + !$omp assumes no_openmp_routines absent(simd) ! OK inferface of an external subroutine/subprogram + end + integer function mod_mod_func_iterface() + !$omp assumes no_openmp_routines absent(error) ! OK inferface of an external subroutine/subprogram + end + end interface + +contains + subroutine mod_sub + interface + subroutine mod_sub_iterface() + !$omp assumes no_openmp_routines absent(simd) ! OK inferface of an external subroutine/subprogram + end + end interface + !$omp assumes no_openmp_routines absent(simd) ! OK module subroutine/subprogram + contains + subroutine mod_inner_sub + !$omp assumes no_parallelism absent(teams) ! OK internal subroutine/subprogram + end + end + + integer function mod_func () + !$omp assumes no_openmp_routines absent(simd) ! OK module function/subprogram + interface + integer function mod_func_iterface() + !$omp assumes no_openmp_routines absent(simd) ! OK inferface of an external function/subprogram + end + end interface + mod_func = 0 + contains + integer function mod_inner_func() + !$omp assumes no_parallelism absent(teams) ! OK internal function/subprogram + mod_inner_sub2 = 0 + end + end +end module m + + +! PROGRAM - invalid as: +! main program is a program unit that is not a subprogram +!$omp assumes no_openmp absent(simd) ! { dg-error "must be in the specification part of a subprogram or module" } + block + ! invalid: block + !$omp assumes no_openmp absent(target) ! { dg-error "must be in the specification part of a subprogram or module" } + end block +end + + diff --git a/gcc/testsuite/gfortran.dg/gomp/assumes-2.f90 b/gcc/testsuite/gfortran.dg/gomp/assumes-2.f90 new file mode 100644 index 00000000000..9e4eabd4977 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/assumes-2.f90 @@ -0,0 +1,7 @@ +module m + integer ::x + !$omp assumes contains(target) holds(x > 0.0) + !$omp assumes absent(target) holds(0.0) +! { dg-error "HOLDS expression at .1. must be a logical expression" "" { target *-*-* } .-1 } +! { dg-error "'TARGET' directive mentioned both times in ABSENT and CONTAINS clauses in ASSUMES directive at .1." "" { target *-*-* } .-2 } +end module diff --git a/libgomp/libgomp.texi b/libgomp/libgomp.texi index 2b11f304409..12b6edc0026 100644 --- a/libgomp/libgomp.texi +++ b/libgomp/libgomp.texi @@ -287,7 +287,7 @@ The OpenMP 4.5 specification is fully supported. @code{append_args} @tab N @tab @item @code{dispatch} construct @tab N @tab @item device-specific ICV settings with environment variables @tab Y @tab -@item @code{assume} directive @tab P @tab Only C/C++ +@item @code{assume} directive @tab Y @tab @item @code{nothing} directive @tab Y @tab @item @code{error} directive @tab Y @tab @item @code{masked} construct @tab Y @tab