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.
......
...@@ -1877,6 +1877,7 @@ package body Checks is ...@@ -1877,6 +1877,7 @@ 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);
Decls : List_Id;
Prag : Node_Id; Prag : Node_Id;
begin begin
...@@ -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);
else Analyze (Prag);
Insert_After (Subp_Decl, 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; end if;
Append_To (Decls, Prag);
-- Ensure the proper visibility of the subprogram body and its
-- parameters.
Push_Scope (Subp);
Analyze (Prag); Analyze (Prag);
Pop_Scope;
-- For subprogram declarations insert the PPC pragma right after the
-- declarative node.
else
Insert_After_And_Analyze (Subp_Decl, Prag);
end if;
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.
......
...@@ -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,7 +5232,7 @@ package body Sem_Ch13 is ...@@ -5232,7 +5232,7 @@ 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
......
...@@ -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