[multiple changes]

2011-08-03  Olivier Hainque  <hainque@adacore.com>

	* tracebak.c (STOP_FRAME ppc AIX): Stop at null return address as well.

2011-08-03  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch8.adb (Analyze_Object_Renaming): if the renamed object is an
	explicit dereference of an unconstrained type, create a constrained
	subtype for it, as is done for function calls that return an
	unconstrained type.

2011-08-03  Thomas Quinot  <quinot@adacore.com>

	* g-pehage.adb (Finalize): Avoid possible double-free.

2011-08-03  Steve Baird  <baird@adacore.com>

	* exp_attr.adb (Expand_N_Attribute_Reference): Don't expand
	Elab_Spec/Body attrs in CodePeer_Mode.

2011-08-03  Javier Miranda  <miranda@adacore.com>

	* exp_aggr.adb (Flatten): Convert to positional form aggregates whose
	low bound is not known at compile time but they have no others choice.
	Done because in this case the bounds can be obtained directly from the
	aggregate.

2011-08-03  Ed Falis  <falis@adacore.com>

	* s-tasinf-vxworks.ads: Update comment to reflect 0 indexing of CPUs
	on VxWorks SMP. Remove unusable constant ANY_CPU.

From-SVN: r177242

7 files changed, 151 insertions, 46 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index ebd1b03..ecb09e0 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,35 @@
+2011-08-03  Olivier Hainque  <hainque@adacore.com>
+
+	* tracebak.c (STOP_FRAME ppc AIX): Stop at null return address as well.
+
+2011-08-03  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch8.adb (Analyze_Object_Renaming): if the renamed object is an
+	explicit dereference of an unconstrained type, create a constrained
+	subtype for it, as is done for function calls that return an
+	unconstrained type.
+
+2011-08-03  Thomas Quinot  <quinot@adacore.com>
+
+	* g-pehage.adb (Finalize): Avoid possible double-free.
+
+2011-08-03  Steve Baird  <baird@adacore.com>
+
+	* exp_attr.adb (Expand_N_Attribute_Reference): Don't expand
+	Elab_Spec/Body attrs in CodePeer_Mode.
+
+2011-08-03  Javier Miranda  <miranda@adacore.com>
+
+	* exp_aggr.adb (Flatten): Convert to positional form aggregates whose
+	low bound is not known at compile time but they have no others choice.
+	Done because in this case the bounds can be obtained directly from the
+	aggregate.
+
+2011-08-03  Ed Falis  <falis@adacore.com>
+
+	* s-tasinf-vxworks.ads: Update comment to reflect 0 indexing of CPUs
+	on VxWorks SMP. Remove unusable constant ANY_CPU.
+
 2011-08-03  Emmanuel Briot  <briot@adacore.com>
 
 	* gnatcmd.adb, make.adb, prj-part.adb, prj-part.ads, prj-makr.adb,
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index c083805..b797648 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -3825,6 +3825,8 @@ package body Exp_Aggr is
          Lov : Uint;
          Hiv : Uint;
 
+         Others_Present : Boolean := False;
+
       begin
          if Nkind (Original_Node (N)) = N_String_Literal then
             return True;
@@ -3839,8 +3841,44 @@ package body Exp_Aggr is
          Lov := Expr_Value (Lo);
          Hiv := Expr_Value (Hi);
 
+         --  Check if there is an others choice
+
+         if Present (Component_Associations (N)) then
+            declare
+               Assoc   : Node_Id;
+               Choice  : Node_Id;
+
+            begin
+               Assoc := First (Component_Associations (N));
+               while Present (Assoc) loop
+                  Choice := First (Choices (Assoc));
+
+                  while Present (Choice) loop
+                     if Nkind (Choice) = N_Others_Choice then
+                        Others_Present := True;
+                     end if;
+
+                     Next (Choice);
+                  end loop;
+
+                  Next (Assoc);
+               end loop;
+            end;
+         end if;
+
+         --  If the low bound is not known at compile time and others is not
+         --  present we can proceed since the bounds can be obtained from the
+         --  aggregate.
+
+         --  Note: This case is required in VM platforms since their backends
+         --  normalize array indexes in the range 0 .. N-1. Hence, if we do
+         --  not flat an array whose bounds cannot be obtained from the type
+         --  of the index the backend has no way to properly generate the code.
+         --  See ACATS c460010 for an example.
+
          if Hiv < Lov
