From: Ed Schonberg Date: Thu, 31 Jul 2008 08:17:31 +0000 (+0200) Subject: sem_attr.adb: 'Result can have an ambiguous prefix, and is resolved from context. X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=3023ce4262d7de329d1082347943a91621b88e1d;p=platform%2Fupstream%2Fgcc.git sem_attr.adb: 'Result can have an ambiguous prefix, and is resolved from context. 2008-07-31 Ed Schonberg sem_attr.adb: 'Result can have an ambiguous prefix, and is resolved from context. This attribute must be usable in Ada95 mode. The attribute can appear in the body of a function marked Inline_Always, but in this case the postocondition is not enforced. sem_prag.adb (Check_Precondition_Postcondition): within the expansion of an inlined call pre- and postconditions are legal From-SVN: r138364 --- diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 14f9102..c131827 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -1898,6 +1898,7 @@ package body Sem_Attr is and then Aname /= Name_Address and then Aname /= Name_Code_Address and then Aname /= Name_Count + and then Aname /= Name_Result and then Aname /= Name_Unchecked_Access then Error_Attr ("ambiguous prefix for % attribute", P); @@ -3738,9 +3739,23 @@ package body Sem_Attr is when Attribute_Result => Result : declare CS : constant Entity_Id := Current_Scope; - PS : constant Entity_Id := Scope (CS); + PS : Entity_Id; begin + PS := Scope (CS); + + -- If we are analyzing a body to be inlined, there is an additional + -- scope present, used to gather global references. Retrieve the + -- source scope. + + if Chars (PS) = Name_uParent then + PS := Scope (PS); + if Warn_On_Redundant_Constructs then + Error_Msg_N + ("postconditions on inlined functions not enforced", N); + end if; + end if; + -- If we are in the scope of a function and in Spec_Expression mode, -- this is likely the prescan of the postcondition pragma, and we -- just set the proper type. If there is an error it will be caught @@ -3775,9 +3790,13 @@ package body Sem_Attr is then -- Check OK prefix - if Nkind (P) /= N_Identifier - or else Chars (P) /= Chars (PS) + if (Nkind (P) = N_Identifier + or else Nkind (P) = N_Operator_Symbol) + and then Chars (P) = Chars (PS) then + null; + + else Error_Msg_NE ("incorrect prefix for % attribute, expected &", P, PS); Error_Attr; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 3feba80..a7cce6f 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -583,6 +583,7 @@ package body Sem_Prag is -- expression, returns True if so, False if non-static or not String. procedure Pragma_Misplaced; + pragma No_Return (Pragma_Misplaced); -- Issue fatal error message for misplaced pragma procedure Process_Atomic_Shared_Volatile; @@ -1350,9 +1351,48 @@ package body Sem_Prag is procedure Check_Precondition_Postcondition (In_Body : out Boolean) is P : Node_Id; - S : Entity_Id; PO : Node_Id; + procedure Chain_PPC (PO : Node_Id); + -- PO is the N_Subprogram_Declaration node for the subprogram to + -- which the precondition/postcondition applies. This procedure + -- completes the processing for the pragma. + + --------------- + -- Chain_PPC -- + --------------- + + procedure Chain_PPC (PO : Node_Id) is + S : Node_Id; + + begin + S := Defining_Unit_Name (Specification (PO)); + + -- Analyze the pragma unless it appears within a package spec, + -- which is the case where we delay the analysis of the PPC until + -- the end of the package declarations (for details, see + -- Analyze_Package_Specification.Analyze_PPCs). + + if Ekind (Scope (S)) /= E_Package + and then + Ekind (Scope (S)) /= E_Generic_Package + then + Analyze_PPC_In_Decl_Part (N, S); + end if; + + -- Chain spec PPC pragma to list for subprogram + + Set_Next_Pragma (N, Spec_PPC_List (S)); + Set_Spec_PPC_List (S, N); + + -- Return indicating spec case + + In_Body := False; + return; + end Chain_PPC; + + -- Start of processing for Check_Precondition_Postcondition + begin if not Is_List_Member (N) then Pragma_Misplaced; @@ -1362,6 +1402,14 @@ package body Sem_Prag is Set_PPC_Enabled (N, Check_Enabled (Pname)); + -- If we are within an inlined body, the legality of the pragma + -- has been checked already. + + if In_Inlined_Body then + In_Body := True; + return; + end if; + -- Search prior declarations P := N; @@ -1382,28 +1430,7 @@ package body Sem_Prag is -- Here if we hit a subprogram declaration elsif Nkind (PO) = N_Subprogram_Declaration then - S := Defining_Unit_Name (Specification (PO)); - - -- Analyze the pragma unless it appears within a package spec, - -- which is the case where we delay the analysis of the PPC - -- until the end of the package declarations (for details, - -- see Analyze_Package_Specification.Analyze_PPCs). - - if Ekind (Scope (S)) /= E_Package - and then - Ekind (Scope (S)) /= E_Generic_Package - then - Analyze_PPC_In_Decl_Part (N, S); - end if; - - -- Chain spec PPC pragma to list for subprogram - - Set_Next_Pragma (N, Spec_PPC_List (S)); - Set_Spec_PPC_List (S, N); - - -- Return indicating spec case - - In_Body := False; + Chain_PPC (PO); return; -- If we encounter any other declaration moving back, misplaced @@ -1422,11 +1449,22 @@ package body Sem_Prag is In_Body := True; return; - -- If not, it was misplaced + -- See if it is in the pragmas after a library level subprogram - else - Pragma_Misplaced; + elsif Nkind (Parent (N)) = N_Compilation_Unit_Aux then + declare + Decl : constant Node_Id := Unit (Parent (Parent (N))); + begin + if Nkind (Decl) = N_Subprogram_Declaration then + Chain_PPC (Decl); + return; + end if; + end; end if; + + -- If we fall through, pragma was misplaced + + Pragma_Misplaced; end Check_Precondition_Postcondition; -----------------------------