[multiple changes]

2011-08-03  Robert Dewar  <dewar@adacore.com>

	* exp_ch4.adb (Optimize_Length_Check): Fix bad handling of case where
	comparison operand is variable, and turns out to be zero or negative.

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

	* exp_intr.adb
	(Expand_Dispatching_Constructor_Call): Disable expansion of
	code required for native targets. Done to avoid generating
	references to unavailable runtime entities in VM targets.
	* exp_ch3.adb
	(Expand_N_Object_Declaration): Add missing support to handle
	the explicit initialization of class-wide interface objects.
	Fix documentation.

2011-08-03  Matthew Heaney  <heaney@adacore.com>

	* a-cobove.adb (Merge): Move source onto target, instead of using Assign

2011-08-03  Matthew Heaney  <heaney@adacore.com>

	* a-cbdlli.adb (Splice): move source items from first to last

2011-08-03  Yannick Moy  <moy@adacore.com>

	* sem_util.ads: comment added.

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

	* exp_aggr.adb
	(Expand_Record_Aggregate): In VM targets disable the expansion into
	assignments of aggregates whose type is not known at compile time.

From-SVN: r177233

8 files changed, 92 insertions, 35 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 2612b17..64dd744 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,37 @@
+2011-08-03  Robert Dewar  <dewar@adacore.com>
+
+	* exp_ch4.adb (Optimize_Length_Check): Fix bad handling of case where
+	comparison operand is variable, and turns out to be zero or negative.
+
+2011-08-03  Javier Miranda  <miranda@adacore.com>
+
+	* exp_intr.adb
+	(Expand_Dispatching_Constructor_Call): Disable expansion of
+	code required for native targets. Done to avoid generating
+	references to unavailable runtime entities in VM targets.
+	* exp_ch3.adb
+	(Expand_N_Object_Declaration): Add missing support to handle
+	the explicit initialization of class-wide interface objects.
+	Fix documentation.
+
+2011-08-03  Matthew Heaney  <heaney@adacore.com>
+
+	* a-cobove.adb (Merge): Move source onto target, instead of using Assign
+
+2011-08-03  Matthew Heaney  <heaney@adacore.com>
+
+	* a-cbdlli.adb (Splice): move source items from first to last
+
+2011-08-03  Yannick Moy  <moy@adacore.com>
+
+	* sem_util.ads: comment added.
+
+2011-08-03  Javier Miranda  <miranda@adacore.com>
+
+	* exp_aggr.adb
+	(Expand_Record_Aggregate): In VM targets disable the expansion into
+	assignments of aggregates whose type is not known at compile time.
+
 2011-08-03  Ed Schonberg  <schonberg@adacore.com>
 
 	* exp_ch9.adb (Build_Renamed_Formal_Declaration): common procedure for
diff --git a/gcc/ada/a-cbdlli.adb b/gcc/ada/a-cbdlli.adb
index 2dd8a5c..61615a0 100644
--- a/gcc/ada/a-cbdlli.adb
+++ b/gcc/ada/a-cbdlli.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-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- --
@@ -1486,10 +1486,9 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
            "attempt to tamper with cursors of Source (list is busy)";
       end if;
 
-      loop
-         Insert (Target, Before, Source.Nodes (Source.Last).Element);
-         Delete_Last (Source);
-         exit when Is_Empty (Source);
+      while not Is_Empty (Source) loop
+         Insert (Target, Before, Source.Nodes (Source.First).Element);
+         Delete_First (Source);
       end loop;
    end Splice;
 
diff --git a/gcc/ada/a-cobove.adb b/gcc/ada/a-cobove.adb
index 759bab4..eaef697 100644
--- a/gcc/ada/a-cobove.adb
+++ b/gcc/ada/a-cobove.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-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- --
@@ -762,7 +762,7 @@ package body Ada.Containers.Bounded_Vectors is
 
       begin
          if Target.Is_Empty then
-            Target.Assign (Source);
+            Move (Target => Target, Source => Source);
             return;
          end if;
 
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 536b317..079db9c 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.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- --
@@ -5649,7 +5649,9 @@ package body Exp_Aggr is
       --  Gigi doesn't handle properly temporaries of variable size
       --  so we generate it in the front-end
 
-      elsif not Size_Known_At_Compile_Time (Typ) then
+      elsif not Size_Known_At_Compile_Time (Typ)
+        and then Tagged_Type_Expansion
+      then
          Convert_To_Assignments (N, Typ);
 
       --  Temporaries for controlled aggregates need to be attached to a
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 540d395..fc999c6 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -4477,14 +4477,6 @@ package body Exp_Ch3 is
    -- Expand_N_Object_Declaration --
    ---------------------------------
 
-   --  First we do special processing for objects of a tagged type where this
-   --  is the point at which the type is frozen. The creation of the dispatch
-   --  table and the initialization procedure have to be deferred to this
-   --  point, since we reference previously declared primitive subprograms.
-
-   --  The above comment is in the wrong place, it should be at the proper
-   --  point in this routine ???
-
    procedure Expand_N_Object_Declaration (N : Node_Id) is
       Def_Id   : constant Entity_Id  := Defining_Identifier (N);
       Expr     : constant Node_Id    := Expression (N);
