From patchwork Mon Aug 1 10:28:04 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 107713 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 D5BF8B6F8E for ; Mon, 1 Aug 2011 20:28:41 +1000 (EST) Received: (qmail 1159 invoked by alias); 1 Aug 2011 10:28:36 -0000 Received: (qmail 1124 invoked by uid 22791); 1 Aug 2011 10:28:30 -0000 X-SWARE-Spam-Status: No, hits=-2.1 required=5.0 tests=AWL, BAYES_00, RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from mel.act-europe.fr (HELO mel.act-europe.fr) (194.98.77.210) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Mon, 01 Aug 2011 10:28:13 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id 9737BCB021A; Mon, 1 Aug 2011 12:28:11 +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 RHHaTyqM2Jhw; Mon, 1 Aug 2011 12:28:01 +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 61663CB01E5; Mon, 1 Aug 2011 12:28:01 +0200 (CEST) Received: by saumur.act-europe.fr (Postfix, from userid 525) id 4799E245242; Mon, 1 Aug 2011 12:28:04 +0200 (CEST) Date: Mon, 1 Aug 2011 12:28:04 +0200 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Robert Dewar Subject: [Ada] Visibility check for aspects, part 1 Message-ID: <20110801102804.GA5292@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 patch implements the consistent visibility check for enties with delayed aspects that are frozen early, as shown by the tests below. This step covers all aspects except Invariant and Predicate, which will be taken care of separately. 1. pragma Ada_2012; 2. package AspectVis is 3. R_Size : constant Integer := 32; 4. 5. package Inner is 6. type R is new Integer with 7. Size => R_Size; | >>> visibility of aspect for "R" changes after freeze point 8. F : R; -- freezes | >>> info: "R" is frozen here, aspects evaluated at this point 9. R_Size : constant Integer := 64; 10. S : constant Integer := R'Size; -- 32 not 64 11. end Inner; 12. end AspectVis; 1. pragma Ada_2012; 2. package AspectVis2 is 3. R_Size : constant Integer := 32; 4. 5. package Inner is 6. type R is new Integer with 7. Size => R_Size; 1 2 >>> visibility of aspect for "R" changes after freeze point >>> expected type "Standard.Integer" >>> found type "Standard.Float" 8. F : R; -- freezes | >>> info: "R" is frozen here, aspects evaluated at this point 9. R_Size : constant Float := 64.0; 10. S : constant Integer := R'Size; -- 32 not 64 11. end Inner; 12. end AspectVis2; Tested on x86_64-pc-linux-gnu, committed on trunk 2011-08-01 Robert Dewar * freeze.adb (Freeze_Entity): Call Check_Aspect_At_Freeze_Point (Freeze_All): Call Check_Aspect_At_End_Of_Declarations * sem_ch13.ads, sem_ch13.adb (Check_Aspect_At_Freeze_Point): New procedure. (Check_Aspect_At_End_Of_Declarations): New procedure (Analye_Aspect_Specification): Minor changes for above procedures * sinfo.ads, sinfo.adb (Is_Delayed_Aspect): Now set in aspect specification node as well. Index: sinfo.adb =================================================================== --- sinfo.adb (revision 177005) +++ sinfo.adb (working copy) @@ -1732,6 +1732,7 @@ (N : Node_Id) return Boolean is begin pragma Assert (False + or else NT (N).Nkind = N_Aspect_Specification or else NT (N).Nkind = N_Attribute_Definition_Clause or else NT (N).Nkind = N_Pragma); return Flag14 (N); @@ -4760,6 +4761,7 @@ (N : Node_Id; Val : Boolean := True) is begin pragma Assert (False + or else NT (N).Nkind = N_Aspect_Specification or else NT (N).Nkind = N_Attribute_Definition_Clause or else NT (N).Nkind = N_Pragma); Set_Flag14 (N, Val); Index: sinfo.ads =================================================================== --- sinfo.ads (revision 177005) +++ sinfo.ads (working copy) @@ -1265,7 +1265,8 @@ -- Is_Delayed_Aspect (Flag14-Sem) -- Present in N_Pragma and N_Attribute_Definition_Clause nodes which -- come from aspect specifications, where the evaluation of the aspect - -- must be delayed to the freeze point. + -- must be delayed to the freeze point. This flag is also set True in + -- the corresponding N_Aspect_Specification node. -- Is_Controlling_Actual (Flag16-Sem) -- This flag is set on in an expression that is a controlling argument in @@ -6548,9 +6549,17 @@ -- Next_Rep_Item (Node5-Sem) -- Split_PPC (Flag17) Set if split pre/post attribute -- Is_Boolean_Aspect (Flag16-Sem) + -- Is_Delayed_Aspect (Flag14-Sem) -- Note: Aspect_Specification is an Ada 2012 feature + -- Note: The Identifier serves to identify the aspect involved (it + -- is the aspect whose name corresponds to the Chars field). This + -- means that the other fields of this identifier are unused, and + -- in particular we use the Entity field of this identifier to save + -- a copy of the expression for visibility analysis, see spec of + -- Sem_Ch13 for full details of this usage. + -- Note: When a Pre or Post aspect specification is processed, it is -- broken into AND THEN sections. The left most section has Split_PPC -- set to False, indicating that it is the original specification (e.g. Index: freeze.adb =================================================================== --- freeze.adb (revision 177005) +++ freeze.adb (working copy) @@ -1323,6 +1323,27 @@ if not Is_Frozen (E) then Flist := Freeze_Entity (E, After); Process_Flist; + + -- If already frozen, and there are delayed aspects, this is where + -- we do the visibility check for these aspects (see Sem_Ch13 spec + -- for a description of how we handle aspect visibility). + + elsif Has_Delayed_Aspects (E) then + declare + Ritem : Node_Id; + + begin + Ritem := First_Rep_Item (E); + while Present (Ritem) loop + if Nkind (Ritem) = N_Aspect_Specification + and then Is_Delayed_Aspect (Ritem) + then + Check_Aspect_At_End_Of_Declarations (Ritem); + end if; + + Ritem := Next_Rep_Item (Ritem); + end loop; + end; end if; -- If an incomplete type is still not frozen, this may be a @@ -2390,9 +2411,9 @@ while Present (Ritem) loop if Nkind (Ritem) = N_Aspect_Specification and then Entity (Ritem) = E + and then Is_Delayed_Aspect (Ritem) then Aitem := Aspect_Rep_Item (Ritem); - pragma Assert (Is_Delayed_Aspect (Aitem)); Set_Parent (Aitem, Ritem); -- Deal with Boolean case, if no expression, True, otherwise @@ -2423,6 +2444,10 @@ -- Analyze the pragma after possibly setting Aspect_Cancel Analyze (Aitem); + + -- Do visibility analysis for aspect at freeze point + + Check_Aspect_At_Freeze_Point (Ritem); end if; Next_Rep_Item (Ritem); Index: sem_ch13.adb =================================================================== --- sem_ch13.adb (revision 177005) +++ sem_ch13.adb (working copy) @@ -700,11 +700,10 @@ -- one of two things happens: -- If we are required to delay the evaluation of this aspect to the - -- freeze point, we preanalyze the relevant argument, and then attach - -- the corresponding pragma/attribute definition clause to the aspect - -- specification node, which is then placed in the Rep Item chain. - -- In this case we mark the entity with the Has_Delayed_Aspects flag, - -- and we evaluate the rep item at the freeze point. + -- freeze point, we attach the corresponding pragma/attribute definition + -- clause to the aspect specification node, which is then placed in the + -- Rep Item chain. In this case we mark the entity by setting the flag + -- Has_Delayed_Aspects and we evaluate the rep item at the freeze point. -- If no delay is required, we just insert the pragma or attribute -- after the declaration, and it will get processed by the normal @@ -800,6 +799,11 @@ Next (Anod); end loop; + -- Copy expression for later processing by the procedures + -- Check_Aspect_At_[Freeze_Point | End_Of_Declarations] + + Set_Entity (Id, New_Copy_Tree (Expr)); + -- Processing based on specific aspect case A_Id is @@ -836,6 +840,7 @@ else Delay_Required := True; + Set_Is_Delayed_Aspect (Aspect); end if; -- Aspects corresponding to attribute definition clauses @@ -868,6 +873,7 @@ -- Here a delay is required Delay_Required := True; + Set_Is_Delayed_Aspect (Aspect); -- Aspects corresponding to pragmas with two arguments, where -- the first argument is a local name referring to the entity, @@ -981,6 +987,7 @@ end if; Set_From_Aspect_Specification (Aitem, True); + Set_Is_Delayed_Aspect (Aspect); -- For Pre/Post cases, insert immediately after the entity -- declaration, since that is the required pragma placement. @@ -1032,6 +1039,7 @@ end if; Set_From_Aspect_Specification (Aitem, True); + Set_Is_Delayed_Aspect (Aspect); -- For Invariant case, insert immediately after the entity -- declaration. We do not have to worry about delay issues @@ -1065,6 +1073,7 @@ -- have a place to build the predicate function). Ensure_Freeze_Node (E); + Set_Is_Delayed_Aspect (Aspect); -- For Predicate case, insert immediately after the entity -- declaration. We do not have to worry about delay issues @@ -4850,6 +4859,161 @@ return; end Build_Static_Predicate; + ----------------------------------------- + -- Check_Aspect_At_End_Of_Declarations -- + ----------------------------------------- + + procedure Check_Aspect_At_End_Of_Declarations (ASN : Node_Id) is + Ent : constant Entity_Id := Entity (ASN); + Ident : constant Node_Id := Identifier (ASN); + + Freeze_Expr : constant Node_Id := Expression (ASN); + -- Preanalyzed expression from call to Check_Aspect_At_Freeze_Point + + End_Decl_Expr : constant Node_Id := Entity (Ident); + -- Expression to be analyzed at end of declarations + + T : constant Entity_Id := Etype (Freeze_Expr); + -- Type required for preanalyze call + + A_Id : constant Aspect_Id := Get_Aspect_Id (Chars (Ident)); + + Err : Boolean; + -- Set False if error + + -- On entry to this procedure, Entity (Ident) contains a copy of the + -- original expression from the aspect, saved for this purpose, and + -- but Expression (Ident) is a preanalyzed copy of the expression, + -- preanalyzed just after the freeze point. + + begin + -- Case of stream attributes, just have to compare entities + + if A_Id = Aspect_Input or else + A_Id = Aspect_Output or else + A_Id = Aspect_Read or else + A_Id = Aspect_Write + then + Analyze (End_Decl_Expr); + Err := Entity (End_Decl_Expr) /= Entity (Freeze_Expr); + + -- All other cases + + else + Preanalyze_Spec_Expression (End_Decl_Expr, T); + Err := not Fully_Conformant_Expressions (End_Decl_Expr, Freeze_Expr); + end if; + + -- Output error message if error + + if Err then + Error_Msg_NE + ("visibility of aspect for& changes after freeze point", + ASN, Ent); + Error_Msg_NE + ("?info: & is frozen here, aspects evaluated at this point", + Freeze_Node (Ent), Ent); + end if; + end Check_Aspect_At_End_Of_Declarations; + + ---------------------------------- + -- Check_Aspect_At_Freeze_Point -- + ---------------------------------- + + procedure Check_Aspect_At_Freeze_Point (ASN : Node_Id) is + Ident : constant Node_Id := Identifier (ASN); + -- Identifier (use Entity field to save expression) + + T : Entity_Id; + -- Type required for preanalyze call + + A_Id : constant Aspect_Id := Get_Aspect_Id (Chars (Ident)); + + begin + -- On entry to this procedure, Entity (Ident) contains a copy of the + -- original expression from the aspect, saved for this purpose. + + -- On exit from this procedure Entity (Ident) is unchanged, still + -- containing that copy, but Expression (Ident) is a preanalyzed copy + -- of the expression, preanalyzed just after the freeze point. + + -- Make a copy of the expression to be preanalyed + + Set_Expression (ASN, New_Copy_Tree (Entity (Ident))); + + -- Find type for preanalyze call + + case A_Id is + + -- No_Aspect should be impossible + + when No_Aspect => + raise Program_Error; + + -- Aspects taking an optional boolean argument. Note that we will + -- never be called with an empty expression, because such aspects + -- never need to be delayed anyway. + + when Boolean_Aspects => + pragma Assert (Present (Expression (ASN))); + T := Standard_Boolean; + + -- Aspects corresponding to attribute definition clauses + + when Aspect_Address => + T := RTE (RE_Address); + + when Aspect_Bit_Order => + T := RTE (RE_Bit_Order); + + when Aspect_External_Tag => + T := Standard_String; + + when Aspect_Storage_Pool => + T := Class_Wide_Type (RTE (RE_Root_Storage_Pool)); + + when + Aspect_Alignment | + Aspect_Component_Size | + Aspect_Machine_Radix | + Aspect_Object_Size | + Aspect_Size | + Aspect_Storage_Size | + Aspect_Stream_Size | + Aspect_Value_Size => + T := Any_Integer; + + -- Stream attribute. Special case, the expression is just an entity + -- that does not need any resolution, so just analyze. + + when Aspect_Input | + Aspect_Output | + Aspect_Read | + Aspect_Write => + Analyze (Expression (ASN)); + return; + + -- Suppress/Unsupress/Warnings should never be delayed + + when Aspect_Suppress | + Aspect_Unsuppress | + Aspect_Warnings => + raise Program_Error; + + -- Pre/Post/Invariant/Predicate take boolean expressions + + when Aspect_Pre | + Aspect_Post | + Aspect_Invariant | + Aspect_Predicate => + T := Standard_Boolean; + end case; + + -- Do the preanalyze call + + Preanalyze_Spec_Expression (Expression (ASN), T); + end Check_Aspect_At_Freeze_Point; + ----------------------------------- -- Check_Constant_Address_Clause -- ----------------------------------- Index: sem_ch13.ads =================================================================== --- sem_ch13.ads (revision 176998) +++ sem_ch13.ads (working copy) @@ -236,4 +236,81 @@ Table_Increment => 200, Table_Name => "Independence_Checks"); + ----------------------------------- + -- Handling of Aspect Visibility -- + ----------------------------------- + + -- The visibility of aspects is tricky. First, the visibility is delayed + -- to the freeze point. This is not too complicated, what we do is simply + -- to leave the aspect "laying in wait" for the freeze point, and at that + -- point materialize and analye the corresponding attribute definition + -- clause or pragma. There is some special processing for preconditions + -- and postonditions, where the pragmas themselves deal with the required + -- delay, but basically the approach is the same, delay analysis of the + -- expression to the freeze point. + + -- Much harder is the requirement for diagnosing cases in which an early + -- freeze causes a change in visibility. Consider: + + -- package AspectVis is + -- R_Size : constant Integer := 32; + -- + -- package Inner is + -- type R is new Integer with + -- Size => R_Size; + -- F : R; -- freezes + -- R_Size : constant Integer := 64; + -- S : constant Integer := R'Size; -- 32 not 64 + -- end Inner; + -- end AspectVis; + + -- Here the 32 not 64 shows what would be expected if this program were + -- legal, since the evaluation of R_Size has to be done at the freeze + -- point and gets the outer definition not the inner one. + + -- But the language rule requires this program to be diagnosed as illegal + -- because the visibility changes between the freeze point and the end of + -- the declarative region. + + -- To meet this requirement, we first note that the Expression field of the + -- N_Aspect_Specification node holds the raw unanalyzed expression, which + -- will get used in processing the aspect. At the time of analyzing the + -- N_Aspect_Specification node, we create a complete copy of the expression + -- and store it in the entity field of the Identifier (an odd usage, but + -- the identifier is not used except to identify the aspect, so its Entity + -- field is otherwise unused, and we are short of room in the node). + + -- This copy stays unanalyzed up to the freeze point, where we analyze the + -- resulting pragma or attribute definition clause, except that in the + -- case of invariants and predicates, we mark occurrences of the subtype + -- name as having the entity of the subprogram parameter, so that they + -- will not cause trouble in the following steps. + + -- Then at the freeze point, we create another copy of this unanalyzed + -- expression. By this time we no longer need the Expression field for + -- other purposes, so we can store it there. Now we have two copies of + -- the original unanalyzed expression. One of them gets preanalyzed at + -- the freeze point to capture the visibility at the freeze point. + + -- Now when we hit the freeze all at the end of the declarative part, if + -- we come across a frozen entity with delayed aspects, we still have one + -- copy of the unanalyzed expression available in the node, and we again + -- do a preanalysis using that copy and the visibility at the end of the + -- declarative part. Now we have two preanalyzed expression (preanalysis + -- is good enough, since we are only interested in referenced entities). + -- One captures the visibility at the freeze point, the other captures the + -- visibility at the end of the declarative part. We see if the entities + -- in these two expressions are the same, by seeing if the two expressions + -- are fully conformant, and if not, issue appropriate error messages. + + -- Quite an awkward procedure, but this is an awkard requirement! + + procedure Check_Aspect_At_Freeze_Point (ASN : Node_Id); + -- Performs the processing described above at the freeze point, ASN is the + -- N_Aspect_Specification node for the aspect. + + procedure Check_Aspect_At_End_Of_Declarations (ASN : Node_Id); + -- Performs the processing described above at the freeze all point, and + -- issues appropriate error messages if the visibility has indeed changed. + -- Again, ASN is the N_Aspect_Specification node for the aspect. end Sem_Ch13;