-           or else not Compile_Time_Known_Value (Blo)
+           or else (not Compile_Time_Known_Value (Blo)
+                     and then Others_Present)
          then
             return False;
          end if;
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 8990e0b..a2c2bcc 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, 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- --
@@ -1808,6 +1808,13 @@ package body Exp_Attr is
       when Attribute_Elab_Body |
            Attribute_Elab_Spec =>
 
+         --  Leave attribute unexpanded in CodePeer mode: the gnat2scil
+         --  back-end knows how to handle this attribute directly.
+
+         if CodePeer_Mode then
+            return;
+         end if;
+
          Elab_Body : declare
             Ent  : constant Entity_Id := Make_Temporary (Loc, 'E');
             Str  : String_Id;
diff --git a/gcc/ada/g-pehage.adb b/gcc/ada/g-pehage.adb
index 0d5e52a..b08f530 100644
--- a/gcc/ada/g-pehage.adb
+++ b/gcc/ada/g-pehage.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                     Copyright (C) 2002-2010, AdaCore                     --
+--                     Copyright (C) 2002-2011, AdaCore                     --
 --                                                                          --
 -- 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- --
@@ -103,7 +103,7 @@ package body GNAT.Perfect_Hash_Generators is
    No_Table  : constant Table_Id  := -1;
 
    type Word_Type is new String_Access;
-   procedure Free_Word (W : in out Word_Type);
+   procedure Free_Word (W : in out Word_Type) renames Free;
    function New_Word (S : String) return Word_Type;
 
    procedure Resize_Word (W : in out Word_Type; Len : Natural);
@@ -913,8 +913,14 @@ package body GNAT.Perfect_Hash_Generators is
       --  ones) to avoid memory leaks.
 
       for W in 0 .. WT.Last loop
-         Free_Word (WT.Table (W));
+         --  Note: WT.Table (NK) is a temporary variable, do not free it since
+         --  this would cause a double free.
+
+         if W /= NK then
+            Free_Word (WT.Table (W));
+         end if;
       end loop;
+
       WT.Release;
       IT.Release;
 
@@ -948,17 +954,6 @@ package body GNAT.Perfect_Hash_Generators is
       Min_Key_Len := 0;
    end Finalize;
 
-   ---------------
-   -- Free_Word --
-   ---------------
-
-   procedure Free_Word (W : in out Word_Type) is
-   begin
-      if W /= null then
-         Free (W);
-      end if;
-   end Free_Word;
-
    ----------------------------
    -- Generate_Mapping_Table --
    ----------------------------
@@ -1258,6 +1253,11 @@ package body GNAT.Perfect_Hash_Generators is
       --  explicitly initialized to null.
 
       WT.Set_Last (Reduced (NK - 1));
+
+      --  Note: Reduced (0) = NK + 1
+
+      WT.Table (NK) := null;
+
       for W in 0 .. NK - 1 loop
          WT.Table (Reduced (W)) := null;
       end loop;
diff --git a/gcc/ada/s-tasinf-vxworks.ads b/gcc/ada/s-tasinf-vxworks.ads
index 18b2ad4..db6bc56 100644
--- a/gcc/ada/s-tasinf-vxworks.ads
+++ b/gcc/ada/s-tasinf-vxworks.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, 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- --
@@ -76,10 +76,7 @@ package System.Task_Info is
    ------------------
 
    subtype Task_Info_Type is Interfaces.C.int;
-   --  This is a CPU number (positive)
-
-   Any_CPU : constant Task_Info_Type := 0;
-   --  Allow task to run on any CPU
+   --  This is a CPU number (natural - CPUs are 0-indexed on VxWorks)
 
    use type Interfaces.C.int;
 
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index 67a53e3..fddb704c 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -688,9 +688,55 @@ package body Sem_Ch8 is
       T   : Entity_Id;
       T2  : Entity_Id;
 
