From 8d9509fd725209f785a5ded6152ff9aa97058cde Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Tue, 5 Aug 2008 16:37:19 +0200 Subject: [PATCH] sem_attr.adb: (Analyze_Attribute... 2008-08-05 Ed Schonberg * sem_attr.adb: (Analyze_Attribute, case 'Result): handle properly the case where some operand of the expression in a post-condition generates a transient block. From-SVN: r138722 --- gcc/ada/sem_attr.adb | 94 ++++++++++++++++++++++++++++++++++------------------ 1 file changed, 62 insertions(+), 32 deletions(-) diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 3068491..f32d0b7 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -3767,8 +3767,8 @@ package body Sem_Attr is ------------ when Attribute_Result => Result : declare - CS : constant Entity_Id := Current_Scope; - PS : constant Entity_Id := Scope (CS); + CS : Entity_Id := Current_Scope; + PS : Entity_Id := Scope (CS); begin -- If the enclosing subprogram is always inlined, the enclosing @@ -3808,44 +3808,61 @@ package body Sem_Attr is end if; -- Body case, where we must be inside a generated _Postcondition - -- procedure, or the attribute use is definitely misplaced. + -- procedure, and the prefix must be on the scope stack, or else + -- the attribute use is definitely misplaced. The condition itself + -- may have generated transient scopes, and is not necessarily the + -- current one. - elsif Chars (CS) = Name_uPostconditions - and then Ekind (PS) = E_Function - then - -- Check OK prefix + else + while Present (CS) + and then CS /= Standard_Standard + loop + if Chars (CS) = Name_uPostconditions then + exit; + else + CS := Scope (CS); + end if; + end loop; - if (Nkind (P) = N_Identifier - or else Nkind (P) = N_Operator_Symbol) - and then Chars (P) = Chars (PS) + PS := Scope (CS); + + if Chars (CS) = Name_uPostconditions + and then Ekind (PS) = E_Function then - null; + -- Check OK prefix - -- Within an instance, the prefix designates the local renaming - -- of the original generic. + if (Nkind (P) = N_Identifier + or else Nkind (P) = N_Operator_Symbol) + and then Chars (P) = Chars (PS) + then + null; - elsif Is_Entity_Name (P) - and then Ekind (Entity (P)) = E_Function - and then Present (Alias (Entity (P))) - and then Chars (Alias (Entity (P))) = Chars (PS) - then - null; + -- Within an instance, the prefix designates the local renaming + -- of the original generic. - else - Error_Msg_NE - ("incorrect prefix for % attribute, expected &", P, PS); - Error_Attr; - end if; + elsif Is_Entity_Name (P) + and then Ekind (Entity (P)) = E_Function + and then Present (Alias (Entity (P))) + and then Chars (Alias (Entity (P))) = Chars (PS) + then + null; - Rewrite (N, - Make_Identifier (Sloc (N), - Chars => Name_uResult)); - Analyze_And_Resolve (N, Etype (PS)); + else + Error_Msg_NE + ("incorrect prefix for % attribute, expected &", P, PS); + Error_Attr; + end if; - else - Error_Attr - ("% attribute can only appear in function Postcondition pragma", - P); + Rewrite (N, + Make_Identifier (Sloc (N), + Chars => Name_uResult)); + Analyze_And_Resolve (N, Etype (PS)); + + else + Error_Attr + ("% attribute can only appear" & + " in function Postcondition pragma", P); + end if; end if; end Result; @@ -7542,6 +7559,19 @@ package body Sem_Attr is Note_Possible_Modification (P, Sure => False); end if; + -- The following comes from a query by Adam Beneschan, concerning + -- improper use of universal_access in equality tests involving + -- anonymous access types. Another good reason for 'Ref, but + -- for now disable the test, which breaks several filed tests. + + if Ekind (Typ) = E_Anonymous_Access_Type + and then Nkind_In (Parent (N), N_Op_Eq, N_Op_Ne) + and then False + then + Error_Msg_N ("need unique type to resolve 'Access", N); + Error_Msg_N ("\qualify attribute with some access type", N); + end if; + if Is_Entity_Name (P) then if Is_Overloaded (P) then Get_First_Interp (P, Index, It); -- 2.7.4