einfo.ads, einfo.adb (Suppress_Initialization): Replaces Suppress_Init_Procs.

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

	* einfo.ads, einfo.adb (Suppress_Initialization): Replaces
	Suppress_Init_Procs.
	* exp_ch3.adb, exp_disp.adb, freeze.adb: Use
	Suppress_Initialization/Initialization_Suppressed.
	* gnat_rm.texi: New documentation for pragma Suppress_Initialization
	* sem_aux.ads, sem_aux.adb (Initialization_Suppressed): New function
	* sem_dist.adb: Use Suppress_Initialization/Initialization_Suppressed
	* sem_prag.adb: New processing for pragma Suppress_Initialization.

From-SVN: r177161

gcc/ada/ChangeLog

 2011-08-02  Robert Dewar  <dewar@adacore.com>
 
+	* einfo.ads, einfo.adb (Suppress_Initialization): Replaces
+	Suppress_Init_Procs.
+	* exp_ch3.adb, exp_disp.adb, freeze.adb: Use
+	Suppress_Initialization/Initialization_Suppressed.
+	* gnat_rm.texi: New documentation for pragma Suppress_Initialization
+	* sem_aux.ads, sem_aux.adb (Initialization_Suppressed): New function
+	* sem_dist.adb: Use Suppress_Initialization/Initialization_Suppressed
+	* sem_prag.adb: New processing for pragma Suppress_Initialization.
+
+2011-08-02  Robert Dewar  <dewar@adacore.com>
+
 	* gnat_rm.texi, a-tags.ads, sem_prag.adb, sem_ch12.adb, exp_disp.adb:
 	Minor reformatting.
 

gcc/ada/einfo.adb

@@ -357,7 +357,7 @@ package body Einfo is
    --    Is_Called                       Flag102
    --    Is_Completely_Hidden            Flag103
    --    Address_Taken                   Flag104
-   --    Suppress_Init_Proc              Flag105
+   --    Suppress_Initialization         Flag105
    --    Is_Limited_Composite            Flag106
    --    Is_Private_Composite            Flag107
    --    Default_Expressions_Processed   Flag108
@@ -2686,10 +2686,11 @@ package body Einfo is
       return Flag148 (Id);
    end Suppress_Elaboration_Warnings;
 
-   function Suppress_Init_Proc (Id : E) return B is
+   function Suppress_Initialization (Id : E) return B is
    begin
-      return Flag105 (Base_Type (Id));
-   end Suppress_Init_Proc;
+      pragma Assert (Is_Type (Id));
+      return Flag105 (Id);
+   end Suppress_Initialization;
 
    function Suppress_Style_Checks (Id : E) return B is
    begin
@@ -5204,11 +5205,11 @@ package body Einfo is
       Set_Flag148 (Id, V);
    end Set_Suppress_Elaboration_Warnings;
 
-   procedure Set_Suppress_Init_Proc (Id : E; V : B := True) is
+   procedure Set_Suppress_Initialization (Id : E; V : B := True) is
    begin
-      pragma Assert (Id = Base_Type (Id));
+      pragma Assert (Is_Type (Id));
       Set_Flag105 (Id, V);
-   end Set_Suppress_Init_Proc;
+   end Set_Suppress_Initialization;
 
    procedure Set_Suppress_Style_Checks (Id : E; V : B := True) is
    begin
@@ -7567,7 +7568,7 @@ package body Einfo is
       W ("Static_Elaboration_Desired",      Flag77  (Id));
       W ("Strict_Alignment",                Flag145 (Id));
       W ("Suppress_Elaboration_Warnings",   Flag148 (Id));
-      W ("Suppress_Init_Proc",              Flag105 (Id));
+      W ("Suppress_Initialization",         Flag105 (Id));
       W ("Suppress_Style_Checks",           Flag165 (Id));
       W ("Suppress_Value_Tracking_On_Call", Flag217 (Id));
       W ("Treat_As_Volatile",               Flag41  (Id));

gcc/ada/einfo.ads

@@ -3709,10 +3709,15 @@ package Einfo is
 --       elaboration, and it is set on variables when a warning is given to
 --       avoid multiple elaboration warnings for the same variable.
 
---    Suppress_Init_Proc (Flag105) [base type only]
---       Present in all type entities. Set to suppress the generation of
---       initialization procedures where they are known to be not needed.
---       For example, the enumeration image table entity uses this flag.
+--    Suppress_Initialization (Flag105)
+--       Present in all type and subtype entities. If set for the base type,
+--       then the generation of initialization procedures is suppressed for the
+--       type. Any other implicit initialiation (e.g. from the use of pragma
+--       Initialize_Scalars) is also suppressed if this flag is set either for
+--       the subtype in question, or for the base type. Set by use of pragma
+--       Suppress_Initialization and also for internal entities where we know
+--       that no initialization is required. For example, enumeration image
+--       table entities set it.
 
 --    Suppress_Style_Checks (Flag165)
 --       Present in all entities. Suppresses any style checks specifically
