2010-10-22 Robert Dewar <dewar@adacore.com>

	* einfo.ads, einfo.adb (Has_Predicates): Flag is now on all entities
	(simplifies code).
	* exp_ch13.adb (Build_Predicate_Function): Output info msgs for
	inheritance.
	* sem_ch13.adb (Analyze_Aspect_Specifications): Make sure we have a
	freeze node for entities for which a predicate is specified.
	(Analyze_Aspect_Specifications): Avoid duplicate calls
	* sem_ch3.adb (Analyze_Full_Type_Declaration): Remove attempt to avoid
	duplicate calls to Analye_Aspect_Specifications.

2010-10-22  Thomas Quinot  <quinot@adacore.com>

	* a-exextr.adb, atree.ads, freeze.adb: Minor reformatting.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@165804 138bc75d-0d04-0410-961f-82ee72b054a4

9 files changed, 80 insertions, 41 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 1770e471716..b396ff6dad9 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,19 @@
+2010-10-22  Robert Dewar  <dewar@adacore.com>
+
+	* einfo.ads, einfo.adb (Has_Predicates): Flag is now on all entities
+	(simplifies code).
+	* exp_ch13.adb (Build_Predicate_Function): Output info msgs for
+	inheritance.
+	* sem_ch13.adb (Analyze_Aspect_Specifications): Make sure we have a
+	freeze node for entities for which a predicate is specified.
+	(Analyze_Aspect_Specifications): Avoid duplicate calls
+	* sem_ch3.adb (Analyze_Full_Type_Declaration): Remove attempt to avoid
+	duplicate calls to Analye_Aspect_Specifications.
+
+2010-10-22  Thomas Quinot  <quinot@adacore.com>
+
+	* a-exextr.adb, atree.ads, freeze.adb: Minor reformatting.
+
 2010-10-21  Robert Dewar  <dewar@adacore.com>
 
 	* sem_ch3.adb: Minor reformatting.
diff --git a/gcc/ada/a-exextr.adb b/gcc/ada/a-exextr.adb
index 2ea9a3ad1e5..26567b3a488 100644
--- a/gcc/ada/a-exextr.adb
+++ b/gcc/ada/a-exextr.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2010, 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- --
@@ -53,8 +53,7 @@ package body Exception_Traces is
    pragma Export
      (Ada, Raise_Hook_Initialized, "__gnat_exception_actions_initialized");
 
-   procedure Last_Chance_Handler
-     (Except :  Exception_Occurrence);
+   procedure Last_Chance_Handler (Except : Exception_Occurrence);
    pragma Import (C, Last_Chance_Handler, "__gnat_last_chance_handler");
    pragma No_Return (Last_Chance_Handler);
    --  Users can replace the default version of this routine,
diff --git a/gcc/ada/atree.ads b/gcc/ada/atree.ads
index 904c637fc0c..31b4391e4cc 100644
--- a/gcc/ada/atree.ads
+++ b/gcc/ada/atree.ads
@@ -537,9 +537,8 @@ package Atree is
 
    function Parent            (N : Node_Id) return Node_Id;
    pragma Inline (Parent);
-   --  Returns the parent of a node if the node is not a list member, or
-   --  else the parent of the list containing the node if the node is a
-   --  list member.
+   --  Returns the parent of a node if the node is not a list member, or else
+   --  the parent of the list containing the node if the node is a list member.
 
    function No                (N : Node_Id) return Boolean;
    pragma Inline (No);
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index 96f1e52fe7c..68eedfd0bdb 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -1411,7 +1411,6 @@ package body Einfo is
 
    function Has_Predicates (Id : E) return B is
    begin
-      pragma Assert (Is_Type (Id) or else Is_Subprogram (Id));
       return Flag250 (Id);
    end Has_Predicates;
 
@@ -3863,9 +3862,6 @@ package body Einfo is
 
    procedure Set_Has_Predicates (Id : E; V : B := True) is
    begin
-      pragma Assert (Is_Type (Id)
-        or else Ekind (Id) = E_Function
-        or else Ekind (Id) = E_Void);
       Set_Flag250 (Id, V);
    end Set_Has_Predicates;
 
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 1d3c9cb0f11..febac6df740 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -1674,11 +1674,11 @@ package Einfo is
 --       such an object and no warning is generated.
 
 --    Has_Predicates (Flag250)
