ada: Add minimal support for other delayed aspects on controlled objects

This extends the processing done for the Address aspect to other delayed
aspects.  The External_Name aspect is also reclassified as a representation
aspect and the three representation aspects External_Name, Link_Name and
Linker_Section are moved from the Always_Delay to the Rep_Aspect category,
which makes it possible not to delay them in most cases with a small tweak.

gcc/ada/ChangeLog:

	* aspects.ads (Is_Representation_Aspect): True for External_Name.
	(Aspect_Delay): Use Rep_Aspect for External_Name, Link_Name and
	Linker_Section.
	* einfo.ads (Initialization_Statements): Document extended usage.
	* exp_util.adb (Needs_Initialization_Statements): Return True for
	all delayed aspects.
	* freeze.adb (Check_Address_Clause): Do not move the initialization
	expression here...
	(Freeze_Object_Declaration): ...but here instead, as well as for all
	delayed aspects.  Remove test for pragma Linker_Section.
	* sem_ch13.adb (Analyze_One_Aspect): Do not delay in the Rep_Aspect
	case if the expression is a string literal.

diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads
index ebf09602ea5283360261ace8b5c99e498fc22c15..100ab4d55a8a41fdb3863fb7d9f08b043619a5f3 100644 (file)
--- a/gcc/ada/aspects.ads
+++ b/gcc/ada/aspects.ads
@@ -543,7 +543,7 @@ package Aspects is
       Aspect_Exclusive_Functions          => False,
       Aspect_Extended_Access              => True,
       Aspect_External_Initialization      => False,
-      Aspect_External_Name                => False,
+      Aspect_External_Name                => True,
       Aspect_External_Tag                 => False,
       Aspect_Finalizable                  => False,
       Aspect_First_Controlling_Parameter  => False,
@@ -973,7 +973,6 @@ package Aspects is
       Aspect_Dynamic_Predicate            => Always_Delay,
       Aspect_Elaborate_Body               => Always_Delay,
       Aspect_Exclusive_Functions          => Always_Delay,
-      Aspect_External_Name                => Always_Delay,
       Aspect_External_Tag                 => Always_Delay,
       Aspect_Favor_Top_Level              => Always_Delay,
       Aspect_Finalizable                  => Always_Delay,
@@ -990,8 +989,6 @@ package Aspects is
       Aspect_Invariant                    => Always_Delay,
       Aspect_Iterable                     => Always_Delay,
       Aspect_Iterator_Element             => Always_Delay,
-      Aspect_Link_Name                    => Always_Delay,
-      Aspect_Linker_Section               => Always_Delay,
       Aspect_Lock_Free                    => Always_Delay,
       Aspect_No_Inline                    => Always_Delay,
       Aspect_No_Raise                     => Always_Delay,
@@ -1100,7 +1097,10 @@ package Aspects is
       Aspect_Bit_Order                    => Rep_Aspect,
       Aspect_Component_Size               => Rep_Aspect,
       Aspect_Extended_Access              => Rep_Aspect,
+      Aspect_External_Name                => Rep_Aspect,
       Aspect_Full_Access_Only             => Rep_Aspect,
+      Aspect_Link_Name                    => Rep_Aspect,
+      Aspect_Linker_Section               => Rep_Aspect,
       Aspect_Machine_Radix                => Rep_Aspect,
       Aspect_Object_Size                  => Rep_Aspect,
       Aspect_Pack                         => Rep_Aspect,

diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index f929c26571d6eb36712b2686ac2245485c346cb7..1a8760c0dbb19520ec0e2f29fadcd29af2c7457f 100644 (file)
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -2274,9 +2274,9 @@ package Einfo is
 --       source and initialized with an aggregate or a call expanded in place,
 --       points to a compound statement containing the assignment(s). This is
 --       used for a couple of purposes: 1) to defer the initialization to the
---       freeze point if an address aspect/clause is present for the object,
---       2) to cancel the initialization of imported objects generated by
---       Initialize_Scalars or Normalize_Scalars before the pragma Import is
+--       freeze point if an address clause or a delayed aspect is present for
+--       the object, 2) to cancel initialization of imported objects generated
+--       by Initialize_Scalars or Normalize_Scalars before the pragma Import is
 --       encountered for the object.
 
 --    Inner_Instances

diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index dd284e2a20d228d2b7e19927d38e0728a83bb5e9..e9a683f82550ec52b04eb840938e084874bb01cd 100644 (file)
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -11700,7 +11700,7 @@ package body Exp_Util is
       --  See the documentation of Initialization_Statements in Einfo
 
       return Comes_From_Source (Decl)
-        and then (Has_Aspect (Obj_Id, Aspect_Address)
+        and then (Has_Delayed_Aspects (Obj_Id)
                    or else Present (Following_Address_Clause (Decl))
                    or else Init_Or_Norm_Scalars);
    end Needs_Initialization_Statements;

diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index b2f1c3913a794ccd890304ec975ed3993d6187dd..dae1d9afcde9e3a53f970bbca36071a2cfebabd3 100644 (file)
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -98,8 +98,7 @@ package body Freeze is
 
    procedure Check_Address_Clause (E : Entity_Id);
    --  Apply legality checks to address clauses for object declarations,
-   --  at the point the object is frozen. Also ensure any initialization is
-   --  performed only after the object has been frozen.
+   --  at the point the object is frozen.
 
    procedure Check_Component_Storage_Order
      (Encl_Type        : Entity_Id;
@@ -636,11 +635,9 @@ package body Freeze is
       Addr       : constant Node_Id   := Address_Clause (E);
       Typ        : constant Entity_Id := Etype (E);
 
-      Assign : Node_Id;
-      Decl   : Node_Id;
-      Expr   : Node_Id;
-      Init   : Node_Id;
-      Lhs    : Node_Id;
+      Decl : Node_Id;
+      Expr : Node_Id;
+      Init : Node_Id;
 
    begin
       if Present (Addr) then
@@ -744,47 +741,6 @@ package body Freeze is
                end if;
             end;
          end if;
-
-         --  Remove side effects from initial expression, except in the case of
-         --  limited build-in-place calls and aggregates, which have their own
-         --  expansion elsewhere. This exception is necessary to avoid copying
-         --  limited objects.
-
-         if Present (Init)
-           and then not Is_Inherently_Limited_Type (Typ)
-         then
-            --  Capture initialization value at point of declaration, and make
-            --  explicit assignment legal, because object may be a constant.
-
-            Remove_Side_Effects (Init);
-            Lhs := New_Occurrence_Of (E, Sloc (Decl));
-            Set_Assignment_OK (Lhs);
-
-            Assign :=
-              Make_Assignment_Statement (Sloc (Decl),
-                Name       => Lhs,
-                Expression => Init);
-
-            Set_No_Initialization (Decl);
-
-            --  If the initialization expression is an aggregate, we do not
-            --  adjust after the assignment but, in either case, we do not
-            --  finalize before since the object is now uninitialized. Note
-            --  that Make_Tag_Ctrl_Assignment will also automatically insert
-            --  the tag assignment in the tagged case.
-
-            if Nkind (Unqualify (Init)) = N_Aggregate then
-               Set_No_Ctrl_Actions (Assign);
-            else
-               Set_No_Finalize_Actions (Assign);
-            end if;
-
-            --  Move initialization to freeze actions, once the object has
-            --  been frozen and the address clause alignment check has been
-            --  performed.
-
-            Append_Freeze_Action (E, Assign);
-         end if;
       end if;
    end Check_Address_Clause;
 
@@ -4229,6 +4185,8 @@ package body Freeze is
       -------------------------------
 
       procedure Freeze_Object_Declaration (E : Entity_Id) is
+         Decl : constant Node_Id := Declaration_Node (E);
+
          procedure Check_Large_Modular_Array (Typ : Entity_Id);
          --  Check that the size of array type Typ can be computed without
          --  overflow, and generates a Storage_Error otherwise. This is only
@@ -4307,11 +4265,11 @@ package body Freeze is
                                   Make_Itype_Reference (Obj_Loc);
                   begin
                      Set_Itype (Ref_Node, Etype (E));
-                     Insert_Action (Declaration_Node (E), Ref_Node);
+                     Insert_Action (Decl, Ref_Node);
                   end;
                end if;
 
-               Insert_Action (Declaration_Node (E),
+               Insert_Action (Decl,
                  Make_Raise_Storage_Error (Obj_Loc,
                    Condition =>
                      Make_Op_Ge (Obj_Loc,
@@ -4494,45 +4452,63 @@ package body Freeze is
          --  checks to freeze time since pragma Import inhibits default
          --  initialization and thus pragma Import affects these checks.
 
-         Validate_Object_Declaration (Declaration_Node (E));
+         Validate_Object_Declaration (Decl);
 
-         --  If there is an address clause, check that it is valid and if need
-         --  be move initialization to the freeze node.
+         --  If there is an address clause, check that it is valid
 
          Check_Address_Clause (E);
 
-         --  Similar processing is needed for aspects that may affect object
-         --  layout, like Address, if there is an initialization expression.
-         --  We don't do this if there is a pragma Linker_Section, because it
-         --  would prevent the back end from statically initializing the
-         --  object; we don't want elaboration code in that case.
+         --  If the object has an address clause or a delayed aspect, remove
+         --  the side effects from initial expression, except in the case of
+         --  limited build-in-place calls and aggregates, which have their own
+         --  expansion elsewhere. This exception is necessary to avoid copying
+         --  limited objects.
 
-         if Has_Delayed_Aspects (E)
-           and then Expander_Active
-           and then Is_Array_Type (Typ)
-           and then Present (Expression (Declaration_Node (E)))
-           and then No (Linker_Section_Pragma (E))
+         if Expander_Active
+           and then
+             (Present (Address_Clause (E)) or else Has_Delayed_Aspects (E))
+           and then Present (Expression (Decl))
+           and then not No_Initialization (Decl)
+           and then not Is_Inherently_Limited_Type (Typ)
          then
             declare
-               Decl : constant Node_Id := Declaration_Node (E);
+               Init : constant Node_Id := Expression (Decl);
                Lhs  : constant Node_Id := New_Occurrence_Of (E, Loc);
 
+               Assign : Node_Id;
+
             begin
                --  Capture initialization value at point of declaration, and
                --  make explicit assignment legal, because object may be a
                --  constant.
 
-               Remove_Side_Effects (Expression (Decl));
+               Remove_Side_Effects (Init);
                Set_Assignment_OK (Lhs);
 
-               --  Move initialization to freeze actions
-
-               Append_Freeze_Action (E,
-                 Make_Assignment_Statement (Loc,
+               Assign :=
+                 Make_Assignment_Statement (Sloc (Decl),
                    Name       => Lhs,
-                   Expression => Expression (Decl)));
+                   Expression => Init);
 
                Set_No_Initialization (Decl);
+
+               --  If the initialization expression is an aggregate, we do not
+               --  adjust after the assignment but, in either case, we do not
+               --  finalize before since the object is now uninitialized. Note
+               --  that Make_Tag_Ctrl_Assignment will also automatically insert
+               --  the tag assignment in the tagged case.
+
+               if Nkind (Unqualify (Init)) = N_Aggregate then
+                  Set_No_Ctrl_Actions (Assign);
+               else
+                  Set_No_Finalize_Actions (Assign);
+               end if;
+
+               --  Move initialization to freeze actions, once the object has
+               --  been frozen and the address clause alignment check has been
+               --  performed.
+
+               Append_Freeze_Action (E, Assign);
             end;
          end if;
 
@@ -4574,8 +4550,7 @@ package body Freeze is
             null;
 
          elsif Has_Default_Initialization (E) then
-            Check_Restriction
-              (No_Default_Initialization, Declaration_Node (E));
+            Check_Restriction (No_Default_Initialization, Decl);
          end if;
 
          --  Ensure that a variable subject to pragma Thread_Local_Storage

diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 2d13ecc2f9835310a96a86117cf1e9b208fc65ec..1a3a16ac9ee5913c48a0505dd90f8fe26903754a 100644 (file)
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -2868,11 +2868,12 @@ package body Sem_Ch13 is
                   --  For non-Boolean aspects, if the expression has the form
                   --  of an integer literal, then do not delay, since we know
                   --  the value cannot change. This optimization catches most
-                  --  rep clause cases.
+                  --  rep clause cases. Likewise for a string literal.
 
                   elsif A_Id not in Boolean_Aspects
                     and then Present (Expr)
-                    and then Nkind (Expr) = N_Integer_Literal
+                    and then
+                      Nkind (Expr) in N_Integer_Literal | N_String_Literal
                   then
                      Delay_Required := False;