sem_attr.adb: 'Result can have an ambiguous prefix, and is resolved from context.

2008-07-31  Ed Schonberg  <schonberg@adacore.com>

	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

2 files changed, 86 insertions, 29 deletions

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;
 
       -----------------------------