From patchwork Tue Jun 22 07:22:32 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 56408 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id C580BB6F05 for ; Tue, 22 Jun 2010 17:22:41 +1000 (EST) Received: (qmail 6498 invoked by alias); 22 Jun 2010 07:22:39 -0000 Received: (qmail 6487 invoked by uid 22791); 22 Jun 2010 07:22:38 -0000 X-SWARE-Spam-Status: No, hits=-1.8 required=5.0 tests=AWL, BAYES_00, T_RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from mel.act-europe.fr (HELO mel.act-europe.fr) (212.99.106.210) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Tue, 22 Jun 2010 07:22:31 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id 16A49CB0252; Tue, 22 Jun 2010 09:22:33 +0200 (CEST) Received: from mel.act-europe.fr ([127.0.0.1]) by localhost (smtp.eu.adacore.com [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id maCEKhPAAfiX; Tue, 22 Jun 2010 09:22:33 +0200 (CEST) Received: from saumur.act-europe.fr (saumur.act-europe.fr [10.10.0.183]) by mel.act-europe.fr (Postfix) with ESMTP id 041F0CB024F; Tue, 22 Jun 2010 09:22:33 +0200 (CEST) Received: by saumur.act-europe.fr (Postfix, from userid 525) id E026FD9B31; Tue, 22 Jun 2010 09:22:32 +0200 (CEST) Date: Tue, 22 Jun 2010 09:22:32 +0200 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Thomas Quinot Subject: [Ada] Record original expression associated with actual subtypes Message-ID: <20100622072232.GA20203@adacore.com> Mime-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.9i X-IsSubscribed: yes Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org This change adds information to subtypes created by Build_Actual_Subtype to allow code analysis tools to retrieve the original expression. Tested on x86_64-pc-linux-gnu, committed on trunk 2010-06-22 Thomas Quinot * sem_util.adb (Build_Actual_Subtype): Record original expression in Related_Expression attribute of the constructed subtype. * einfo.adb, einfo.ads (Underlying_View): Move to Node28 to free up Node24 on types for... (Related_Expression): Make attribute available on types as well. Index: einfo.adb =================================================================== --- einfo.adb (revision 161073) +++ einfo.adb (working copy) @@ -208,7 +208,6 @@ package body Einfo is -- Related_Expression Node24 -- Spec_PPC_List Node24 - -- Underlying_Record_View Node24 -- Interface_Alias Node25 -- Interfaces Elist25 @@ -228,6 +227,7 @@ package body Einfo is -- Wrapped_Entity Node27 -- Extra_Formals Node28 + -- Underlying_Record_View Node28 --------------------------------------------- -- Usage of Flags in Defining Entity Nodes -- @@ -2434,7 +2434,8 @@ package body Einfo is function Related_Expression (Id : E) return N is begin - pragma Assert (Ekind_In (Id, E_Constant, E_Variable)); + pragma Assert (Is_Type (Id) + or else Ekind_In (Id, E_Constant, E_Variable)); return Node24 (Id); end Related_Expression; @@ -2656,7 +2657,7 @@ package body Einfo is function Underlying_Record_View (Id : E) return E is begin - return Node24 (Id); + return Node28 (Id); end Underlying_Record_View; function Universal_Aliasing (Id : E) return B is @@ -2938,6 +2939,12 @@ package body Einfo is -- Attribute Set Procedures -- ------------------------------ + -- Note: in many of these set procedures an "obvious" assertion is missing. + -- The reason for this is that in many cases, a field is set before the + -- Ekind field is set, so that the field is set when Ekind = E_Void. It + -- it is possible to add assertions that specifically include the E_Void + -- possibility, but in some cases, we just omit the assertions. + procedure Set_Accept_Address (Id : E; V : L) is begin Set_Elist21 (Id, V); @@ -5114,7 +5121,7 @@ package body Einfo is procedure Set_Underlying_Record_View (Id : E; V : E) is begin pragma Assert (Ekind (Id) = E_Record_Type); - Set_Node24 (Id, V); + Set_Node28 (Id, V); end Set_Underlying_Record_View; procedure Set_Universal_Aliasing (Id : E; V : B := True) is @@ -7894,14 +7901,11 @@ package body Einfo is when Subprogram_Kind => Write_Str ("Spec_PPC_List"); - when E_Record_Type => - Write_Str ("Underlying_Record_View"); - - when E_Variable | E_Constant => + when E_Variable | E_Constant | Type_Kind => Write_Str ("Related_Expression"); when others => - Write_Str ("???"); + Write_Str ("Field24???"); end case; end Write_Field24_Name; @@ -8005,6 +8009,9 @@ package body Einfo is when E_Procedure | E_Function | E_Entry => Write_Str ("Extra_Formals"); + when E_Record_Type => + Write_Str ("Underlying_Record_View"); + when others => Write_Str ("Field28??"); end case; Index: einfo.ads =================================================================== --- einfo.ads (revision 161073) +++ einfo.ads (working copy) @@ -3244,9 +3244,13 @@ package Einfo is -- only for type-related error messages. -- Related_Expression (Node24) --- Present in variables generated internally. Denotes the source --- expression whose elaboration created the variable declaration. --- Used for clearer messages from CodePeer. +-- Present in variables and types. Set only for internally generated +-- entities, where it may be used to denote the source expression whose +-- elaboration created the variable declaration. If set, it is used +-- for generating clearer messages from CodePeer. +-- +-- Shouldn't it also be used for the same purpose in errout? It seems +-- odd to have two mechanisms here??? -- Related_Instance (Node15) -- Present in the wrapper packages created for subprogram instances. @@ -3539,12 +3543,13 @@ package Einfo is -- value may be passed around, and if used, may clobber a local variable. -- Task_Body_Procedure (Node25) --- Present in task types and subtypes. Points to the entity for --- the task body procedure (as further described in Exp_Ch9, task --- bodies are expanded into procedures). A convenient function to --- retrieve this field is Sem_Util.Get_Task_Body_Procedure. --- The last sentence is odd ??? Why not have Task_Body_Procedure --- go to the Underlying_Type of the Root_Type??? +-- Present in task types and subtypes. Points to the entity for the task +-- task body procedure (as further described in Exp_Ch9, task bodies are +-- expanded into procedures). A convenient function to retrieve this +-- field is Sem_Util.Get_Task_Body_Procedure. +-- +-- The last sentence is odd??? Why not have Task_Body_Procedure go to the +-- Underlying_Type of the Root_Type??? -- Treat_As_Volatile (Flag41) -- Present in all type entities, and also in constants, components and @@ -3591,7 +3596,7 @@ package Einfo is -- private completion. If Td is already constrained, then its full view -- can serve directly as the full view of T. --- Underlying_Record_View (Node24) +-- Underlying_Record_View (Node28) -- Present in record types. Set for record types that are extensions of -- types with unknown discriminants, and also set for internally built -- underlying record views to reference its original record type. Record @@ -4599,6 +4604,7 @@ package Einfo is -- Esize (Uint12) -- RM_Size (Uint13) -- Alignment (Uint14) + -- Related_Expression (Node24) -- Depends_On_Private (Flag14) -- Discard_Names (Flag88) @@ -5290,8 +5296,8 @@ package Einfo is -- Discriminant_Constraint (Elist21) -- Corresponding_Remote_Type (Node22) -- Stored_Constraint (Elist23) - -- Underlying_Record_View (Node24) (base type only) -- Interfaces (Elist25) + -- Underlying_Record_View (Node28) (base type only) -- Component_Alignment (special) (base type only) -- C_Pass_By_Copy (Flag125) (base type only) -- Has_Dispatch_Table (Flag220) (base tagged type only) Index: sem_util.adb =================================================================== --- sem_util.adb (revision 161135) +++ sem_util.adb (working copy) @@ -398,7 +398,7 @@ package body Sem_Util is end loop; end if; - Subt := Make_Temporary (Loc, 'S'); + Subt := Make_Temporary (Loc, 'S', Related_Node => N); Set_Is_Internal (Subt); Decl :=