public inbox for gcc-cvs@sourceware.org help / color / mirror / Atom feed
From: Pierre-Marie de Rodat <pmderodat@gcc.gnu.org> To: gcc-cvs@gcc.gnu.org Subject: [gcc r13-601] [Ada] Crash building VSS with compiler built with assertions Date: Wed, 18 May 2022 08:44:18 +0000 (GMT) [thread overview] Message-ID: <20220518084418.6D900385782C@sourceware.org> (raw) https://gcc.gnu.org/g:ddb82555b422eb175471a3f4df40b27f872ce9bf commit r13-601-gddb82555b422eb175471a3f4df40b27f872ce9bf Author: Javier Miranda <miranda@adacore.com> Date: Fri Apr 1 22:12:05 2022 +0000 [Ada] Crash building VSS with compiler built with assertions When a tagged type T has aspect String_Literal, a derived type defines a null extension T2, and the context to resolve the use of an object of type T2 where the string literal is applicable is a class-wide type the frontend crashes trying to evaluate if the object is a null extension. This problem does not reproduce when the compiler is built with assertions disabled. gcc/ada/ * sem_ch6.adb (Find_Corresponding_Spec): Avoid calling Is_Null_Extension with a class-wide type entity. (Overrides_Visible_Function): Handle alias entities. * sem_res.adb (Has_Applicable_User_Defined_Literal): Conversion not needed if the result type of the call is class-wide or if the result type matches the context type. * sem_util.ads (Is_Null_Extension): Adding documentation. (Is_Null_Extension_Of): Adding documentation. * sem_util.adb (Is_Null_Extension): Adding assertion. (Is_Null_Extension_Of): Adding assertions. Diff: --- gcc/ada/sem_ch6.adb | 6 ++++-- gcc/ada/sem_res.adb | 7 ++++++- gcc/ada/sem_util.adb | 5 +++++ gcc/ada/sem_util.ads | 2 ++ 4 files changed, 17 insertions(+), 3 deletions(-) diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index c9e57e95b10..a5373583207 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -9867,7 +9867,8 @@ package body Sem_Ch6 is and then Ada_Version >= Ada_2005 and then not Comes_From_Source (E) and then Has_Controlling_Result (E) - and then Is_Null_Extension (Etype (E)) + and then (not Is_Class_Wide_Type (Etype (E)) + and then Is_Null_Extension (Etype (E))) and then Comes_From_Source (Spec) then Set_Has_Completion (E, False); @@ -11265,7 +11266,8 @@ package body Sem_Ch6 is function Overrides_Private_Part_Op return Boolean is Over_Decl : constant Node_Id := - Unit_Declaration_Node (Overridden_Operation (S)); + Unit_Declaration_Node + (Ultimate_Alias (Overridden_Operation (S))); Subp_Decl : constant Node_Id := Unit_Declaration_Node (S); begin diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 33f445d69b9..060fcfc5508 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -559,7 +559,12 @@ package body Sem_Res is Set_Etype (Call, Etype (Callee)); - if Base_Type (Etype (Call)) /= Base_Type (Typ) then + -- Conversion not needed if the result type of the call is class-wide + -- or if the result type matches the context type. + + if not Is_Class_Wide_Type (Typ) + and then Base_Type (Etype (Call)) /= Base_Type (Typ) + then -- Conversion may be needed in case of an inherited -- aspect of a derived type. For a null extension, we -- use a null extension aggregate instead because the diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index a059d1eb933..762fe48d1c9 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -19279,6 +19279,8 @@ package body Sem_Util is Type_Decl : Node_Id; Type_Def : Node_Id; begin + pragma Assert (not Is_Class_Wide_Type (T)); + if Ignore_Privacy then Type_Decl := Parent (Underlying_Type (Base_Type (T))); else @@ -19311,7 +19313,10 @@ package body Sem_Util is := Underlying_Type (Base_Type (Ancestor)); Descendant_Type : Entity_Id := Underlying_Type (Base_Type (Descendant)); begin + pragma Assert (not Is_Class_Wide_Type (Descendant)); + pragma Assert (not Is_Class_Wide_Type (Ancestor)); pragma Assert (Descendant_Type /= Ancestor_Type); + while Descendant_Type /= Ancestor_Type loop if not Is_Null_Extension (Descendant_Type, Ignore_Privacy => True) diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 6f28fe0b652..b6c70ca2300 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -2209,12 +2209,14 @@ package Sem_Util is -- Given a tagged type, returns True if argument is a type extension -- that introduces no new components (discriminant or nondiscriminant). -- Ignore_Privacy should be True for use in implementing dynamic semantics. + -- Cannot be called with class-wide types. function Is_Null_Extension_Of (Descendant, Ancestor : Entity_Id) return Boolean; -- Given two tagged types, the first a descendant of the second, -- returns True if every component of Descendant is inherited -- (directly or indirectly) from Ancestor. Privacy is ignored. + -- Cannot be called with class-wide types. function Is_Null_Record_Definition (Record_Def : Node_Id) return Boolean; -- Returns True for an N_Record_Definition node that has no user-defined
reply other threads:[~2022-05-18 8:44 UTC|newest] Thread overview: [no followups] expand[flat|nested] mbox.gz Atom feed
Reply instructions: You may reply publicly to this message via plain-text email using any one of the following methods: * Save the following mbox file, import it into your mail client, and reply-to-all from there: mbox Avoid top-posting and favor interleaved quoting: https://en.wikipedia.org/wiki/Posting_style#Interleaved_style * Reply using the --to, --cc, and --in-reply-to switches of git-send-email(1): git send-email \ --in-reply-to=20220518084418.6D900385782C@sourceware.org \ --to=pmderodat@gcc.gnu.org \ --cc=gcc-cvs@gcc.gnu.org \ /path/to/YOUR_REPLY https://kernel.org/pub/software/scm/git/docs/git-send-email.html * If your mail client supports setting the In-Reply-To header via mailto: links, try the mailto: linkBe sure your reply has a Subject: header at the top and a blank line before the message body.
This is a public inbox, see mirroring instructions for how to clone and mirror all data and code used for this inbox; as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).