Commit c5a26133 by Arnaud Charlet

[multiple changes]

2012-10-01  Robert Dewar  <dewar@adacore.com>

	* freeze.adb, sem_ch6.adb, opt.ads, sem_ch13.adb,
	exp_ch3.adb: Minor reformatting.

2012-10-01  Hristian Kirtchev  <kirtchev@adacore.com>

	* checks.adb (Build_PPC_Pragma): A PPC pragma can now be properly
	associated with a subprogram body.

From-SVN: r191902
parent 9e1902a9
2012-10-01 Robert Dewar <dewar@adacore.com>
* freeze.adb, sem_ch6.adb, opt.ads, sem_ch13.adb,
exp_ch3.adb: Minor reformatting.
2012-10-01 Hristian Kirtchev <kirtchev@adacore.com>
* checks.adb (Build_PPC_Pragma): A PPC pragma can now be properly
associated with a subprogram body.
2012-10-01 Ed Schonberg <schonberg@adacore.com> 2012-10-01 Ed Schonberg <schonberg@adacore.com>
* aspects.ads: Type_Invariant'class is a valid aspect. * aspects.ads: Type_Invariant'class is a valid aspect.
......
...@@ -1876,8 +1876,9 @@ package body Checks is ...@@ -1876,8 +1876,9 @@ package body Checks is
---------------------- ----------------------
procedure Build_PPC_Pragma (PPC_Nam : Name_Id; Check : Node_Id) is procedure Build_PPC_Pragma (PPC_Nam : Name_Id; Check : Node_Id) is
Loc : constant Source_Ptr := Sloc (Subp); Loc : constant Source_Ptr := Sloc (Subp);
Prag : Node_Id; Decls : List_Id;
Prag : Node_Id;
begin begin
Prag := Prag :=
...@@ -1904,11 +1905,34 @@ package body Checks is ...@@ -1904,11 +1905,34 @@ package body Checks is
if Nkind (Parent (Subp_Decl)) = N_Compilation_Unit then if Nkind (Parent (Subp_Decl)) = N_Compilation_Unit then
Add_Global_Declaration (Prag); Add_Global_Declaration (Prag);
Analyze (Prag);
-- PPC pragmas associated with subprogram bodies must be inserted in
-- the declarative part of the body.
elsif Nkind (Subp_Decl) = N_Subprogram_Body then
Decls := Declarations (Subp_Decl);
if No (Decls) then
Decls := New_List;
Set_Declarations (Subp_Decl, Decls);
end if;
Append_To (Decls, Prag);
-- Ensure the proper visibility of the subprogram body and its
-- parameters.
Push_Scope (Subp);
Analyze (Prag);
Pop_Scope;
-- For subprogram declarations insert the PPC pragma right after the
-- declarative node.
else else
Insert_After (Subp_Decl, Prag); Insert_After_And_Analyze (Subp_Decl, Prag);
end if; end if;
Analyze (Prag);
end Build_PPC_Pragma; end Build_PPC_Pragma;
-- Local variables -- Local variables
...@@ -1941,10 +1965,11 @@ package body Checks is ...@@ -1941,10 +1965,11 @@ package body Checks is
or else Is_Imported (Subp) or else Is_Imported (Subp)
or else Is_Intrinsic_Subprogram (Subp) or else Is_Intrinsic_Subprogram (Subp)
-- Do not consider subprogram bodies because pre and post conditions -- The PPC pragmas generated by this routine do not correspond to
-- cannot be associated with them. -- source aspects, therefore they cannot be applied to abstract
-- subprograms.
or else Nkind (Subp_Decl) /= N_Subprogram_Declaration or else Nkind (Subp_Decl) = N_Abstract_Subprogram_Declaration
-- Do not process null procedures because there is no benefit of -- Do not process null procedures because there is no benefit of
-- adding the checks to a no action routine. -- adding the checks to a no action routine.
......
...@@ -3626,7 +3626,7 @@ package body Exp_Ch3 is ...@@ -3626,7 +3626,7 @@ package body Exp_Ch3 is
-- Name for argument of invariant procedure -- Name for argument of invariant procedure
Object_Entity : constant Node_Id := Object_Entity : constant Node_Id :=
Make_Defining_Identifier (Loc, Object_Name); Make_Defining_Identifier (Loc, Object_Name);
-- The procedure declaration entity for the argument -- The procedure declaration entity for the argument
Invariant_Found : Boolean; Invariant_Found : Boolean;
...@@ -3681,10 +3681,10 @@ package body Exp_Ch3 is ...@@ -3681,10 +3681,10 @@ package body Exp_Ch3 is
begin begin
Stmts := New_List; Stmts := New_List;
Decl := First_Non_Pragma (Component_Items (Comp_List)); Decl := First_Non_Pragma (Component_Items (Comp_List));
while Present (Decl) loop while Present (Decl) loop
if Nkind (Decl) = N_Component_Declaration then if Nkind (Decl) = N_Component_Declaration then
Id := Defining_Identifier (Decl); Id := Defining_Identifier (Decl);
if Has_Invariants (Etype (Id)) then if Has_Invariants (Etype (Id)) then
Append_To (Stmts, Build_Component_Invariant_Call (Id)); Append_To (Stmts, Build_Component_Invariant_Call (Id));
end if; end if;
...@@ -3734,14 +3734,16 @@ package body Exp_Ch3 is ...@@ -3734,14 +3734,16 @@ package body Exp_Ch3 is
return Stmts; return Stmts;
end Build_Invariant_Checks; end Build_Invariant_Checks;
-- Start of processing for Build_Record_Invariant_Proc
begin begin
Invariant_Found := False; Invariant_Found := False;
Type_Def := Type_Definition (Parent (R_Type)); Type_Def := Type_Definition (Parent (R_Type));
if Nkind (Type_Def) = N_Record_Definition if Nkind (Type_Def) = N_Record_Definition
and then not Null_Present (Type_Def) and then not Null_Present (Type_Def)
then then
Stmts := Stmts := Build_Invariant_Checks (Component_List (Type_Def));
Build_Invariant_Checks (Component_List (Type_Def));
else else
return; return;
end if; end if;
......
...@@ -2660,8 +2660,7 @@ package body Freeze is ...@@ -2660,8 +2660,7 @@ package body Freeze is
-- storage of subprogram parameters. -- storage of subprogram parameters.
if Is_Subprogram (E) if Is_Subprogram (E)
and then (Check_Aliasing_Of_Parameters and then (Check_Aliasing_Of_Parameters or Check_Validity_Of_Parameters)
or else Check_Validity_Of_Parameters)
then then
Apply_Parameter_Aliasing_And_Validity_Checks (E); Apply_Parameter_Aliasing_And_Validity_Checks (E);
end if; end if;
......
...@@ -326,7 +326,7 @@ package Opt is ...@@ -326,7 +326,7 @@ package Opt is
Check_Validity_Of_Parameters : Boolean := False; Check_Validity_Of_Parameters : Boolean := False;
-- GNAT -- GNAT
-- Set to True to check for proper scalar initialization of subprogram -- Set to True to check for proper scalar initialization of subprogram
-- parameters on both entry and exit. -- parameters on both entry and exit. Turned on by??? turned off by???
Check_Withs : Boolean := False; Check_Withs : Boolean := False;
-- GNAT -- GNAT
......
...@@ -5232,16 +5232,16 @@ package body Sem_Ch13 is ...@@ -5232,16 +5232,16 @@ package body Sem_Ch13 is
-- Build_Predicate_Function -- -- Build_Predicate_Function --
------------------------------ ------------------------------
-- The procedure that is constructed here has the form -- The procedure that is constructed here has the form:
-- function typPredicate (Ixxx : typ) return Boolean is -- function typPredicate (Ixxx : typ) return Boolean is
-- begin -- begin
-- return -- return
-- exp1 and then exp2 and then ... -- exp1 and then exp2 and then ...
-- and then typ1Predicate (typ1 (Ixxx)) -- and then typ1Predicate (typ1 (Ixxx))
-- and then typ2Predicate (typ2 (Ixxx)) -- and then typ2Predicate (typ2 (Ixxx))
-- and then ...; -- and then ...;
-- end typPredicate; -- end typPredicate;
-- Here exp1, and exp2 are expressions from Predicate pragmas. Note that -- Here exp1, and exp2 are expressions from Predicate pragmas. Note that
-- this is the point at which these expressions get analyzed, providing the -- this is the point at which these expressions get analyzed, providing the
......
...@@ -11344,9 +11344,7 @@ package body Sem_Ch6 is ...@@ -11344,9 +11344,7 @@ package body Sem_Ch6 is
-- public subprogram, since we do get initializations to deal with. -- public subprogram, since we do get initializations to deal with.
-- Other internally generated subprograms are not public. -- Other internally generated subprograms are not public.
if not Is_List_Member (DD) if not Is_List_Member (DD) and then Is_Init_Proc (DD) then
and then Is_Init_Proc (DD)
then
return True; return True;
elsif not Comes_From_Source (DD) then elsif not Comes_From_Source (DD) then
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment