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