@@ -4528,6 +4520,12 @@ package body Exp_Ch3 is
          return;
       end if;
 
+      --  First we do special processing for objects of a tagged type where
+      --  this is the point at which the type is frozen. The creation of the
+      --  dispatch table and the initialization procedure have to be deferred
+      --  to this point, since we reference previously declared primitive
+      --  subprograms.
+
       --  Force construction of dispatch tables of library level tagged types
 
       if Tagged_Type_Expansion
@@ -4993,11 +4991,33 @@ package body Exp_Ch3 is
                   Set_Homonym (Defining_Identifier (N), Homonym (Def_Id));
                   Exchange_Entities (Defining_Identifier (N), Def_Id);
                end;
+
+            --  Handle initialization of class-wide interface object in VM
+            --  targets
+
+            elsif not Tagged_Type_Expansion then
+
+               --  Replace
+               --     CW : I'Class := Obj;
+               --  by
+               --     CW : I'Class;
+               --     CW := I'Class (Obj); [1]
+
+               --  The assignment [1] is later expanded in a dispatching
+               --  call to _assign
+
+               Set_Expression (N, Empty);
+
+               Insert_Action (N,
+                 Make_Assignment_Statement (Loc,
+                   Name       => New_Reference_To (Def_Id, Loc),
+                   Expression => Convert_To (Typ,
+                                   Relocate_Node (Expr))));
             end if;
 
             return;
 
-         --  Comment needed here, what case is this???
+         --  Common case of explicit object initialization
 
          else
             --  In most cases, we must check that the initial value meets any
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index abaf676..0298487 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -10209,11 +10209,11 @@ package body Exp_Ch4 is
       --  Kind of comparison operator, gets flipped if operands backwards
 
       function Is_Optimizable (N : Node_Id) return Boolean;
-      --  Tests N to see if it is an optimizable comparison value (defined
-      --  as constant zero or one, or something else where the value is known
-      --  to be in range of 32-bits, and where the corresponding Length value
-      --  is also known to be 32-bits. If result is true, sets Is_Zero, Ityp,
-      --  and Comp accordingly.
+      --  Tests N to see if it is an optimizable comparison value (defined as
+      --  constant zero or one, or something else where the value is known to
+      --  be positive and in the range of 32-bits, and where the corresponding
+      --  Length value is also known to be 32-bits. If result is true, sets
+      --  Is_Zero, Ityp, and Comp accordingly.
 
       function Is_Entity_Length (N : Node_Id) return Boolean;
       --  Tests if N is a length attribute applied to a simple entity. If so,
@@ -10293,14 +10293,14 @@ package body Exp_Ch4 is
          Determine_Range (N, OK, Lo, Hi, Assume_Valid => True);
 
          if not OK
-           or else Lo < UI_From_Int (Int'First)
+           or else Lo < Uint_1
            or else Hi > UI_From_Int (Int'Last)
          then
             return False;
          end if;
 
-         --  Comparison value was within 32-bits, so now we must check the
-         --  index value to make sure it is also within 32-bits.
+         --  Comparison value was within range, so now we must check the index
+         --  value to make sure it is also within 32-bits.
 
          Indx := First_Index (Etype (Ent));
 
diff --git a/gcc/ada/exp_intr.adb b/gcc/ada/exp_intr.adb
index 0dfbac1..dff0044 100644
--- a/gcc/ada/exp_intr.adb
+++ b/gcc/ada/exp_intr.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- --
@@ -233,6 +233,7 @@ package body Exp_Intr is
 
          if not Is_Ancestor (Etype (Result_Typ), Etype (Tag_Arg),
                              Use_Full_View => True)
+           and then Tagged_Type_Expansion
          then
             --  Obtain the reference to the Ada.Tags service before generating
             --  the Object_Declaration node to ensure that if this service is
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 371afbb..c176179 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -279,14 +279,15 @@ package Sem_Util is
 
    procedure Mark_Non_ALFA_Subprogram;
    --  If Current_Subprogram is not Empty, mark either its specification or its
-   --  body as not being in ALFA. If this procedure is called during the
-   --  analysis of a precondition or postcondition, as indicated by the flag
-   --  In_Pre_Post_Expression, mark the specification as not being in ALFA.
-   --  Otherwise, mark the body as not being in ALFA.
-   --
-   --  I would really like to see more comments on this peculiar processing
-   --  for precondition/postcondition, the comment above says what is done
-   --  but not why???
+   --  body as not being in ALFA. This procedure may be called either during
+   --  the analysis of a precondition or postcondition, as indicated by the
+   --  flag In_Pre_Post_Expression, or during the analysis of a subprogram's
+   --  body. In the first case, the specification of Current_Subprogram must be
+   --  marked as not being in ALFA, as the contract is considered to be part of
+   --  the specification, so that calls to this subprogram are not in ALFA. In
+   --  the second case, mark the body as not being in ALFA, which does not
+   --  prevent the subprogram's specification, and calls to the subprogram, to
+   --  be in ALFA.
 
    function Defining_Entity (N : Node_Id) return Entity_Id;
    --  Given a declaration N, returns the associated defining entity. If the