---       Present in type and subtype entities and in subprogram entities. Set
---       if a pragma Predicate or Predicate aspect applies to the type, or if
---       it inherits a Predicate aspect from its parent or progenitor types.
---       Also set in the predicate function entity, to distinguish it among
---       entries in the Subprograms_For_Type.
+--       Present in all entities. Set in type and subtype entities if a pragma
+--       Predicate or Predicate aspect applies to the type, or if it inherits a
+--       Predicate aspect from its parent or progenitor types. Also set in the
+--       predicate function entity, to distinguish it among entries in the
+--       Subprograms_For_Type.
 
 --    Has_Primitive_Operations (Flag120) [base type only]
 --       Present in all type entities. Set if at least one primitive operation
@@ -4666,6 +4666,7 @@ package Einfo is
    --    Has_Pragma_Thread_Local_Storage     (Flag169)
    --    Has_Pragma_Unmodified               (Flag233)
    --    Has_Pragma_Unreferenced             (Flag180)
+   --    Has_Predicates                      (Flag250)
    --    Has_Private_Declaration             (Flag155)
    --    Has_Qualified_Name                  (Flag161)
    --    Has_Stream_Size_Clause              (Flag184)
@@ -4778,7 +4779,6 @@ package Einfo is
    --    Has_Object_Size_Clause              (Flag172)
    --    Has_Pragma_Preelab_Init             (Flag221)
    --    Has_Pragma_Unreferenced_Objects     (Flag212)
-   --    Has_Predicates                      (Flag250)
    --    Has_Primitive_Operations            (Flag120)  (base type only)
    --    Has_Size_Clause                     (Flag29)
    --    Has_Specified_Layout                (Flag100)  (base type only)
@@ -5138,7 +5138,6 @@ package Einfo is
    --    Has_Missing_Return                  (Flag142)
    --    Has_Nested_Block_With_Handler       (Flag101)
    --    Has_Postconditions                  (Flag240)
-   --    Has_Predicates                      (Flag250)
    --    Has_Recursive_Call                  (Flag143)
    --    Has_Subprogram_Descriptor           (Flag93)
    --    Is_Abstract_Subprogram              (Flag19)   (non-generic case only)
@@ -5271,7 +5270,6 @@ package Einfo is
    --    Subprograms_For_Type                (Node29)
    --    Has_Invariants                      (Flag232)
    --    Has_Postconditions                  (Flag240)
-   --    Has_Predicates                      (Flag250)
    --    Is_Machine_Code_Subprogram          (Flag137)
    --    Is_Pure                             (Flag44)
    --    Is_Intrinsic_Subprogram             (Flag64)
@@ -5403,7 +5401,6 @@ package Einfo is
    --    Has_Master_Entity                   (Flag21)
    --    Has_Nested_Block_With_Handler       (Flag101)
    --    Has_Postconditions                  (Flag240)
-   --    Has_Predicates                      (Flag250)
    --    Has_Subprogram_Descriptor           (Flag93)
    --    Is_Abstract_Subprogram              (Flag19)   (non-generic case only)
    --    Is_Asynchronous                     (Flag81)
diff --git a/gcc/ada/exp_ch13.adb b/gcc/ada/exp_ch13.adb
index eaf90f7c02b..8e9d2ca3188 100644
--- a/gcc/ada/exp_ch13.adb
+++ b/gcc/ada/exp_ch13.adb
@@ -27,6 +27,7 @@ with Atree;    use Atree;
 with Checks;   use Checks;
 with Einfo;    use Einfo;
 with Elists;   use Elists;
+with Errout;   use Errout;
 with Exp_Ch3;  use Exp_Ch3;
 with Exp_Ch6;  use Exp_Ch6;
 with Exp_Imgv; use Exp_Imgv;
@@ -126,12 +127,17 @@ package body Exp_Ch13 is
 
       begin
          if Present (T) and then Present (Predicate_Function (T)) then
+
+            --  Build the call to the predicate function of T
+
             Exp :=
               Make_Predicate_Call
                 (T,
                  Convert_To (T,
                    Make_Identifier (Loc, Chars => Object_Name)));
 
+            --  Add call to evolving expression, using AND THEN if needed
+
             if No (Expr) then
                Expr := Exp;
             else
@@ -140,6 +146,14 @@ package body Exp_Ch13 is
                    Left_Opnd  => Relocate_Node (Expr),
                    Right_Opnd => Exp);
             end if;
+
+            --  Output info message on inheritance if required
+
+            if Opt.List_Inherited_Aspects then
+               Error_Msg_Sloc := Sloc (Predicate_Function (T));
+               Error_Msg_Node_2 := T;
+               Error_Msg_N ("?info: & inherits predicate from & at #", Typ);
+            end if;
          end if;
       end Add_Call;
 
