+2017-11-09 Javier Miranda <miranda@adacore.com>
+
+ * libgnat/s-rident.ads (Static_Dispatch_Tables): New restriction name.
+ * exp_disp.adb (Building_Static_DT): Check restriction.
+ (Building_Static_Secondary_DT): Check restriction.
+ (Make_DT): Initialize the HT_Link to No_Tag.
+ * opt.ads (Static_Dispatch_Tables): Rename flag...
+ (Building_Static_Dispatch_Tables): ... into this. This will avoid
+ conflict with the restriction name.
+ * gnat1drv.adb: Update.
+ * exp_aggr.adb (Is_Static_Dispatch_Table_Aggregate): Update.
+ * exp_ch3.adb (Expand_N_Object_Declaration): Update.
+
+2017-11-09 Pascal Obry <obry@adacore.com>
+
+ * libgnarl/s-taprop__mingw.adb: Minor code clean-up. Better using a
+ named number.
+
2017-11-09 Yannick Moy <moy@adacore.com>
* binde.adb (Diagnose_Elaboration_Problem): Mark procedure No_Return.
Typ : constant Entity_Id := Base_Type (Etype (N));
begin
- return Static_Dispatch_Tables
+ return Building_Static_Dispatch_Tables
and then Tagged_Type_Expansion
and then RTU_Loaded (Ada_Tags)
-- Force construction of dispatch tables of library level tagged types
if Tagged_Type_Expansion
- and then Static_Dispatch_Tables
+ and then Building_Static_Dispatch_Tables
and then Is_Library_Level_Entity (Def_Id)
and then Is_Library_Level_Tagged_Type (Base_Typ)
and then Ekind_In (Base_Typ, E_Record_Type,
------------------------
function Building_Static_DT (Typ : Entity_Id) return Boolean is
- Root_Typ : Entity_Id := Root_Type (Typ);
+ Root_Typ : Entity_Id := Root_Type (Typ);
+ Static_DT : Boolean;
begin
-- Handle private types
Root_Typ := Full_View (Root_Typ);
end if;
- return Static_Dispatch_Tables
+ Static_DT := Building_Static_Dispatch_Tables
and then Is_Library_Level_Tagged_Type (Typ)
-- If the type is derived from a CPP class we cannot statically
-- from the CPP side.
and then not Is_CPP_Class (Root_Typ);
+
+ if not Static_DT then
+ Check_Restriction (Static_Dispatch_Tables, Typ);
+ end if;
+
+ return Static_DT;
end Building_Static_DT;
----------------------------------
----------------------------------
function Building_Static_Secondary_DT (Typ : Entity_Id) return Boolean is
- Full_Typ : Entity_Id := Typ;
- Root_Typ : Entity_Id := Root_Type (Typ);
+ Full_Typ : Entity_Id := Typ;
+ Root_Typ : Entity_Id := Root_Type (Typ);
+ Static_DT : Boolean;
begin
-- Handle private types
Root_Typ := Full_View (Root_Typ);
end if;
- return Building_Static_DT (Full_Typ)
+ Static_DT := Building_Static_DT (Full_Typ)
and then not Is_Interface (Full_Typ)
and then Has_Interfaces (Full_Typ)
and then (Full_Typ = Root_Typ
or else not Is_Variable_Size_Record (Etype (Full_Typ)));
+
+ if not Static_DT
+ and then not Is_Interface (Full_Typ)
+ and then Has_Interfaces (Full_Typ)
+ then
+ Check_Restriction (Static_Dispatch_Tables, Typ);
+ end if;
+
+ return Static_DT;
end Building_Static_Secondary_DT;
----------------------------------
Append_To (Result,
Make_Object_Declaration (Loc,
Defining_Identifier => HT_Link,
- Object_Definition => New_Occurrence_Of (RTE (RE_Tag), Loc)));
+ Object_Definition => New_Occurrence_Of (RTE (RE_Tag), Loc),
+ Expression => New_Occurrence_Of (RTE (RE_No_Tag), Loc)));
end if;
-- Generate code to create the storage for the type specific data object
-- problems with subtypes of type Ada.Tags.Dispatch_Table_Wrapper. ???
if Debug_Flag_Dot_T then
- Static_Dispatch_Tables := False;
+ Building_Static_Dispatch_Tables := False;
end if;
-- Flip endian mode if -gnatd8 set
Known_Tasks (T.Known_Tasks_Index) := null;
end if;
- if T.Common.LL.Thread /= 0 then
+ if T.Common.LL.Thread /= Null_Thread_Id then
-- This task has been activated. Close the thread handle. This
-- is needed to release system resources.
No_Elaboration_Code, -- GNAT
No_Obsolescent_Features, -- Ada 2005 AI-368
No_Wide_Characters, -- GNAT
+ Static_Dispatch_Tables, -- GNAT
SPARK_05, -- GNAT
-- The following cases require a parameter value
-- Other Global Flags --
------------------------
- Expander_Active : Boolean := False;
- -- A flag that indicates if expansion is active (True) or deactivated
- -- (False). When expansion is deactivated all calls to expander routines
- -- have no effect. Note that the initial setting of False is merely to
- -- prevent saving of an undefined value for an initial call to the
- -- Expander_Mode_Save_And_Set procedure. For more information on the use of
- -- this flag, see package Expander. Indeed this flag might more logically
- -- be in the spec of Expander, but it is referenced by Errout, and it
- -- really seems wrong for Errout to depend on Expander.
-
- Static_Dispatch_Tables : Boolean := True;
+ Building_Static_Dispatch_Tables : Boolean := True;
-- This flag indicates if the backend supports generation of statically
-- allocated dispatch tables. If it is True, then the front end will
-- generate static aggregates for dispatch tables that contain forward
-- behavior can be disabled using switch -gnatd.t which will set this flag
-- to False and revert to the previous dynamic behavior.
+ Expander_Active : Boolean := False;
+ -- A flag that indicates if expansion is active (True) or deactivated
+ -- (False). When expansion is deactivated all calls to expander routines
+ -- have no effect. Note that the initial setting of False is merely to
+ -- prevent saving of an undefined value for an initial call to the
+ -- Expander_Mode_Save_And_Set procedure. For more information on the use of
+ -- this flag, see package Expander. Indeed this flag might more logically
+ -- be in the spec of Expander, but it is referenced by Errout, and it
+ -- really seems wrong for Errout to depend on Expander.
+
-----------------------
-- Tree I/O Routines --
-----------------------
projects / gcc.git / commitdiff