[multiple changes]
authorArnaud Charlet <charlet@gcc.gnu.org>
Wed, 3 Aug 2011 07:52:00 +0000 (09:52 +0200)
committerArnaud Charlet <charlet@gcc.gnu.org>
Wed, 3 Aug 2011 07:52:00 +0000 (09:52 +0200)
2011-08-03  Robert Dewar  <dewar@adacore.com>

* sem_util.ads, exp_aggr.adb, exp_ch3.adb: Minor reformatting.

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

* sem_ch3.adb (Analyze_Object_Declaration): if a constant object of an
unconstrained type with discriminants is initialized with an aggregate,
use the constrained subtype of the aggregate as the type of the object,
because it is immutable, and this allows the back-end to generate no
code for the object declaration.

From-SVN: r177234

gcc/ada/ChangeLog
gcc/ada/exp_aggr.adb
gcc/ada/exp_ch3.adb
gcc/ada/sem_ch3.adb
gcc/ada/sem_util.ads

index 64dd7442b5e00c9a6a7bd2b4d27a3c8ba168a50f..47ec9bf44f76003e6748b10d6b39af5e7227024b 100644 (file)
@@ -1,3 +1,15 @@
+2011-08-03  Robert Dewar  <dewar@adacore.com>
+
+       * sem_util.ads, exp_aggr.adb, exp_ch3.adb: Minor reformatting.
+
+2011-08-03  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_ch3.adb (Analyze_Object_Declaration): if a constant object of an
+       unconstrained type with discriminants is initialized with an aggregate,
+       use the constrained subtype of the aggregate as the type of the object,
+       because it is immutable, and this allows the back-end to generate no
+       code for the object declaration.
+
 2011-08-03  Robert Dewar  <dewar@adacore.com>
 
        * exp_ch4.adb (Optimize_Length_Check): Fix bad handling of case where
index 079db9c9564e2fc865f8ac2723c4fd3eb84364e0..7ff4b7a49b1dca6d37c1670a48267f96f6383423 100644 (file)
@@ -308,23 +308,21 @@ package body Exp_Aggr is
       Lov  : Uint;
       Hiv  : Uint;
 
-      --  The following constant determines the maximum size of an
-      --  array aggregate produced by converting named to positional
-      --  notation (e.g. from others clauses). This avoids running
-      --  away with attempts to convert huge aggregates, which hit
-      --  memory limits in the backend.
-
-      --  The normal limit is 5000, but we increase this limit to
-      --  2**24 (about 16 million) if Restrictions (No_Elaboration_Code)
-      --  or Restrictions (No_Implicit_Loops) is specified, since in
-      --  either case, we are at risk of declaring the program illegal
-      --  because of this limit.
+      --  The following constant determines the maximum size of an array
+      --  aggregate produced by converting named to positional notation (e.g.
+      --  from others clauses). This avoids running away with attempts to
+      --  convert huge aggregates, which hit memory limits in the backend.
+
+      --  The normal limit is 5000, but we increase this limit to 2**24 (about
+      --  16 million) if Restrictions (No_Elaboration_Code) or Restrictions
+      --  (No_Implicit_Loops) is specified, since in either case, we are at
+      --  risk of declaring the program illegal because of this limit.
 
       Max_Aggr_Size : constant Nat :=
                         5000 + (2 ** 24 - 5000) *
                           Boolean'Pos
                             (Restriction_Active (No_Elaboration_Code)
-                               or else
+                              or else
                              Restriction_Active (No_Implicit_Loops));
 
       function Component_Count (T : Entity_Id) return Int;
@@ -5458,10 +5456,11 @@ package body Exp_Aggr is
                 New_Occurrence_Of
                   (Node (First_Elmt (Access_Disp_Table (Typ))), Loc),
               Parent_Expr => A);
+
+         --  No tag is needed in the case of a VM
+
          else
-            --  No tag is needed in the case of a VM
-            Expand_Record_Aggregate (N,
-              Parent_Expr => A);
+            Expand_Record_Aggregate (N, Parent_Expr => A);
          end if;
       end if;
 
@@ -5646,17 +5645,17 @@ package body Exp_Aggr is
             Set_Expansion_Delayed (N, False);
          end if;
 
-      --  Gigi doesn't handle properly temporaries of variable size
-      --  so we generate it in the front-end
+      --  Gigi doesn't properly handle temporaries of variable size so we
+      --  generate it in the front-end
 
       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
-      --  final chain in order to be properly finalized, so it has to
-      --  be created in the front-end
+      --  Temporaries for controlled aggregates need to be attached to a final
+      --  chain in order to be properly finalized, so it has to be created in
+      --  the front-end
 
       elsif Is_Controlled (Typ)
         or else Has_Controlled_Component (Base_Type (Typ))
@@ -5695,9 +5694,14 @@ package body Exp_Aggr is
       --  If some components are mutable, the size of the aggregate component
       --  may be distinct from the default size of the type component, so
       --  we need to expand to insure that the back-end copies the proper
-      --  size of the data.
+      --  size of the data. However, if the aggregate is the initial value of
+      --  a constant, the target is immutable and may be built statically.
 
-      elsif Has_Mutable_Components (Typ) then
+      elsif Has_Mutable_Components (Typ)
+        and then
+          (Nkind (Parent (N)) /= N_Object_Declaration
+             or else not Constant_Present (Parent (N)))
+      then
          Convert_To_Assignments (N, Typ);
 
       --  If the type involved has any non-bit aligned components, then we are
index fc999c6d4d6471de5865bace968513dc209fbb6f..f4e103facc593fa52133417f9b224c8c38eeb7a8 100644 (file)
@@ -5011,8 +5011,7 @@ package body Exp_Ch3 is
                Insert_Action (N,
                  Make_Assignment_Statement (Loc,
                    Name       => New_Reference_To (Def_Id, Loc),
-                   Expression => Convert_To (Typ,
-                                   Relocate_Node (Expr))));
+                   Expression => Convert_To (Typ, Relocate_Node (Expr))));
             end if;
 
             return;
index 79a0828603d7afbea587c28c7dfe863a8cfe58d6..6a1e3e940ea8fb4efdd65104a1779abb9229bd71 100644 (file)
@@ -3401,6 +3401,18 @@ package body Sem_Ch3 is
          --  It is unclear why this should make it acceptable to gcc. ???
 
          Remove_Side_Effects (E);
+
+      elsif not Is_Constrained (T)
+        and then Has_Discriminants (T)
+        and then Constant_Present (N)
+        and then not Has_Unchecked_Union (T)
+        and then Nkind (E) = N_Aggregate
+      then
+         --  If this is a constant declaration of an unconstrained type and
+         --  the initialization is an aggregate, we can use the subtype of the
+         --  aggregate for the declared entity because it is immutable.
+
+         Act_T := Etype (E);
       end if;
 
       --  Check No_Wide_Characters restriction
index c176179058c50956f426ee03a4830d6e94ee81d4..3d11069f476808c86ca27583e0904d3c50f536f2 100644 (file)
@@ -279,15 +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. 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
+   --  body as not being in ALFA. This procedure may be called 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.
+   --  prevent the subprogram's specification, and calls to the subprogram,
+   --  from being in ALFA.
 
    function Defining_Entity (N : Node_Id) return Entity_Id;
    --  Given a declaration N, returns the associated defining entity. If the