aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--gcc/ada/ChangeLog9
-rw-r--r--gcc/ada/sem_ch12.adb13
-rw-r--r--gcc/ada/sem_prag.adb81
-rw-r--r--gcc/ada/sem_prag.ads9
4 files changed, 108 insertions, 4 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 83947b7..4830074 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,12 @@
+2012-01-23 Vincent Pucci <pucci@adacore.com>
+
+ * sem_ch12.adb (Analyze_Generic_Subprogram_Declaration): Call
+ to Make_Aspect_For_PPC_In_Gen_Sub_Decl added in ASIS mode.
+ * sem_prag.adb, sem_prag.ads (Make_Aspect_For_PPC_In_Gen_Sub_Decl): New
+ routine. In ASIS mode, convert any PPC pragmas into aspects in generic
+ subprogram declaration in order to enable the analysis of PPC boolean
+ expressions.
+
2012-01-23 Robert Dewar <dewar@adacore.com>
* sem_ch3.adb (Analyze_Object_Declaration): Properly
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 4976294..a954ccd 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -59,6 +59,7 @@ with Sem_Disp; use Sem_Disp;
with Sem_Elab; use Sem_Elab;
with Sem_Elim; use Sem_Elim;
with Sem_Eval; use Sem_Eval;
+with Sem_Prag; use Sem_Prag;
with Sem_Res; use Sem_Res;
with Sem_Type; use Sem_Type;
with Sem_Util; use Sem_Util;
@@ -3082,6 +3083,15 @@ package body Sem_Ch12 is
end;
end if;
+ -- For ASIS purposes, convert any postcondition, precondition pragmas
+ -- into aspects, if N is not a compilation unit by itself, in order to
+ -- enable the analysis of expressions inside the corresponding PPC
+ -- pragmas.
+
+ if ASIS_Mode and then Is_List_Member (N) then
+ Make_Aspect_For_PPC_In_Gen_Sub_Decl (N);
+ end if;
+
Spec := Specification (N);
Id := Defining_Entity (Spec);
Generate_Definition (Id);
@@ -4662,7 +4672,8 @@ package body Sem_Ch12 is
end if;
Generate_Definition (Act_Decl_Id);
- Set_Contract (Anon_Id, Make_Contract (Sloc (Anon_Id))); -- ??? needed?
+ -- Set_Contract (Anon_Id, Make_Contract (Sloc (Anon_Id)));
+ -- ??? needed?
Set_Contract (Act_Decl_Id, Make_Contract (Sloc (Act_Decl_Id)));
-- Inherit all inlining-related flags which apply to the generic in
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 00b27d3..73d57a4 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -7991,8 +7991,9 @@ package body Sem_Prag is
-- Normally the analysis that follows will freeze the subprogram
-- being called. However, if the call is to a null procedure,
-- we want to freeze it before creating the block, because the
- -- analysis that follows may be done with expansion disabled, and
- -- and the body will not be generated, leading to spurious errors.
+ -- analysis that follows may be done with expansion disabled, in
+ -- which case the body will not be generated, leading to spurious
+ -- errors.
if Nkind (Call) = N_Procedure_Call_Statement
and then Is_Entity_Name (Name (Call))
@@ -15242,6 +15243,82 @@ package body Sem_Prag is
end if;
end Is_Pragma_String_Literal;
+ -----------------------------------------
+ -- Make_Aspect_For_PPC_In_Gen_Sub_Decl --
+ -----------------------------------------
+
+ -- Convert any PPC and pragmas that appear within a generic subprogram
+ -- declaration into aspect.
+
+ procedure Make_Aspect_For_PPC_In_Gen_Sub_Decl (Decl : Node_Id) is
+ Aspects : constant List_Id := New_List;
+ Loc : constant Source_Ptr := Sloc (Decl);
+ Or_Decl : constant Node_Id := Original_Node (Decl);
+ Aspect : Node_Id;
+ Original_Aspects : List_Id;
+ -- To capture global references, a copy of the created aspects must be
+ -- inserted in the original tree.
+
+ Prag : Node_Id;
+ Prag_Arg_Ass : Node_Id;
+ Prag_Id : Pragma_Id;
+
+ begin
+ Prag := Next (Decl);
+
+ -- Check for any PPC pragmas that appear within Decl
+
+ while Nkind (Prag) = N_Pragma loop
+ Prag_Id := Get_Pragma_Id (Chars (Pragma_Identifier (Prag)));
+
+ case Prag_Id is
+ when Pragma_Postcondition | Pragma_Precondition =>
+ Prag_Arg_Ass := First (Pragma_Argument_Associations (Prag));
+
+ -- Make an aspect from any PPC pragma
+
+ Aspect :=
+ Make_Aspect_Specification (Loc,
+ Identifier =>
+ Make_Identifier (Loc, Chars (Pragma_Identifier (Prag))),
+ Expression => Expression (Prag_Arg_Ass));
+
+ Append (Aspect, Aspects);
+
+ -- Set the pragma node analyzed to avoid any further analysis
+
+ Set_Analyzed (Prag, True);
+
+ when others => null;
+ end case;
+
+ Next (Prag);
+ end loop;
+
+ -- Set all new aspects into the generic declaration node
+
+ if Is_Non_Empty_List (Aspects) then
+ -- Create the list of aspects which will be inserted in the original
+ -- tree.
+
+ Original_Aspects := Copy_Separate_List (Aspects);
+
+ -- Check if Decl already has aspects
+ -- Attach the new lists of aspects to both the generic copy and the
+ -- original tree.
+
+ if Has_Aspects (Decl) then
+ Append_List (Aspects, Aspect_Specifications (Decl));
+ Append_List (Original_Aspects, Aspect_Specifications (Or_Decl));
+ else
+ Set_Parent (Aspects, Decl);
+ Set_Aspect_Specifications (Decl, Aspects);
+ Set_Parent (Original_Aspects, Or_Decl);
+ Set_Aspect_Specifications (Or_Decl, Original_Aspects);
+ end if;
+ end if;
+ end Make_Aspect_For_PPC_In_Gen_Sub_Decl;
+
------------------------
-- Preanalyze_TC_Args --
------------------------
diff --git a/gcc/ada/sem_prag.ads b/gcc/ada/sem_prag.ads
index 18ffcc3..503b658 100644
--- a/gcc/ada/sem_prag.ads
+++ b/gcc/ada/sem_prag.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -110,6 +110,13 @@ package Sem_Prag is
-- length, and then returns True. If it is not of the correct form, then an
-- appropriate error message is posted, and False is returned.
+ procedure Make_Aspect_For_PPC_In_Gen_Sub_Decl (Decl : Node_Id);
+ -- This routine makes aspects from precondition or postcondition pragmas
+ -- that appear within a generic subprogram declaration. Decl is the generic
+ -- subprogram declaration node.
+ -- Note that the aspects are attached to the generic copy and also to the
+ -- orginal tree.
+
procedure Process_Compilation_Unit_Pragmas (N : Node_Id);
-- Called at the start of processing compilation unit N to deal with any
-- special issues regarding pragmas. In particular, we have to deal with