@@ -200,24 +214,27 @@ package body Exp_Ch13 is
                Arg1 := Get_Pragma_Arg (Arg1);
                Arg2 := Get_Pragma_Arg (Arg2);
 
-               --  We need to replace any occurrences of the name of the type
-               --  with references to the object. We do this by first doing a
-               --  preanalysis, to identify all the entities, then we traverse
-               --  looking for the type entity, doing the needed substitution.
-               --  The preanalysis is done with the special OK_To_Reference
-               --  flag set on the type, so that if we get an occurrence of
-               --  this type, it will be recognized as legitimate.
-
-               Set_OK_To_Reference (Typ, True);
-               Preanalyze_Spec_Expression (Arg2, Standard_Boolean);
-               Set_OK_To_Reference (Typ, False);
-               Replace_Type (Arg2);
-
                --  See if this predicate pragma is for the current type
 
                if Entity (Arg1) = Typ then
 
-                  --  We have a match, add the expression
+                  --  We have a match, this entry is for our subtype
+
+                  --  First We need to replace any occurrences of the name of
+                  --  the type with references to the object. We do this by
+                  --  first doing a preanalysis, to identify all the entities,
+                  --  then we traverse looking for the type entity, doing the
+                  --  needed substitution. The preanalysis is done with the
+                  --  special OK_To_Reference flag set on the type, so that if
+                  --  we get an occurrence of this type, it will be recognized
+                  --  as legitimate.
+
+                  Set_OK_To_Reference (Typ, True);
+                  Preanalyze_Spec_Expression (Arg2, Standard_Boolean);
+                  Set_OK_To_Reference (Typ, False);
+                  Replace_Type (Arg2);
+
+                  --  OK, replacement complete, now we can add the expression
 
                   if No (Expr) then
                      Expr := Relocate_Node (Arg2);
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 5bbcab0134c..236ee271894 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -3464,9 +3464,9 @@ package body Freeze is
                   end;
                end if;
 
-               --  If any of the index types was an enumeration type with
-               --  a non-standard rep clause, then we indicate that the
-               --  array type is always packed (even if it is not bit packed).
+               --  If any of the index types was an enumeration type with a
+               --  non-standard rep clause, then we indicate that the array
+               --  type is always packed (even if it is not bit packed).
 
                if Non_Standard_Enum then
                   Set_Has_Non_Standard_Rep (Base_Type (E));
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index b1f619c90e7..58150a32893 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -658,10 +658,21 @@ package body Sem_Ch13 is
       --  Set True if delay is required
 
    begin
+      --  Return if no aspects
+
       if L = No_List then
          return;
       end if;
 
+      --  Return if already analyzed (avoids duplicate calls in some cases
+      --  where type declarations get rewritten and proessed twice).
+
+      if Analyzed (N) then
+         return;
+      end if;
+
+      --  Loop through apsects
+
       Aspect := First (L);
       while Present (Aspect) loop
          declare
@@ -1068,6 +1079,12 @@ package body Sem_Ch13 is
 
                   Set_From_Aspect_Specification (Aitem, True);
 
+                  --  Make sure we have a freeze node (it might otherwise be
+                  --  missing in cases like subtype X is Y, and we would not
+                  --  have a place to build the predicate function).
+
+                  Ensure_Freeze_Node (E);
+
                   --  For Predicate case, insert immediately after the entity
                   --  declaration. We do not have to worry about delay issues
                   --  since the pragma processing takes care of this.
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index f0e4c497deb..335d348b649 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -2403,9 +2403,7 @@ package body Sem_Ch3 is
       Set_Optimize_Alignment_Flags (Def_Id);
       Check_Eliminated (Def_Id);
 
-      if Nkind (N) = N_Full_Type_Declaration then
-         Analyze_Aspect_Specifications (N, Def_Id, Aspect_Specifications (N));
-      end if;
+      Analyze_Aspect_Specifications (N, Def_Id, Aspect_Specifications (N));
    end Analyze_Full_Type_Declaration;
 
    ----------------------------------
@@ -4215,8 +4213,8 @@ package body Sem_Ch3 is
       Set_Optimize_Alignment_Flags (Id);
       Check_Eliminated (Id);
 
-      <<Leave>>
-         Analyze_Aspect_Specifications (N, Id, Aspect_Specifications (N));
+   <<Leave>>
+      Analyze_Aspect_Specifications (N, Id, Aspect_Specifications (N));
    end Analyze_Subtype_Declaration;
 
    --------------------------------