@@ -4849,7 +4854,7 @@ package Einfo is
    --    Size_Depends_On_Discriminant        (Flag177)
    --    Size_Known_At_Compile_Time          (Flag92)
    --    Strict_Alignment                    (Flag145)  (base type only)
-   --    Suppress_Init_Proc                  (Flag105)  (base type only)
+   --    Suppress_Initialization             (Flag105)
    --    Treat_As_Volatile                   (Flag41)
    --    Universal_Aliasing                  (Flag216)  (base type only)
 
@@ -6280,7 +6285,7 @@ package Einfo is
    function String_Literal_Low_Bound            (Id : E) return N;
    function Subprograms_For_Type                (Id : E) return E;
    function Suppress_Elaboration_Warnings       (Id : E) return B;
-   function Suppress_Init_Proc                  (Id : E) return B;
+   function Suppress_Initialization             (Id : E) return B;
    function Suppress_Style_Checks               (Id : E) return B;
    function Suppress_Value_Tracking_On_Call     (Id : E) return B;
    function Task_Body_Procedure                 (Id : E) return N;
@@ -6869,7 +6874,7 @@ package Einfo is
    procedure Set_String_Literal_Low_Bound        (Id : E; V : N);
    procedure Set_Subprograms_For_Type            (Id : E; V : E);
    procedure Set_Suppress_Elaboration_Warnings   (Id : E; V : B := True);
-   procedure Set_Suppress_Init_Proc              (Id : E; V : B := True);
+   procedure Set_Suppress_Initialization         (Id : E; V : B := True);
    procedure Set_Suppress_Style_Checks           (Id : E; V : B := True);
    procedure Set_Suppress_Value_Tracking_On_Call (Id : E; V : B := True);
    procedure Set_Task_Body_Procedure             (Id : E; V : N);
@@ -7603,7 +7608,7 @@ package Einfo is
    pragma Inline (String_Literal_Low_Bound);
    pragma Inline (Subprograms_For_Type);
    pragma Inline (Suppress_Elaboration_Warnings);
-   pragma Inline (Suppress_Init_Proc);
+   pragma Inline (Suppress_Initialization);
    pragma Inline (Suppress_Style_Checks);
    pragma Inline (Suppress_Value_Tracking_On_Call);
    pragma Inline (Task_Body_Procedure);
@@ -7998,7 +8003,7 @@ package Einfo is
    pragma Inline (Set_String_Literal_Low_Bound);
    pragma Inline (Set_Subprograms_For_Type);
    pragma Inline (Set_Suppress_Elaboration_Warnings);
-   pragma Inline (Set_Suppress_Init_Proc);
+   pragma Inline (Set_Suppress_Initialization);
    pragma Inline (Set_Suppress_Style_Checks);
    pragma Inline (Set_Suppress_Value_Tracking_On_Call);
    pragma Inline (Set_Task_Body_Procedure);

gcc/ada/exp_ch3.adb

@@ -674,7 +674,7 @@ package body Exp_Ch3 is
       --    3. The type has CIL/JVM convention.
       --    4. An initialization already exists for the base type
 
-      if Suppress_Init_Proc (A_Type)
+      if Initialization_Suppressed (A_Type)
         or else Is_Value_Type (Comp_Type)
         or else Convention (A_Type) = Convention_CIL
         or else Convention (A_Type) = Convention_Java
@@ -3216,7 +3216,7 @@ package body Exp_Ch3 is
       begin
          --  Definitely do not need one if specifically suppressed
 
-         if Suppress_Init_Proc (Rec_Id) then
+         if Initialization_Suppressed (Rec_Id) then
             return False;
          end if;
 
@@ -4682,12 +4682,9 @@ package body Exp_Ch3 is
 
             and then not Is_Value_Type (Typ)
 
-            --  Suppress call if Suppress_Init_Proc set on the type. This is
-            --  needed for the derived type case, where Suppress_Initialization
-            --  may be set for the derived type, even if there is an init proc
-            --  defined for the root type.
+            --  Suppress call if initialization suppressed for the type
 
-            and then not Suppress_Init_Proc (Typ)
+            and then not Initialization_Suppressed (Typ)
          then
             --  Return without initializing when No_Default_Initialization
             --  applies. Note that the actual restriction check occurs later,
@@ -8536,6 +8533,12 @@ package body Exp_Ch3 is
                            or (Initialize_Scalars and Consider_IS);
 
    begin
+      --  Never need initialization if it is suppressed
+
+      if Initialization_Suppressed (T) then
+         return False;
+      end if;
+
       --  Check for private type, in which case test applies to the underlying
       --  type of the private type.
 

gcc/ada/exp_disp.adb

@@ -6728,7 +6728,7 @@ package body Exp_Disp is
             --  to simplify the expansion associated with dispatching calls.
 
             Analyze_List (Result);
-            Set_Suppress_Init_Proc (Base_Type (DT_Prims));
+            Set_Suppress_Initialization (Base_Type (DT_Prims));
 
             --  Disable backend optimizations based on assumptions about the
             --  aliasing status of objects designated by the access to the

gcc/ada/freeze.adb

