[multiple changes]

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.

From-SVN: r254572

8 files changed, 58 insertions, 21 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index f612544..1ccc7df 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,21 @@
+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.
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 86621a4..a2498f8 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -7533,7 +7533,7 @@ package body Exp_Aggr is
       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)
 
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 3385efa..16bbb18 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -6280,7 +6280,7 @@ package body Exp_Ch3 is
       --  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,
diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
index b29686a..caa7945 100644
--- a/gcc/ada/exp_disp.adb
+++ b/gcc/ada/exp_disp.adb
@@ -281,7 +281,8 @@ package body Exp_Disp is
    ------------------------
 
    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
@@ -290,7 +291,7 @@ package body Exp_Disp is
          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
@@ -298,6 +299,12 @@ package body Exp_Disp is
          --  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;
 
    ----------------------------------
@@ -305,8 +312,9 @@ package body Exp_Disp is
    ----------------------------------
 
    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
@@ -319,11 +327,20 @@ package body Exp_Disp is
          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;
 
    ----------------------------------
@@ -5103,7 +5120,8 @@ package body Exp_Disp is
          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
diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb
index 7138c85..3e4234b 100644
--- a/gcc/ada/gnat1drv.adb
+++ b/gcc/ada/gnat1drv.adb
@@ -590,7 +590,7 @@ procedure Gnat1drv is
       --  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
diff --git a/gcc/ada/libgnarl/s-taprop__mingw.adb b/gcc/ada/libgnarl/s-taprop__mingw.adb
index b14444a..c14c228 100644
--- a/gcc/ada/libgnarl/s-taprop__mingw.adb
+++ b/gcc/ada/libgnarl/s-taprop__mingw.adb
@@ -976,7 +976,7 @@ package body System.Task_Primitives.Operations is
          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.
diff --git a/gcc/ada/libgnat/s-rident.ads b/gcc/ada/libgnat/s-rident.ads
index cd88593..cde036a 100644
--- a/gcc/ada/libgnat/s-rident.ads
+++ b/gcc/ada/libgnat/s-rident.ads
@@ -183,6 +183,7 @@ package System.Rident is
       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
diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads
index 96e2f3e..94ed953 100644
--- a/gcc/ada/opt.ads
+++ b/gcc/ada/opt.ads
@@ -2148,17 +2148,7 @@ package Opt is
    -- 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
@@ -2170,6 +2160,16 @@ package Opt is
    --  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 --
    -----------------------