From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 1914) id 8FA553857C6E; Fri, 1 Oct 2021 06:15:32 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 8FA553857C6E MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Type: text/plain; charset="utf-8" From: Pierre-Marie de Rodat To: gcc-cvs@gcc.gnu.org Subject: [gcc r12-4017] [Ada] Assert_Failure on derived type with inherited Default_Initial_Condition X-Act-Checkin: gcc X-Git-Author: Gary Dismukes X-Git-Refname: refs/heads/master X-Git-Oldrev: 698425f5cc85ec83fa17ba08d6da0754ced198f7 X-Git-Newrev: 28c49456b29e6311bd729aed5adac3af045ff739 Message-Id: <20211001061532.8FA553857C6E@sourceware.org> Date: Fri, 1 Oct 2021 06:15:32 +0000 (GMT) X-BeenThere: gcc-cvs@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-cvs mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Fri, 01 Oct 2021 06:15:32 -0000 https://gcc.gnu.org/g:28c49456b29e6311bd729aed5adac3af045ff739 commit r12-4017-g28c49456b29e6311bd729aed5adac3af045ff739 Author: Gary Dismukes Date: Wed Aug 11 16:49:40 2021 -0400 [Ada] Assert_Failure on derived type with inherited Default_Initial_Condition gcc/ada/ * exp_util.adb (Build_DIC_Procedure_Body): Remove inappropriate Assert pragma. Remove unneeded and dead code related to derived private types. Diff: --- gcc/ada/exp_util.adb | 47 +++-------------------------------------------- 1 file changed, 3 insertions(+), 44 deletions(-) diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 7c366663dcb..4a301e20624 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -2035,14 +2035,11 @@ package body Exp_Util is Stmts => Stmts); end if; - -- Otherwise the "full" DIC procedure verifies the DICs of the full - -- view, well as DICs inherited from parent types. In addition, it - -- indirectly verifies the DICs of the partial view by calling the - -- "partial" DIC procedure. + -- Otherwise, the "full" DIC procedure verifies the DICs inherited from + -- parent types, as well as indirectly verifying the DICs of the partial + -- view by calling the "partial" DIC procedure. else - pragma Assert (Present (Full_Typ)); - -- Check the DIC of the partial view by calling the "partial" DIC -- procedure, unless the partial DIC body is empty. Generate: @@ -2056,44 +2053,6 @@ package body Exp_Util is New_Occurrence_Of (Obj_Id, Loc)))); end if; - -- Derived subtypes do not have a partial view - - if Present (Priv_Typ) then - - -- The processing of the "full" DIC procedure intentionally - -- skips the partial view because a) this may result in changes of - -- visibility and b) lead to duplicate checks. However, when the - -- full view is the underlying full view of an untagged derived - -- type whose parent type is private, partial DICs appear on - -- the rep item chain of the partial view only. - - -- package Pack_1 is - -- type Root ... is private; - -- private - -- - -- end Pack_1; - - -- with Pack_1; - -- package Pack_2 is - -- type Child is new Pack_1.Root with Type_DIC => ...; - -- - -- end Pack_2; - - -- As a result, the processing of the full view must also consider - -- all DICs of the partial view. - - if Is_Untagged_Private_Derivation (Priv_Typ, Full_Typ) then - null; - - -- Otherwise the DICs of the partial view are ignored - - else - -- Ignore the DICs of the partial view by eliminating the view - - Priv_Typ := Empty; - end if; - end if; - -- Process inherited Default_Initial_Conditions for all parent types Add_Parent_DICs (Work_Typ, Obj_Id, Stmts);