sem_ch12.adb (Analyze_Generic_Subprogram_Declaration): Call to…

sem_ch12.adb (Analyze_Generic_Subprogram_Declaration): Call to Make_Aspect_For_PPC_In_Gen_Sub_Decl added in ASIS mode.

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.

From-SVN: r183422

gcc/ada/ChangeLog

+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

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

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

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