From patchwork Mon May 16 08:42:58 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Pierre-Marie de Rodat X-Patchwork-Id: 54004 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id CDDE83857407 for ; Mon, 16 May 2022 08:48:39 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org CDDE83857407 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1652690919; bh=lJi3h1WCnxZWvGr1OH3E7zYO6J2naB4cOfvlvg69Eqo=; h=Date:To:Subject:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:Cc:From; b=E8JZsjBHNo+LWXuGJQex8JJ7RV2bZ5WeX/8wpLu2T1qFPVwdAKtQmz/vM7c9Quz4L GYgAikdl5PRF4mUhDtrUyKkBSnm+hp7TnOzFw84JWYwzGvfo3lObTit+mQb2VPVJFR yFjhkpsa4hLHk4lNtUpxFOOoo/8QewStZv8jz3gA= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wr1-x42f.google.com (mail-wr1-x42f.google.com [IPv6:2a00:1450:4864:20::42f]) by sourceware.org (Postfix) with ESMTPS id 85C0D3857419 for ; Mon, 16 May 2022 08:43:00 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 85C0D3857419 Received: by mail-wr1-x42f.google.com with SMTP id u3so19508754wrg.3 for ; Mon, 16 May 2022 01:43:00 -0700 (PDT) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=x-gm-message-state:date:from:to:cc:subject:message-id:mime-version :content-disposition; bh=lJi3h1WCnxZWvGr1OH3E7zYO6J2naB4cOfvlvg69Eqo=; b=8AumhlsxMw43MzCzrKVT1BhcK47UkSlOGxCnNQKsl6X53Pq4pQdGreJP4zhl81Mt9U dujYFiaeF8sMIgapUmu/SKCeOsdt3SUHhiT3LnWpk6xf0SVN6BhIrKp0FPeEW9gPoG1M BfBPmKgKuI1/vkc31zDmo+Y5ndYffawRYGeEDWFk45rCfB7kQEr4vGmxxuGTfSjUegW2 NDXscEOKV7qRvKLD6l2vkNFCiVcP4XMbQO8jUzSwS8M2+8KHHgsTN7d6KcdVQkFvJbOm pyiQ6WfSlF9ysDeTq/XXBQ4Bp+cXofrnogAge9PkpQa2r7F1HOtaNGzrGpAIXjzRBIXv gZVQ== X-Gm-Message-State: AOAM5323+HTsM3qBUvBZtb2dzvPiql822AF8WerP0tBW5FKFMDDdGgdv PXkB84Qd83ibEqLZeew5ovSUJe8jFGdgsg== X-Google-Smtp-Source: ABdhPJyKPg3In2nQUx2YDl41allIoWgjoxEu3KBXf+T4HeNKzFvAZCD+fM053WvWM+Sax6nKUCihaw== X-Received: by 2002:a05:6000:1cd:b0:20a:d7a3:f44 with SMTP id t13-20020a05600001cd00b0020ad7a30f44mr13061157wrx.590.1652690579245; Mon, 16 May 2022 01:42:59 -0700 (PDT) Received: from adacore.com ([45.147.211.82]) by smtp.gmail.com with ESMTPSA id h21-20020a05600c351500b0039454a85a9asm10476193wmq.30.2022.05.16.01.42.58 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 16 May 2022 01:42:58 -0700 (PDT) Date: Mon, 16 May 2022 08:42:58 +0000 To: gcc-patches@gcc.gnu.org Subject: [Ada] Fix spurious error on limited view with incomplete type Message-ID: <20220516084258.GA3843383@adacore.com> 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, KAM_ASCII_DIVIDERS, 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: Pierre-Marie de Rodat via Gcc-patches From: Pierre-Marie de Rodat Reply-To: Pierre-Marie de Rodat Cc: Eric Botcazou Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" The problem is that Install_Limited_With_Clause does not fully implement AI05-0129, in the case where a regular with clause is processed before a limited_with clause of the same package: the visible "shadow" entity is that of the incomplete type, instead of that of the full type per the AI. This requires adjusting Remove_Limited_With_Unit to match the change in Install_Limited_With_Clause and also Build_Incomplete_Type_Declaration, which is responsible for synthesizing incomplete types out of full type declarations for self-referential types. A small tweak is also needed in Analyze_Subprogram_Body_Helper to align it with an equivalent processing for CW types in Find_Type_Name. And the patch also changes the Incomplete_View field in full type declarations to point to the entity of the view instead of its declaration. Tested on x86_64-pc-linux-gnu, committed on trunk gcc/ada/ * exp_ch3.adb (Build_Assignment): Adjust to the new definition of Incomplete_View field. * sem_ch10.ads (Decorate_Type): Declare. * sem_ch10.adb (Decorate_Type): Move to library level. (Install_Limited_With_Clause): In the already analyzed case, also deal with incomplete type declarations present in the sources and simplify the replacement code. (Build_Shadow_Entity): Deal with swapped views in package body. (Restore_Chain_For_Shadow): Deal with incomplete type declarations present in the sources. * sem_ch3.adb (Analyze_Full_Type_Declaration): Adjust to the new definition of Incomplete_View field. (Build_Incomplete_Type_Declaration): Small consistency tweak. Set the incomplete type as the Incomplete_View of the full type. If the scope is a package with a limited view, build a shadow entity for the incomplete type. * sem_ch6.adb (Analyze_Subprogram_Body_Helper): When replacing the limited view of a CW type as designated type of an anonymous access return type, get to the CW type of the incomplete view of the tagged type, if any. (Collect_Primitive_Operations): Adjust to the new definition of Incomplete_View field. * sinfo.ads (Incomplete_View): Denote the entity itself instead of its declaration. * sem_util.adb: Remove call to Defining_Entity. diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -2100,8 +2100,7 @@ package body Exp_Ch3 is and then Present (Incomplete_View (Parent (Rec_Type))) then Append_Elmt ( - N => Defining_Identifier - (Incomplete_View (Parent (Rec_Type))), + N => Incomplete_View (Parent (Rec_Type)), To => Map); Append_Elmt ( N => Defining_Identifier diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -3107,6 +3107,72 @@ package body Sem_Ch10 is end if; end Check_Stub_Level; + ------------------- + -- Decorate_Type -- + ------------------- + + procedure Decorate_Type + (Ent : Entity_Id; + Scop : Entity_Id; + Is_Tagged : Boolean := False; + Materialize : Boolean := False) + is + CW_Typ : Entity_Id; + + begin + -- An unanalyzed type or a shadow entity of a type is treated as an + -- incomplete type, and carries the corresponding attributes. + + Mutate_Ekind (Ent, E_Incomplete_Type); + Set_Etype (Ent, Ent); + Set_Full_View (Ent, Empty); + Set_Is_First_Subtype (Ent); + Set_Scope (Ent, Scop); + Set_Stored_Constraint (Ent, No_Elist); + Reinit_Size_Align (Ent); + + if From_Limited_With (Ent) then + Set_Private_Dependents (Ent, New_Elmt_List); + end if; + + -- A tagged type and its corresponding shadow entity share one common + -- class-wide type. The list of primitive operations for the shadow + -- entity is empty. + + if Is_Tagged then + Set_Is_Tagged_Type (Ent); + Set_Direct_Primitive_Operations (Ent, New_Elmt_List); + + CW_Typ := + New_External_Entity + (E_Void, Scope (Ent), Sloc (Ent), Ent, 'C', 0, 'T'); + + Set_Class_Wide_Type (Ent, CW_Typ); + + -- Set parent to be the same as the parent of the tagged type. + -- We need a parent field set, and it is supposed to point to + -- the declaration of the type. The tagged type declaration + -- essentially declares two separate types, the tagged type + -- itself and the corresponding class-wide type, so it is + -- reasonable for the parent fields to point to the declaration + -- in both cases. + + Set_Parent (CW_Typ, Parent (Ent)); + + Mutate_Ekind (CW_Typ, E_Class_Wide_Type); + Set_Class_Wide_Type (CW_Typ, CW_Typ); + Set_Etype (CW_Typ, Ent); + Set_Equivalent_Type (CW_Typ, Empty); + Set_From_Limited_With (CW_Typ, From_Limited_With (Ent)); + Set_Has_Unknown_Discriminants (CW_Typ); + Set_Is_First_Subtype (CW_Typ); + Set_Is_Tagged_Type (CW_Typ); + Set_Materialize_Entity (CW_Typ, Materialize); + Set_Scope (CW_Typ, Scop); + Reinit_Size_Align (CW_Typ); + end if; + end Decorate_Type; + ------------------------ -- Expand_With_Clause -- ------------------------ @@ -5021,9 +5087,8 @@ package body Sem_Ch10 is -- by the shadow ones. -- This code must be kept synchronized with the code that replaces the - -- shadow entities by the real entities (see body of Remove_Limited - -- With_Clause); otherwise the contents of the homonym chains are not - -- consistent. + -- shadow entities by the real entities in Remove_Limited_With_Unit, + -- otherwise the contents of the homonym chains are not consistent. else -- Hide all the type entities of the public part of the package to @@ -5060,14 +5125,16 @@ package body Sem_Ch10 is and then not Is_Child_Unit (Lim_Typ) then declare + Non_Lim_View : constant Entity_Id := + Non_Limited_View (Lim_Typ); + Prev : Entity_Id; begin Prev := Current_Entity (Lim_Typ); - E := Prev; - -- Replace E in the homonyms list, so that the limited view - -- becomes available. + -- Replace Non_Lim_View in the homonyms list, so that the + -- limited view becomes available. -- If the nonlimited view is a record with an anonymous -- self-referential component, the analysis of the record @@ -5076,31 +5143,53 @@ package body Sem_Ch10 is -- entity is now the incomplete type, and that is the one to -- replace in the visibility structure. - if E = Non_Limited_View (Lim_Typ) + -- Similarly, if the source already contains the incomplete + -- type declaration, the limited view of the incomplete type + -- is in fact never visible (AI05-129) but we have created a + -- shadow entity E1 for it that points to E2, the incomplete + -- type at stake. This in turn has full view E3 that is the + -- full declaration, with a corresponding shadow entity E4. + -- When reinstalling the limited view, the visible entity E2 + -- is first replaced with E1, but E4 must eventually become + -- the visible entity as per the AI and thus displace E1, as + -- it is replacing E3 in the homonyms list. + -- + -- regular views limited views + -- + -- * E2 (incomplete) <-- E1 (shadow) + -- + -- | + -- V + -- + -- E3 (full) <-- E4 (shadow) * + -- + -- [*] denotes the visible entity (Current_Entity) + + if Prev = Non_Lim_View or else - (Ekind (E) = E_Incomplete_Type - and then Full_View (E) = Non_Limited_View (Lim_Typ)) + (Ekind (Prev) = E_Incomplete_Type + and then Full_View (Prev) = Non_Lim_View) + or else + (Ekind (Prev) = E_Incomplete_Type + and then From_Limited_With (Prev) + and then + Ekind (Non_Limited_View (Prev)) = E_Incomplete_Type + and then + Full_View (Non_Limited_View (Prev)) = Non_Lim_View) then - Set_Homonym (Lim_Typ, Homonym (Prev)); Set_Current_Entity (Lim_Typ); else + while Present (Homonym (Prev)) + and then Homonym (Prev) /= Non_Lim_View loop - E := Homonym (Prev); - - -- E may have been removed when installing a previous - -- limited_with_clause. - - exit when No (E); - exit when E = Non_Limited_View (Lim_Typ); Prev := Homonym (Prev); end loop; - if Present (E) then - Set_Homonym (Lim_Typ, Homonym (Homonym (Prev))); - Set_Homonym (Prev, Lim_Typ); - end if; + Set_Homonym (Prev, Lim_Typ); end if; + + Set_Homonym (Lim_Typ, Homonym (Non_Lim_View)); end; if Debug_Flag_I then @@ -5665,7 +5754,7 @@ package body Sem_Ch10 is -- Create a shadow entity that hides Ent and offers an abstract or -- incomplete view of Ent. Scop is the proper scope. Flag Is_Tagged -- should be set when Ent is a tagged type. The generated entity is - -- added to Lim_Header. This routine updates the value of Last_Shadow. + -- added to Shadow_Pack. The routine updates the value of Last_Shadow. procedure Decorate_Package (Ent : Entity_Id; Scop : Entity_Id); -- Perform minimal decoration of a package or its corresponding shadow @@ -5675,17 +5764,6 @@ package body Sem_Ch10 is -- Perform full decoration of an abstract state or its corresponding -- shadow entity denoted by Ent. Scop is the proper scope. - procedure Decorate_Type - (Ent : Entity_Id; - Scop : Entity_Id; - Is_Tagged : Boolean := False; - Materialize : Boolean := False); - -- Perform minimal decoration of a type or its corresponding shadow - -- entity denoted by Ent. Scop is the proper scope. Flag Is_Tagged - -- should be set when Ent is a tagged type. Flag Materialize should be - -- set when Ent is a tagged type and its class-wide type needs to appear - -- in the tree. - procedure Decorate_Variable (Ent : Entity_Id; Scop : Entity_Id); -- Perform minimal decoration of a variable denoted by Ent. Scop is the -- proper scope. @@ -5745,8 +5823,21 @@ package body Sem_Ch10 is Decorate_Package (Shadow, Scop); elsif Is_Type (Ent) then - Decorate_Type (Shadow, Scop, Is_Tagged); - Set_Non_Limited_View (Shadow, Ent); + Decorate_Type (Shadow, Scop, Is_Tagged); + + -- If Ent is a private type and we are analyzing the body of its + -- scope, its private and full views are swapped and, therefore, + -- we need to undo this swapping in order to build the same shadow + -- entity as we would have in other contexts. + + if Is_Private_Type (Ent) + and then Present (Full_View (Ent)) + and then In_Package_Body (Scop) + then + Set_Non_Limited_View (Shadow, Full_View (Ent)); + else + Set_Non_Limited_View (Shadow, Ent); + end if; if Is_Tagged then Set_Non_Limited_View @@ -5786,72 +5877,6 @@ package body Sem_Ch10 is Set_Encapsulating_State (Ent, Empty); end Decorate_State; - ------------------- - -- Decorate_Type -- - ------------------- - - procedure Decorate_Type - (Ent : Entity_Id; - Scop : Entity_Id; - Is_Tagged : Boolean := False; - Materialize : Boolean := False) - is - CW_Typ : Entity_Id; - - begin - -- An unanalyzed type or a shadow entity of a type is treated as an - -- incomplete type, and carries the corresponding attributes. - - Mutate_Ekind (Ent, E_Incomplete_Type); - Set_Etype (Ent, Ent); - Set_Full_View (Ent, Empty); - Set_Is_First_Subtype (Ent); - Set_Scope (Ent, Scop); - Set_Stored_Constraint (Ent, No_Elist); - Reinit_Size_Align (Ent); - - if From_Limited_With (Ent) then - Set_Private_Dependents (Ent, New_Elmt_List); - end if; - - -- A tagged type and its corresponding shadow entity share one common - -- class-wide type. The list of primitive operations for the shadow - -- entity is empty. - - if Is_Tagged then - Set_Is_Tagged_Type (Ent); - Set_Direct_Primitive_Operations (Ent, New_Elmt_List); - - CW_Typ := - New_External_Entity - (E_Void, Scope (Ent), Sloc (Ent), Ent, 'C', 0, 'T'); - - Set_Class_Wide_Type (Ent, CW_Typ); - - -- Set parent to be the same as the parent of the tagged type. - -- We need a parent field set, and it is supposed to point to - -- the declaration of the type. The tagged type declaration - -- essentially declares two separate types, the tagged type - -- itself and the corresponding class-wide type, so it is - -- reasonable for the parent fields to point to the declaration - -- in both cases. - - Set_Parent (CW_Typ, Parent (Ent)); - - Mutate_Ekind (CW_Typ, E_Class_Wide_Type); - Set_Class_Wide_Type (CW_Typ, CW_Typ); - Set_Etype (CW_Typ, Ent); - Set_Equivalent_Type (CW_Typ, Empty); - Set_From_Limited_With (CW_Typ, From_Limited_With (Ent)); - Set_Has_Unknown_Discriminants (CW_Typ); - Set_Is_First_Subtype (CW_Typ); - Set_Is_Tagged_Type (CW_Typ); - Set_Materialize_Entity (CW_Typ, Materialize); - Set_Scope (CW_Typ, Scop); - Reinit_Size_Align (CW_Typ); - end if; - end Decorate_Type; - ----------------------- -- Decorate_Variable -- ----------------------- @@ -6577,6 +6602,10 @@ package body Sem_Ch10 is -- Remove_Shadow_Entities_With_Restore -- ----------------------------------------- + -- This code must be kept synchronized with the code that replaces the + -- real entities by the shadow entities in Install_Limited_With_Clause, + -- otherwise the contents of the homonym chains are not consistent. + procedure Remove_Shadow_Entities_With_Restore (Pack_Id : Entity_Id) is procedure Restore_Chain_For_Shadow (Shadow : Entity_Id); -- Remove shadow entity Shadow by updating the entity and homonym @@ -6599,44 +6628,61 @@ package body Sem_Ch10 is ------------------------------ procedure Restore_Chain_For_Shadow (Shadow : Entity_Id) is - Prev : Entity_Id; - Typ : Entity_Id; + Is_E3 : Boolean; + Prev : Entity_Id; + Typ : Entity_Id; begin -- If the package has incomplete types, the limited view of the -- incomplete type is in fact never visible (AI05-129) but we -- have created a shadow entity E1 for it, that points to E2, - -- a nonlimited incomplete type. This in turn has a full view - -- E3 that is the full declaration. There is a corresponding + -- the incomplete type at stake. This in turn has a full view + -- E3 that is the full declaration, with a corresponding -- shadow entity E4. When reinstalling the nonlimited view, - -- E2 must become the current entity and E3 must be ignored. + -- the nonvisible entity E1 is first replaced with E2, but then + -- E3 must *not* become the visible entity as it is replacing E4 + -- in the homonyms list and simply be ignored. + -- + -- regular views limited views + -- + -- * E2 (incomplete) <-- E1 (shadow) + -- + -- | + -- V + -- + -- E3 (full) <-- E4 (shadow) * + -- + -- [*] denotes the visible entity (Current_Entity) Typ := Non_Limited_View (Shadow); - - -- Shadow is the limited view of a full type declaration that has - -- a previous incomplete declaration, i.e. E3 from the previous - -- description. Nothing to insert. - - if Present (Current_Entity (Typ)) - and then Ekind (Current_Entity (Typ)) = E_Incomplete_Type - and then Full_View (Current_Entity (Typ)) = Typ - then - return; - end if; - pragma Assert (not In_Chain (Typ)); + Is_E3 := Nkind (Parent (Typ)) = N_Full_Type_Declaration + and then Present (Incomplete_View (Parent (Typ))); + Prev := Current_Entity (Shadow); if Prev = Shadow then - Set_Current_Entity (Typ); + if Is_E3 then + Set_Name_Entity_Id (Chars (Prev), Homonym (Prev)); + return; + + else + Set_Current_Entity (Typ); + end if; else - while Present (Prev) and then Homonym (Prev) /= Shadow loop + while Present (Homonym (Prev)) + and then Homonym (Prev) /= Shadow + loop Prev := Homonym (Prev); end loop; - if Present (Prev) then + if Is_E3 then + Set_Homonym (Prev, Homonym (Shadow)); + return; + + else Set_Homonym (Prev, Typ); end if; end if; @@ -6760,9 +6806,6 @@ package body Sem_Ch10 is -- and the previously hidden entities must be entered back into direct -- visibility. - -- WARNING: This code must be kept synchronized with that of routine - -- Install_Limited_Withed_Clause. - if Analyzed (Pack_Decl) then Remove_Shadow_Entities_With_Restore (Pack_Id); diff --git a/gcc/ada/sem_ch10.ads b/gcc/ada/sem_ch10.ads --- a/gcc/ada/sem_ch10.ads +++ b/gcc/ada/sem_ch10.ads @@ -34,6 +34,17 @@ package Sem_Ch10 is procedure Analyze_Protected_Body_Stub (N : Node_Id); procedure Analyze_Subunit (N : Node_Id); + procedure Decorate_Type + (Ent : Entity_Id; + Scop : Entity_Id; + Is_Tagged : Boolean := False; + Materialize : Boolean := False); + -- Perform minimal decoration of a type or its corresponding shadow + -- entity denoted by Ent. Scop is the proper scope. Flag Is_Tagged + -- should be set when Ent is a tagged type. Flag Materialize should be + -- set when Ent is a tagged type and its class-wide type needs to appear + -- in the tree. + procedure Install_Context (N : Node_Id; Chain : Boolean := True); -- Installs the entities from the context clause of the given compilation -- unit into the visibility chains. This is done before analyzing a unit. diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -61,6 +61,7 @@ with Sem_Cat; use Sem_Cat; with Sem_Ch6; use Sem_Ch6; with Sem_Ch7; use Sem_Ch7; with Sem_Ch8; use Sem_Ch8; +with Sem_Ch10; use Sem_Ch10; with Sem_Ch13; use Sem_Ch13; with Sem_Dim; use Sem_Dim; with Sem_Disp; use Sem_Disp; @@ -3158,7 +3159,7 @@ package body Sem_Ch3 is and then Present (Full_View (Prev)) then T := Full_View (Prev); - Set_Incomplete_View (N, Parent (Prev)); + Set_Incomplete_View (N, Prev); else T := Prev; end if; @@ -11600,10 +11601,9 @@ package body Sem_Ch3 is if H = Typ then Set_Name_Entity_Id (Chars (Typ), Homonym (Typ)); + else - while Present (H) - and then Homonym (H) /= Typ - loop + while Present (Homonym (H)) and then Homonym (H) /= Typ loop H := Homonym (Typ); end loop; @@ -11613,16 +11613,48 @@ package body Sem_Ch3 is Insert_Before (Typ_Decl, Decl); Analyze (Decl); Set_Full_View (Inc_T, Typ); + Set_Incomplete_View (Typ_Decl, Inc_T); - if Is_Tagged then - - -- Create a common class-wide type for both views, and set the - -- Etype of the class-wide type to the full view. + -- If the type is tagged, create a common class-wide type for + -- both views, and set the Etype of the class-wide type to the + -- full view. + if Is_Tagged then Make_Class_Wide_Type (Inc_T); Set_Class_Wide_Type (Typ, Class_Wide_Type (Inc_T)); Set_Etype (Class_Wide_Type (Typ), Typ); end if; + + -- If the scope is a package with a limited view, create a shadow + -- entity for the incomplete type like Build_Limited_Views, so as + -- to make it possible for Remove_Limited_With_Unit to reinstall + -- this incomplete type as the visible entity. + + if Ekind (Scope (Inc_T)) = E_Package + and then Present (Limited_View (Scope (Inc_T))) + then + declare + Shadow : constant Entity_Id := Make_Temporary (Loc, 'Z'); + + begin + -- This is modeled on Build_Shadow_Entity + + Set_Chars (Shadow, Chars (Inc_T)); + Set_Parent (Shadow, Decl); + Decorate_Type (Shadow, Scope (Inc_T), Is_Tagged); + Set_Is_Internal (Shadow); + Set_From_Limited_With (Shadow); + Set_Non_Limited_View (Shadow, Inc_T); + Set_Private_Dependents (Shadow, New_Elmt_List); + + if Is_Tagged then + Set_Non_Limited_View + (Class_Wide_Type (Shadow), Class_Wide_Type (Inc_T)); + end if; + + Append_Entity (Shadow, Limited_View (Scope (Inc_T))); + end; + end if; end if; end Build_Incomplete_Type_Declaration; diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -3733,6 +3733,7 @@ package body Sem_Ch6 is procedure Detect_And_Exchange (Id : Entity_Id) is Typ : constant Entity_Id := Etype (Id); + begin if From_Limited_With (Typ) and then Has_Non_Limited_View (Typ) @@ -5189,23 +5190,34 @@ package body Sem_Ch6 is -- is the limited view of a class-wide type and the non-limited view is -- available, update the return type accordingly. - if Ada_Version >= Ada_2005 and then Present (Spec_Id) then + if Ada_Version >= Ada_2005 + and then Present (Spec_Id) + and then Ekind (Etype (Spec_Id)) = E_Anonymous_Access_Type + then declare Etyp : Entity_Id; - Rtyp : Entity_Id; begin - Rtyp := Etype (Spec_Id); + Etyp := Directly_Designated_Type (Etype (Spec_Id)); - if Ekind (Rtyp) = E_Anonymous_Access_Type then - Etyp := Directly_Designated_Type (Rtyp); + if Is_Class_Wide_Type (Etyp) + and then From_Limited_With (Etyp) + and then Has_Non_Limited_View (Etyp) + then + Desig_View := Etyp; + Etyp := Non_Limited_View (Etyp); + + -- If the class-wide type has been created by the completion of + -- an incomplete tagged type declaration, get the class-wide + -- type of the incomplete tagged type to match Find_Type_Name. - if Is_Class_Wide_Type (Etyp) - and then From_Limited_With (Etyp) + if Nkind (Parent (Etyp)) = N_Full_Type_Declaration + and then Present (Incomplete_View (Parent (Etyp))) then - Desig_View := Etyp; - Set_Directly_Designated_Type (Rtyp, Available_View (Etyp)); + Etyp := Class_Wide_Type (Incomplete_View (Parent (Etyp))); end if; + + Set_Directly_Designated_Type (Etype (Spec_Id), Etyp); end if; end; end if; 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 @@ -6475,7 +6475,7 @@ package body Sem_Util is elsif Nkind (Parent (B_Type)) = N_Full_Type_Declaration and then Present (Incomplete_View (Parent (B_Type))) then - Id := Defining_Entity (Incomplete_View (Parent (B_Type))); + Id := Incomplete_View (Parent (B_Type)); -- If T is a derived from a type with an incomplete view declared -- elsewhere, that incomplete view is irrelevant, we want the diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -1536,10 +1536,8 @@ package Sinfo is -- Incomplete_View -- Present in full type declarations that are completions of incomplete - -- type declarations. Denotes the corresponding incomplete type - -- declaration. Used to simplify the retrieval of primitive operations - -- that may be declared between the partial and the full view of an - -- untagged type. + -- type declarations. Denotes the corresponding incomplete view declared + -- by the incomplete declaration. -- Inherited_Discriminant -- This flag is present in N_Component_Association nodes. It indicates