From 5b1e6aca6a6a9957a08823e04393f50fa2d48150 Mon Sep 17 00:00:00 2001 From: Robert Dewar Date: Tue, 2 Aug 2011 14:35:51 +0000 Subject: [PATCH] einfo.ads, einfo.adb (Suppress_Initialization): Replaces Suppress_Init_Procs. 2011-08-02 Robert Dewar * 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 | 11 +++++++++++ gcc/ada/einfo.adb | 17 +++++++++-------- gcc/ada/einfo.ads | 23 ++++++++++++++--------- gcc/ada/exp_ch3.adb | 17 ++++++++++------- gcc/ada/exp_disp.adb | 2 +- gcc/ada/freeze.adb | 2 +- gcc/ada/gnat_rm.texi | 13 ++++++++++++- gcc/ada/sem_aux.adb | 10 ++++++++++ gcc/ada/sem_aux.ads | 6 ++++++ gcc/ada/sem_dist.adb | 2 +- gcc/ada/sem_prag.adb | 39 ++++++++++++++++++++++++++------------- 11 files changed, 101 insertions(+), 41 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 41cc29be75b..9f6b629264f 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,14 @@ +2011-08-02 Robert Dewar + + * 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 * gnat_rm.texi, a-tags.ads, sem_prag.adb, sem_ch12.adb, exp_disp.adb: diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index fedf63b70da..6e1f089ab46 100644 --- a/gcc/ada/einfo.adb +++ b/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)); diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index b319cf4b578..e070e5ea4f1 100644 --- a/gcc/ada/einfo.ads +++ b/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); diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index f41db862898..eb1c6dc8148 100644 --- a/gcc/ada/exp_ch3.adb +++ b/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. diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index 7ebd439f0e3..9a7b3308f91 100644 --- a/gcc/ada/exp_disp.adb +++ b/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 diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 06313c84e2f..f1699db8a99 100644 --- a/gcc/ada/freeze.adb +++ b/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))) diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 5d5d855dcbe..94da75d25ee 100644 --- a/gcc/ada/gnat_rm.texi +++ b/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 diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb index e9a47a3bfde..e46c87223f5 100755 --- a/gcc/ada/sem_aux.adb +++ b/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 -- ---------------- diff --git a/gcc/ada/sem_aux.ads b/gcc/ada/sem_aux.ads index 21acc70abc0..3903f583fe9 100755 --- a/gcc/ada/sem_aux.ads +++ b/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 diff --git a/gcc/ada/sem_dist.adb b/gcc/ada/sem_dist.adb index f9a3c2ae9a9..f30e55d315c 100644 --- a/gcc/ada/sem_dist.adb +++ b/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)); diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 5bcb4a907ac..4f54170472c 100644 --- a/gcc/ada/sem_prag.adb +++ b/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; -- 2.30.2