From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 7871) id 332073858C39; Tue, 20 Jun 2023 07:46:06 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 332073858C39 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1687247166; bh=xjPPWOCiNcmbvS4j5GQkpi0cgj70J0fba3W1ZCqVrAU=; h=From:To:Subject:Date:From; b=Qo25lO8O9pgq7PQADgSjFenHybkN/ZSoolGgYbKrnUiSXycXnmHrsLU/T4Pjwr9Ls qlfMDZXshYgiRls6CsDu5ZV2kf5CuEqIDzohm7YhvLLNkjrruy3x8v4U3jzaO1IPLI 9KLOPjHnPpuQ13g/Z9B0EQK7z4mCvXFfUs7NXrXI= MIME-Version: 1.0 Content-Transfer-Encoding: 8bit Content-Type: text/plain; charset="utf-8" From: Marc Poulhi?s To: gcc-cvs@gcc.gnu.org Subject: [gcc r14-1964] ada: Fix type derivation of subtype of derived type X-Act-Checkin: gcc X-Git-Author: =?utf-8?q?Marc_Poulhi=C3=A8s?= X-Git-Refname: refs/heads/master X-Git-Oldrev: 2071134b54aa4f9af01d7d6212dacf7747168448 X-Git-Newrev: ca27b8a030746d09ea61de62e1f3bc1337ebe737 Message-Id: <20230620074606.332073858C39@sourceware.org> Date: Tue, 20 Jun 2023 07:46:06 +0000 (GMT) List-Id: https://gcc.gnu.org/g:ca27b8a030746d09ea61de62e1f3bc1337ebe737 commit r14-1964-gca27b8a030746d09ea61de62e1f3bc1337ebe737 Author: Marc Poulhiès Date: Mon May 22 13:59:05 2023 +0200 ada: Fix type derivation of subtype of derived type Deriving from a subtype of a derived type of a private type, whose full view is itself a derived type of a discriminated record with a known discriminatant was failing with the error message: invalid constraint: type has no discriminant The compiler needs to use the full view to be able to constrain the type. Also fix minor typo in comments. gcc/ada/ * sem_ch3.adb (Build_Derived_Record_Type): Use full view as Parent_Base if needed. Diff: --- gcc/ada/sem_ch3.adb | 36 +++++++++++++++++++++++++++++++++--- 1 file changed, 33 insertions(+), 3 deletions(-) diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index a0677114288..b9302aae2a9 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -5540,7 +5540,7 @@ package body Sem_Ch3 is -- avoided here, when the created subtype declaration is analyzed. (See -- Build_Derived_Types) - -- This also happens when the full view of a private type is derived + -- This also happens when the full view of a private type is a derived -- type with constraints. In this case the entity has been introduced -- in the private declaration. @@ -8669,7 +8669,7 @@ package body Sem_Ch3 is -- 5. FIRST TRANSFORMATION FOR DERIVED RECORDS -- - -- Regardless of whether we dealing with a tagged or untagged type + -- Regardless of whether we are dealing with a tagged or untagged type -- we will transform all derived type declarations of the form -- -- type T is new R (...) [with ...]; @@ -9056,6 +9056,36 @@ package body Sem_Ch3 is Parent_Base := Base_Type (Parent_Base); end if; + -- If the parent base is a private type and only its full view has + -- discriminants, use the full view's base type. + + -- This can happen when we are deriving from a subtype of a derived type + -- of a private type derived from a discriminated type with known + -- discriminant: + -- + -- package Pkg; + -- type Root_Type(I: Positive) is record + -- ... + -- end record; + -- type Bounded_Root_Type is private; + -- private + -- type Bounded_Root_Type is new Root_Type(10); + -- end Pkg; + -- + -- package Pkg2 is + -- type Constrained_Root_Type is new Pkg.Bounded_Root_Type; + -- end Pkg2; + -- subtype Sub_Base is Pkg2.Constrained_Root_Type; + -- type New_Der_Type is new Sub_Base; + + if Is_Private_Type (Parent_Base) + and then Present (Full_View (Parent_Base)) + and then not Has_Discriminants (Parent_Base) + and then Has_Discriminants (Full_View (Parent_Base)) + then + Parent_Base := Base_Type (Full_View (Parent_Base)); + end if; + -- AI05-0115: if this is a derivation from a private type in some -- other scope that may lead to invisible components for the derived -- type, mark it accordingly. @@ -9287,7 +9317,7 @@ package body Sem_Ch3 is Is_Completion => False, Derive_Subps => False); -- ??? This needs re-examination to determine whether the - -- above call can simply be replaced by a call to Analyze. + -- following call can simply be replaced by a call to Analyze. Set_Analyzed (New_Decl);