+      procedure Check_Constrained_Object;
+      --  If the nominal type is unconstrained but the renamed object is
+      --  constrained, as can happen with renaming an explicit dereference or
+      --  a function return, build a constrained subtype from the object. If
+      --  the renaming is for a formal in an accept statement, the analysis
+      --  has already established its actual subtype. This is only relevant
+      --  if the renamed object is an explicit dereference.
+
       function In_Generic_Scope (E : Entity_Id) return Boolean;
       --  Determine whether entity E is inside a generic cope
 
+      ------------------------------
+      -- Check_Constrained_Object --
+      ------------------------------
+
+      procedure Check_Constrained_Object is
+         Loc  : constant Source_Ptr := Sloc (N);
+         Subt : Entity_Id;
+
+      begin
+         if (Nkind (Nam) = N_Function_Call
+              or else Nkind (Nam) = N_Explicit_Dereference)
+           and then Is_Composite_Type (Etype (Nam))
+           and then not Is_Constrained (Etype (Nam))
+           and then not Has_Unknown_Discriminants (Etype (Nam))
+           and then Expander_Active
+         then
+            --  If Actual_Sbutype is already set, nothing to do.
+
+            if (Ekind (Id) = E_Variable
+                 or else Ekind (Id) = E_Constant)
+              and then Present (Actual_Subtype (Id))
+            then
+               null;
+
+            else
+               Subt := Make_Temporary (Loc, 'T');
+               Remove_Side_Effects (Nam);
+               Insert_Action (N,
+                 Make_Subtype_Declaration (Loc,
+                   Defining_Identifier => Subt,
+                   Subtype_Indication  =>
+                     Make_Subtype_From_Expr (Nam, Etype (Nam))));
+               Rewrite (Subtype_Mark (N), New_Occurrence_Of (Subt, Loc));
+               Set_Etype (Nam, Subt);
+            end if;
+         end if;
+      end Check_Constrained_Object;
+
       ----------------------
       -- In_Generic_Scope --
       ----------------------
@@ -910,33 +956,11 @@ package body Sem_Ch8 is
                      Nam);
                end if;
 
-               --  If the function call returns an unconstrained type, we must
-               --  build a constrained subtype for the new entity, in a way
-               --  similar to what is done for an object declaration with an
-               --  unconstrained nominal type.
-
-               if Is_Composite_Type (Etype (Nam))
-                 and then not Is_Constrained (Etype (Nam))
-                 and then not Has_Unknown_Discriminants (Etype (Nam))
-                 and then Expander_Active
-               then
-                  declare
-                     Loc  : constant Source_Ptr := Sloc (N);
-                     Subt : constant Entity_Id  := Make_Temporary (Loc, 'T');
-                  begin
-                     Remove_Side_Effects (Nam);
-                     Insert_Action (N,
-                       Make_Subtype_Declaration (Loc,
-                         Defining_Identifier => Subt,
-                         Subtype_Indication  =>
-                           Make_Subtype_From_Expr (Nam, Etype (Nam))));
-                     Rewrite (Subtype_Mark (N), New_Occurrence_Of (Subt, Loc));
-                     Set_Etype (Nam, Subt);
-                  end;
-               end if;
          end case;
       end if;
 
+      Check_Constrained_Object;
+
       --  An object renaming requires an exact match of the type. Class-wide
       --  matching is not allowed.
 
diff --git a/gcc/ada/tracebak.c b/gcc/ada/tracebak.c
index 23fc5c7..2e29285 100644
--- a/gcc/ada/tracebak.c
+++ b/gcc/ada/tracebak.c
@@ -219,7 +219,14 @@ struct layout
 
 #define FRAME_OFFSET(FP) 0
 #define PC_ADJUST -4
-#define STOP_FRAME(CURRENT, TOP_STACK) ((void *) (CURRENT) < (TOP_STACK))
+
+/* Eventhough the base PPC ABI states that a toplevel frame entry
+   should to feature a null backchain, AIX might expose a null return
+   address instead.  */
+
+#define STOP_FRAME(CURRENT, TOP_STACK) \
+  (((void *) (CURRENT) < (TOP_STACK)) \
+   || (CURRENT)->return_address == NULL)
 
 /* The PPC ABI has an interesting specificity: the return address saved by a
    function is located in it's caller's frame, and the save operation only