From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 7871) id 083053858418; Tue, 8 Nov 2022 08:40:22 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 083053858418 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1667896823; bh=6bVLdbWgSK9PyKJDz4Q80e7AejTbAIQsFEbn2HIPNHU=; h=From:To:Subject:Date:From; b=PlhjbXUqzbsAzuVaEz1yJv7UYR3Q30l5wl039Y56KDR6q16wqYPDZpPNlQFCYSvAR cRStpUZGgZdW/OrAet2Q4tv8Ik1PRDVB0Exv7iblI1C6dLEfFv9lHXsPgbe1r3Oam7 ZV78/SS7/1PAzyzODQo9CC9lJ75k0QVqDyq6zeVY= MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Type: text/plain; charset="utf-8" From: Marc Poulhi?s To: gcc-cvs@gcc.gnu.org Subject: [gcc r13-3776] ada: Raise Tag_Error when Ada.Tags operations are called with No_Tag X-Act-Checkin: gcc X-Git-Author: Piotr Trojanek X-Git-Refname: refs/heads/master X-Git-Oldrev: ae5de5a32798995bcc61099f3021ac28e8614bea X-Git-Newrev: 59dd07ef2534c00f0144431bf54d8219ebb91218 Message-Id: <20221108084023.083053858418@sourceware.org> Date: Tue, 8 Nov 2022 08:40:22 +0000 (GMT) List-Id: https://gcc.gnu.org/g:59dd07ef2534c00f0144431bf54d8219ebb91218 commit r13-3776-g59dd07ef2534c00f0144431bf54d8219ebb91218 Author: Piotr Trojanek Date: Tue Oct 18 14:31:00 2022 +0200 ada: Raise Tag_Error when Ada.Tags operations are called with No_Tag Implement missing behavior of RM 13.9 (25.1/3): Tag_Error is raised by a call of Interface_Ancestor_Tags and Is_Descendant_At_Same_Level, if any tag passed is No_Tag. This change also fixes Descendant_Tag, which relies on Is_Descendant_At_Same_Level. The remaining operations already worked properly. gcc/ada/ * libgnat/a-tags.adb (Interface_Ancestor_Tags): Raise Tag_Error on No_Tag. (Is_Descendant_At_Same_Level): Likewise. Diff: --- gcc/ada/libgnat/a-tags.adb | 22 +++++++++++++++------- 1 file changed, 15 insertions(+), 7 deletions(-) diff --git a/gcc/ada/libgnat/a-tags.adb b/gcc/ada/libgnat/a-tags.adb index d663a41f5a8..a9af942fc64 100644 --- a/gcc/ada/libgnat/a-tags.adb +++ b/gcc/ada/libgnat/a-tags.adb @@ -554,13 +554,18 @@ package body Ada.Tags is ----------------------------- function Interface_Ancestor_Tags (T : Tag) return Tag_Array is - TSD_Ptr : constant Addr_Ptr := - To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size); - TSD : constant Type_Specific_Data_Ptr := - To_Type_Specific_Data_Ptr (TSD_Ptr.all); - Iface_Table : constant Interface_Data_Ptr := TSD.Interfaces_Table; - + TSD_Ptr : Addr_Ptr; + TSD : Type_Specific_Data_Ptr; + Iface_Table : Interface_Data_Ptr; begin + if T = No_Tag then + raise Tag_Error; + end if; + + TSD_Ptr := To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size); + TSD := To_Type_Specific_Data_Ptr (TSD_Ptr.all); + Iface_Table := TSD.Interfaces_Table; + if Iface_Table = null then declare Table : Tag_Array (1 .. 0); @@ -731,7 +736,10 @@ package body Ada.Tags is Ancestor : Tag) return Boolean is begin - if Descendant = Ancestor then + if Descendant = No_Tag or else Ancestor = No_Tag then + raise Tag_Error; + + elsif Descendant = Ancestor then return True; else