aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2012-10-01 10:45:43 +0200
committerArnaud Charlet <charlet@gcc.gnu.org>2012-10-01 10:45:43 +0200
commitc5a26133df8575533bc97def6e76bf66bec7f91a (patch)
treebc41eca22e0a81ac94816a7d59b5d89a6242b070 /gcc/ada
parent9e1902a9e7e3cb06d33ad2c1e1e002d2ba0973ec (diff)
downloadgcc-c5a26133df8575533bc97def6e76bf66bec7f91a.zip
gcc-c5a26133df8575533bc97def6e76bf66bec7f91a.tar.gz
gcc-c5a26133df8575533bc97def6e76bf66bec7f91a.tar.bz2
[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
Diffstat (limited to 'gcc/ada')
-rw-r--r--gcc/ada/ChangeLog10
-rw-r--r--gcc/ada/checks.adb41
-rw-r--r--gcc/ada/exp_ch3.adb12
-rw-r--r--gcc/ada/freeze.adb3
-rw-r--r--gcc/ada/opt.ads2
-rw-r--r--gcc/ada/sem_ch13.adb20
-rw-r--r--gcc/ada/sem_ch6.adb4
7 files changed, 63 insertions, 29 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index d0f8617..db3e9b8 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,13 @@
+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>
* aspects.ads: Type_Invariant'class is a valid aspect.
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index 885a568..8d40abc 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -1876,8 +1876,9 @@ package body Checks is
----------------------
procedure Build_PPC_Pragma (PPC_Nam : Name_Id; Check : Node_Id) is
- Loc : constant Source_Ptr := Sloc (Subp);
- Prag : Node_Id;
+ Loc : constant Source_Ptr := Sloc (Subp);
+ Decls : List_Id;
+ Prag : Node_Id;
begin
Prag :=
@@ -1904,11 +1905,34 @@ package body Checks is
if Nkind (Parent (Subp_Decl)) = N_Compilation_Unit then
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
- Insert_After (Subp_Decl, Prag);
+ Insert_After_And_Analyze (Subp_Decl, Prag);
end if;
-
- Analyze (Prag);
end Build_PPC_Pragma;
-- Local variables
@@ -1941,10 +1965,11 @@ package body Checks is
or else Is_Imported (Subp)
or else Is_Intrinsic_Subprogram (Subp)
- -- Do not consider subprogram bodies because pre and post conditions
- -- cannot be associated with them.
+ -- The PPC pragmas generated by this routine do not correspond to
+ -- 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
-- adding the checks to a no action routine.
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 293c902..cf99375 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -3626,7 +3626,7 @@ package body Exp_Ch3 is
-- Name for argument of invariant procedure
Object_Entity : constant Node_Id :=
- Make_Defining_Identifier (Loc, Object_Name);
+ Make_Defining_Identifier (Loc, Object_Name);
-- The procedure declaration entity for the argument
Invariant_Found : Boolean;
@@ -3681,10 +3681,10 @@ package body Exp_Ch3 is
begin
Stmts := New_List;
Decl := First_Non_Pragma (Component_Items (Comp_List));
-
while Present (Decl) loop
if Nkind (Decl) = N_Component_Declaration then
Id := Defining_Identifier (Decl);
+
if Has_Invariants (Etype (Id)) then
Append_To (Stmts, Build_Component_Invariant_Call (Id));
end if;
@@ -3734,14 +3734,16 @@ package body Exp_Ch3 is
return Stmts;
end Build_Invariant_Checks;
+ -- Start of processing for Build_Record_Invariant_Proc
+
begin
Invariant_Found := False;
Type_Def := Type_Definition (Parent (R_Type));
+
if Nkind (Type_Def) = N_Record_Definition
- and then not Null_Present (Type_Def)
+ and then not Null_Present (Type_Def)
then
- Stmts :=
- Build_Invariant_Checks (Component_List (Type_Def));
+ Stmts := Build_Invariant_Checks (Component_List (Type_Def));
else
return;
end if;
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 6065877..03b2759 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -2660,8 +2660,7 @@ package body Freeze is
-- storage of subprogram parameters.
if Is_Subprogram (E)
- and then (Check_Aliasing_Of_Parameters
- or else Check_Validity_Of_Parameters)
+ and then (Check_Aliasing_Of_Parameters or Check_Validity_Of_Parameters)
then
Apply_Parameter_Aliasing_And_Validity_Checks (E);
end if;
diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads
index 311dad7..dc0d862 100644
--- a/gcc/ada/opt.ads
+++ b/gcc/ada/opt.ads
@@ -326,7 +326,7 @@ package Opt is
Check_Validity_Of_Parameters : Boolean := False;
-- GNAT
-- 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;
-- GNAT
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index c93fd7e..c21468f 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -5232,16 +5232,16 @@ package body Sem_Ch13 is
-- Build_Predicate_Function --
------------------------------
- -- The procedure that is constructed here has the form
-
- -- function typPredicate (Ixxx : typ) return Boolean is
- -- begin
- -- return
- -- exp1 and then exp2 and then ...
- -- and then typ1Predicate (typ1 (Ixxx))
- -- and then typ2Predicate (typ2 (Ixxx))
- -- and then ...;
- -- end typPredicate;
+ -- The procedure that is constructed here has the form:
+
+ -- function typPredicate (Ixxx : typ) return Boolean is
+ -- begin
+ -- return
+ -- exp1 and then exp2 and then ...
+ -- and then typ1Predicate (typ1 (Ixxx))
+ -- and then typ2Predicate (typ2 (Ixxx))
+ -- and then ...;
+ -- end typPredicate;
-- Here exp1, and exp2 are expressions from Predicate pragmas. Note that
-- this is the point at which these expressions get analyzed, providing the
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index c71c2db..5ace348 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -11344,9 +11344,7 @@ package body Sem_Ch6 is
-- public subprogram, since we do get initializations to deal with.
-- Other internally generated subprograms are not public.
- if not Is_List_Member (DD)
- and then Is_Init_Proc (DD)
- then
+ if not Is_List_Member (DD) and then Is_Init_Proc (DD) then
return True;
elsif not Comes_From_Source (DD) then