@@ -2865,7 +2865,7 @@ package body Freeze is
                    ((Has_Non_Null_Base_Init_Proc (Etype (E))
                       and then not No_Initialization (Declaration_Node (E))
                       and then not Is_Value_Type (Etype (E))
-                      and then not Suppress_Init_Proc (Etype (E)))
+                      and then not Initialization_Suppressed (Etype (E)))
                     or else
                       (Needs_Simple_Initialization (Etype (E))
                         and then not Is_Internal (E)))

gcc/ada/gnat_rm.texi

@@ -4892,7 +4892,18 @@ pragma Suppress_Initialization ([Entity =>] type_Name);
 
 @noindent
 This pragma suppresses any implicit or explicit initialization
-associated with the given type name for all variables of this type.
+associated with the given type name for all variables of this type,
+including initialization resulting from the use of pragmas
+Normalize_Scalars or Initialize_Scalars.
+
+This is considered a representation item, so it cannot be given after
+the type is frozen. It applies to all subsequent object declarations,
+and also any allocator that creates objects of the type.
+
+If the pragma is given for the first subtype, then it is considered
+to apply to the base type and all its subtypes. If the pragma is given
+for other than a first subtype, then it applies only to the given subtype.
+The pragma may not be given after the type is frozen.
 
 @node Pragma Task_Info
 @unnumberedsec Pragma Task_Info

gcc/ada/sem_aux.adb

@@ -403,6 +403,16 @@ package body Sem_Aux is
       return Empty;
    end First_Tag_Component;
 
+   -------------------------------
+   -- Initialization_Suppressed --
+   -------------------------------
+
+   function Initialization_Suppressed (Typ : Entity_Id) return Boolean is
+   begin
+      return Suppress_Initialization (Typ)
+        or else Suppress_Initialization (Base_Type (Typ));
+   end Initialization_Suppressed;
+
    ----------------
    -- Initialize --
    ----------------

gcc/ada/sem_aux.ads

@@ -217,6 +217,12 @@ package Sem_Aux is
    function Number_Discriminants (Typ : Entity_Id) return Pos;
    --  Typ is a type with discriminants, yields number of discriminants in type
 
+   function Initialization_Suppressed (Typ : Entity_Id) return Boolean;
+   pragma Inline (Initialization_Suppressed);
+   --  Returns True if initialization should be suppressed for the given type
+   --  or subtype. This is true if Suppress_Initialization is set either for
+   --  the subtype itself, or for the corresponding base type.
+
    function Ultimate_Alias (Prim : Entity_Id) return Entity_Id;
    pragma Inline (Ultimate_Alias);
    --  Return the last entity in the chain of aliased entities of Prim. If Prim

gcc/ada/sem_dist.adb

@@ -610,7 +610,7 @@ package body Sem_Dist is
       --  is active), and there are order of elaboration problems if we do try
       --  to generate an init proc for this created record type.
 
-      Set_Suppress_Init_Proc (Fat_Type);
+      Set_Suppress_Initialization (Fat_Type);
 
       if Expander_Active then
          Add_RAST_Features (Parent (User_Type));

gcc/ada/sem_prag.adb

@@ -6359,7 +6359,6 @@ package body Sem_Prag is
                  ("pragma% cannot be applied to function", Arg1);
 
             elsif Is_Remote_Access_To_Subprogram_Type (Nm) then
-
                   if Is_Record_Type (Nm) then
 
                   --  A record type that is the Equivalent_Type for a remote
@@ -12751,22 +12750,36 @@ package body Sem_Prag is
 
             E := Entity (E_Id);
 
-            if Is_Type (E) then
-               if Is_Incomplete_Or_Private_Type (E) then
-                  if No (Full_View (Base_Type (E))) then
-                     Error_Pragma_Arg
-                       ("argument of pragma% cannot be an incomplete type",
-                         Arg1);
-                  else
-                     Set_Suppress_Init_Proc (Full_View (Base_Type (E)));
-                  end if;
+            if not Is_Type (E) then
+               Error_Pragma_Arg ("pragma% requires type or subtype", Arg1);
+            end if;
+
+            if Rep_Item_Too_Early (E, N)
+                 or else
+               Rep_Item_Too_Late (E, N, FOnly => True)
+            then
+               return;
+            end if;
+
+            --  For incomplete/private type, set flag on full view
+
+            if Is_Incomplete_Or_Private_Type (E) then
+               if No (Full_View (Base_Type (E))) then
+                  Error_Pragma_Arg
+                    ("argument of pragma% cannot be an incomplete type", Arg1);
                else
-                  Set_Suppress_Init_Proc (Base_Type (E));
+                  Set_Suppress_Initialization (Full_View (Base_Type (E)));
                end if;
 
+            --  For first subtype, set flag on base type
+
+            elsif Is_First_Subtype (E) then
+               Set_Suppress_Initialization (Base_Type (E));
+
+            --  For other than first subtype, set flag on subtype itself
+
             else
-               Error_Pragma_Arg
-                 ("pragma% requires argument that is a type name", Arg1);
+               Set_Suppress_Initialization (E);
             end if;
          end Suppress_Init;