From patchwork Tue Sep 6 07:15:40 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Marc_Poulhi=C3=A8s?= X-Patchwork-Id: 1009 Return-Path: Delivered-To: ouuuleilei@gmail.com Received: by 2002:a5d:5044:0:0:0:0:0 with SMTP id h4csp503842wrt; Tue, 6 Sep 2022 00:17:23 -0700 (PDT) X-Google-Smtp-Source: AA6agR7bqwhTd0nMOrUsiNkbtoozm8PMyjOua1ZCdBWyR2NKtRAtE4YXBKDK6s10KM7alRTBq3MT X-Received: by 2002:a17:907:6d24:b0:731:7720:bb9b with SMTP id sa36-20020a1709076d2400b007317720bb9bmr39045551ejc.717.1662448643511; Tue, 06 Sep 2022 00:17:23 -0700 (PDT) ARC-Seal: i=1; a=rsa-sha256; t=1662448643; cv=none; d=google.com; s=arc-20160816; b=WDZ2izlXoNdoDXTfEhRkhl2P+A7EpGi2OhG9WAk0iqLNEl+fihcYlcnZhbSJjS2fes j/jHHAEqVfANYwIK6c7mRLYAfSrlDxVw5ei9/2sWGYEnkh2jmnsSnvZclEG59mtC5KAk NFaHFUvZaPaHn7AutpSwbt9yVBRvEsAxMrY6WR0EJ6cGBkG72Ny7j97LcwLV3x+4Ha+Y UFzrLwlv3kj6/2JP+jtpvD2jpfq9T2T5xPZT8Vqlr4tOp3whPDu6vrhSLfcWJCHgE5h+ sH0yi+Na0VB2o6NrFtYIR1lfipJBuSx6jetaxWvi+glc9+R/7dcQM4GBn/tfDxakFyCm oM1g== ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=google.com; s=arc-20160816; h=sender:errors-to:cc:reply-to:from:list-subscribe:list-help :list-post:list-archive:list-unsubscribe:list-id:precedence :content-disposition:mime-version:message-id:subject:to:date :dmarc-filter:delivered-to:dkim-signature:dkim-filter; bh=5zLLZ0IjtQqq/NHSPz3LktY30b3kyOqgf/FmEutEYFQ=; b=oUSP49ogDguo9yRNR8c6bclc7rvXnfCJZ32BXRvVqFY9oKb5Yeu+t/JloGYB7KhTQX 2k4oTsdE8ulL2Ac30pgD2C8miyuHzLxbsWR/qFaZb2xEKFxpoROcQvDp33P9SDsVG9hP 5igB4WuAQypYVfU5h0CDtvr/VfY+iw8bhC4fZjIhNNBDk1hm/zy1sIL6vF4rnArn4i81 aqo4L12RpQ3WQGGyuCWdrb0dwrSOehirzA4sNOADVKOLFHHZ/wOOQ2nk/esb0kf7Teqt m7DlxxhTSTz45xI/yCNr7+1Og48QaL4TkD9Bw6MSb0PkLuVC/8xpGy89e+5WHeyw8R5z 6P2g== ARC-Authentication-Results: i=1; mx.google.com; dkim=pass header.i=@gcc.gnu.org header.s=default header.b=DuugjF4N; spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 8.43.85.97 as permitted sender) smtp.mailfrom="gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org"; dmarc=pass (p=NONE sp=NONE dis=NONE) header.from=gnu.org Received: from sourceware.org (server2.sourceware.org. [8.43.85.97]) by mx.google.com with ESMTPS id gh6-20020a1709073c0600b0073143915e4fsi7123552ejc.896.2022.09.06.00.17.23 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 06 Sep 2022 00:17:23 -0700 (PDT) Received-SPF: pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 8.43.85.97 as permitted sender) client-ip=8.43.85.97; Authentication-Results: mx.google.com; dkim=pass header.i=@gcc.gnu.org header.s=default header.b=DuugjF4N; spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 8.43.85.97 as permitted sender) smtp.mailfrom="gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org"; dmarc=pass (p=NONE sp=NONE dis=NONE) header.from=gnu.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 696C2383E049 for ; Tue, 6 Sep 2022 07:16:28 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 696C2383E049 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1662448588; bh=5zLLZ0IjtQqq/NHSPz3LktY30b3kyOqgf/FmEutEYFQ=; h=Date:To:Subject:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:Cc:From; b=DuugjF4NZr2TZsN66PsG742jzyWHZoeuEOdsVQb6Z7iGEOBK3k9tAi0aRhGm5EVUR 82cD6eYkc+0cdnZ1zyy+JYLFEIRET2GjgWR7TOBnJSO4GUjywGjdhomtKJ1DMIzUCY 6y8AA26sue3U09pvjDeXhbwAU56o9V3tOOl0Dajc= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wr1-x436.google.com (mail-wr1-x436.google.com [IPv6:2a00:1450:4864:20::436]) by sourceware.org (Postfix) with ESMTPS id 75651385AC19 for ; Tue, 6 Sep 2022 07:15:42 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 75651385AC19 Received: by mail-wr1-x436.google.com with SMTP id b16so14015871wru.7 for ; Tue, 06 Sep 2022 00:15:42 -0700 (PDT) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=content-disposition:mime-version:message-id:subject:cc:to:from:date :x-gm-message-state:from:to:cc:subject:date; bh=5zLLZ0IjtQqq/NHSPz3LktY30b3kyOqgf/FmEutEYFQ=; b=zwHmB0yhLyTWgWBRuSPiJI6i1ht0pXJQo3titXWm5D5MFMz6yKijFllyGyjwooe4Zp 9Poup4+VaR8vYDxfdZs6xBaLcHgcPvmol6foYroATRy1ascH4aSoQXvK+fk2/7kupUn0 ak6gMeYhMN3ghQrXGYOndu6CcmL1T9XH4FfA+MZz770qUE0LYAPnr7VVGDuTmtBHUyIH g4YAkJmyMWRkboQ+LLDak++iXSLUv6FnubCo5S/PTEgKzFeAg49/q5AnsPdkAemJfSKz cG8RlTarByVKa+pinBp6senp5+9PmNeVjRUvznGlDJjGq3ukOiNiM5M+KzII3VBBWxoE 8L3g== X-Gm-Message-State: ACgBeo20L9bAe+eEiLq20PFWUVd3yPLZ0Jp0HrJmb4mCOZsRVBe2Xh2j P8u77PXMOMZuUQ0qoGGFxRAerEU6ipQwKA== X-Received: by 2002:adf:ed81:0:b0:226:a509:14b6 with SMTP id c1-20020adfed81000000b00226a50914b6mr26095455wro.150.1662448541253; Tue, 06 Sep 2022 00:15:41 -0700 (PDT) Received: from poulhies-Precision-5550 (static-176-191-105-132.ftth.abo.bbox.fr. [176.191.105.132]) by smtp.gmail.com with ESMTPSA id z7-20020a05600c0a0700b003a5c1e916c8sm35754568wmp.1.2022.09.06.00.15.40 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 06 Sep 2022 00:15:40 -0700 (PDT) Date: Tue, 6 Sep 2022 09:15:40 +0200 To: gcc-patches@gcc.gnu.org Subject: [Ada] Improve detection of illegal Iterable aspects Message-ID: <20220906071540.GA1280186@poulhies-Precision-5550> MIME-Version: 1.0 Content-Disposition: inline X-Spam-Status: No, score=-12.8 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP, T_SCC_BODY_TEXT_LINE 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-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: , X-Patchwork-Original-From: =?utf-8?q?Marc_Poulhi=C3=A8s_via_Gcc-patches?= From: =?utf-8?q?Marc_Poulhi=C3=A8s?= Reply-To: Marc =?iso-8859-1?q?Poulhi=E8s?= Cc: Piotr Trojanek 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?1743203748418757450?= X-GMAIL-MSGID: =?utf-8?q?1743203748418757450?= Handling of aspect Iterable was lacking guards against illegal code, so the compiler either crashed or emitted cryptic errors while expanding loops that rely on this aspect. Tested on x86_64-pc-linux-gnu, committed on trunk gcc/ada/ * doc/gnat_rm/implementation_defined_aspects.rst (Aspect Iterable): Include Last and Previous primitives in syntactic and semantic description. * exp_attr.adb (Expand_N_Attribute_Reference): Don't expect attributes like Iterable that can only appear in attribute definition clauses. * sem_ch13.adb (Analyze_Attribute_Definition_Clause): Prevent crash on non-aggregate Iterable attribute; improve basic diagnosis of attribute values. (Resolve_Iterable_Operation): Improve checks for illegal primitives in aspect Iterable, e.g. with wrong number of formal parameters. (Validate_Iterable_Aspect): Prevent crashes on syntactically illegal aspect expression. * sem_util.adb (Get_Cursor_Type): Fix style. * gnat_ugn.texi, gnat_rm.texi: Regenerate. diff --git a/gcc/ada/doc/gnat_rm/implementation_defined_aspects.rst b/gcc/ada/doc/gnat_rm/implementation_defined_aspects.rst --- a/gcc/ada/doc/gnat_rm/implementation_defined_aspects.rst +++ b/gcc/ada/doc/gnat_rm/implementation_defined_aspects.rst @@ -317,23 +317,27 @@ The following is a typical example of use: type List is private with Iterable => (First => First_Cursor, Next => Advance, - Has_Element => Cursor_Has_Element, - [Element => Get_Element]); + Has_Element => Cursor_Has_Element + [,Element => Get_Element] + [,Last => Last_Cursor] + [,Previous => Retreat]); -* The value denoted by ``First`` must denote a primitive operation of the - container type that returns a ``Cursor``, which must a be a type declared in +* The values of ``First`` and ``Last`` are primitive operations of the + container type that return a ``Cursor``, which must be a type declared in the container package or visible from it. For example: .. code-block:: ada function First_Cursor (Cont : Container) return Cursor; + function Last_Cursor (Cont : Container) return Cursor; -* The value of ``Next`` is a primitive operation of the container type that takes - both a container and a cursor and yields a cursor. For example: +* The values of ``Next`` and ``Previous`` are primitive operations of the container type that take + both a container and a cursor and yield a cursor. For example: .. code-block:: ada function Advance (Cont : Container; Position : Cursor) return Cursor; + function Retreat (Cont : Container; Position : Cursor) return Cursor; * The value of ``Has_Element`` is a primitive operation of the container type that takes both a container and a cursor and yields a boolean. For example: diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -2079,7 +2079,8 @@ package body Exp_Attr is case Id is - -- Attributes related to Ada 2012 iterators + -- Attributes related to Ada 2012 iterators. They are only allowed in + -- attribute definition clauses and should never be expanded. when Attribute_Constant_Indexing | Attribute_Default_Iterator @@ -2088,7 +2089,7 @@ package body Exp_Attr is | Attribute_Iterator_Element | Attribute_Variable_Indexing => - null; + raise Program_Error; -- Internal attributes used to deal with Ada 2012 delayed aspects. These -- were already rejected by the parser. Thus they shouldn't appear here. diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -9774,33 +9774,37 @@ The following is a typical example of use: type List is private with Iterable => (First => First_Cursor, Next => Advance, - Has_Element => Cursor_Has_Element, - [Element => Get_Element]); + Has_Element => Cursor_Has_Element + [,Element => Get_Element] + [,Last => Last_Cursor] + [,Previous => Retreat]); @end example @itemize * @item -The value denoted by @code{First} must denote a primitive operation of the -container type that returns a @code{Cursor}, which must a be a type declared in +The values of @code{First} and @code{Last} are primitive operations of the +container type that return a @code{Cursor}, which must be a type declared in the container package or visible from it. For example: @end itemize @example function First_Cursor (Cont : Container) return Cursor; +function Last_Cursor (Cont : Container) return Cursor; @end example @itemize * @item -The value of @code{Next} is a primitive operation of the container type that takes -both a container and a cursor and yields a cursor. For example: +The values of @code{Next} and @code{Previous} are primitive operations of the container type that take +both a container and a cursor and yield a cursor. For example: @end itemize @example function Advance (Cont : Container; Position : Cursor) return Cursor; +function Retreat (Cont : Container; Position : Cursor) return Cursor; @end example diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -29308,8 +29308,8 @@ to permit their use in free software. @printindex ge -@anchor{gnat_ugn/gnat_utility_programs switches-related-to-project-files}@w{ } @anchor{cf}@w{ } +@anchor{gnat_ugn/gnat_utility_programs switches-related-to-project-files}@w{ } @c %**end of body @bye diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -6959,6 +6959,7 @@ package body Sem_Ch13 is if Nkind (Expr) /= N_Aggregate then Error_Msg_N ("aspect Iterable must be an aggregate", Expr); + return; end if; declare @@ -6969,7 +6970,9 @@ package body Sem_Ch13 is while Present (Assoc) loop Analyze (Expression (Assoc)); - if not Is_Entity_Name (Expression (Assoc)) then + if not Is_Entity_Name (Expression (Assoc)) + or else Ekind (Entity (Expression (Assoc))) /= E_Function + then Error_Msg_N ("value must be a function", Assoc); end if; @@ -15875,22 +15878,34 @@ package body Sem_Ch13 is Ent := Entity (N); F1 := First_Formal (Ent); + F2 := Next_Formal (F1); - if Nam in Name_First | Name_Last then + if Nam = Name_First then - -- First or Last (Container) => Cursor + -- First (Container) => Cursor if Etype (Ent) /= Cursor then Error_Msg_N ("primitive for First must yield a cursor", N); + elsif Present (F2) then + Error_Msg_N ("no match for First iterable primitive", N); + end if; + + elsif Nam = Name_Last then + + -- Last (Container) => Cursor + + if Etype (Ent) /= Cursor then + Error_Msg_N ("primitive for Last must yield a cursor", N); + elsif Present (F2) then + Error_Msg_N ("no match for Last iterable primitive", N); end if; elsif Nam = Name_Next then -- Next (Container, Cursor) => Cursor - F2 := Next_Formal (F1); - - if Etype (F2) /= Cursor + if No (F2) + or else Etype (F2) /= Cursor or else Etype (Ent) /= Cursor or else Present (Next_Formal (F2)) then @@ -15901,9 +15916,8 @@ package body Sem_Ch13 is -- Previous (Container, Cursor) => Cursor - F2 := Next_Formal (F1); - - if Etype (F2) /= Cursor + if No (F2) + or else Etype (F2) /= Cursor or else Etype (Ent) /= Cursor or else Present (Next_Formal (F2)) then @@ -15914,9 +15928,8 @@ package body Sem_Ch13 is -- Has_Element (Container, Cursor) => Boolean - F2 := Next_Formal (F1); - - if Etype (F2) /= Cursor + if No (F2) + or else Etype (F2) /= Cursor or else Etype (Ent) /= Standard_Boolean or else Present (Next_Formal (F2)) then @@ -15924,7 +15937,8 @@ package body Sem_Ch13 is end if; elsif Nam = Name_Element then - F2 := Next_Formal (F1); + + -- Element (Container, Cursor) => Element_Type; if No (F2) or else Etype (F2) /= Cursor @@ -17084,34 +17098,41 @@ package body Sem_Ch13 is ------------------------------ procedure Validate_Iterable_Aspect (Typ : Entity_Id; ASN : Node_Id) is + Aggr : constant Node_Id := Expression (ASN); Assoc : Node_Id; Expr : Node_Id; Prim : Node_Id; - Cursor : constant Entity_Id := Get_Cursor_Type (ASN, Typ); + Cursor : Entity_Id; - First_Id : Entity_Id; - Last_Id : Entity_Id; - Next_Id : Entity_Id; - Has_Element_Id : Entity_Id; - Element_Id : Entity_Id; + First_Id : Entity_Id := Empty; + Last_Id : Entity_Id := Empty; + Next_Id : Entity_Id := Empty; + Has_Element_Id : Entity_Id := Empty; + Element_Id : Entity_Id := Empty; begin + if Nkind (Aggr) /= N_Aggregate then + Error_Msg_N ("aspect Iterable must be an aggregate", Aggr); + return; + end if; + + Cursor := Get_Cursor_Type (ASN, Typ); + -- If previous error aspect is unusable if Cursor = Any_Type then return; end if; - First_Id := Empty; - Last_Id := Empty; - Next_Id := Empty; - Has_Element_Id := Empty; - Element_Id := Empty; + if not Is_Empty_List (Expressions (Aggr)) then + Error_Msg_N + ("illegal positional association", First (Expressions (Aggr))); + end if; -- Each expression must resolve to a function with the proper signature - Assoc := First (Component_Associations (Expression (ASN))); + Assoc := First (Component_Associations (Aggr)); while Present (Assoc) loop Expr := Expression (Assoc); Analyze (Expr); diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -10894,7 +10894,7 @@ package body Sem_Util is -- First. Assoc := First (Component_Associations (Expression (Aspect))); - First_Op := Any_Id; + First_Op := Any_Id; while Present (Assoc) loop if Chars (First (Choices (Assoc))) = Name_First then First_Op := Expression (Assoc);