s-taasde.adb (Timer_Queue): Don't use a build-in-place function call to initialize the Timer_Queue.

2014-07-30  Bob Duff  <duff@adacore.com>

	* s-taasde.adb (Timer_Queue): Don't use a
	build-in-place function call to initialize the Timer_Queue.
	* s-traent.adb, s-traent.ads, s-traent-vms.adb, s-traent-vms.ads:
	Turn off polling in these units, because otherwise we get
	elaboration circularities with Ada.Exceptions when the -gnatP
	switch is used.
	* s-tassta.adb (Create_Task): Make sure independent tasks
	are created with Parent = Environment_Task. This was not true,
	for example, in s-interr.adb, when Interrupt_Manager does "new
	Server_Task"; the Server_Task had Parent = Interrupt_Manager,
	which is wrong because the master is determined by the access
	type, which is at library level.
	* s-tasuti.adb (Make_Independent): Avoid setting Parent; it is
	now set correctly by Create_Task.
	(Make_Passive): Remove the workaround for the race condition in
	Make_Independent.
	* frontend.adb (Frontend): Revert to previous method of detecting
	temporary configuration pragma files, recognizing such files by
	".tmp" in the name. This is more general than detecting pragmas
	Source_File_Name_Project, because it allows any tool to use
	this naming convention, no matter the content of the file.
	* gnat_ugn.texi: Document this naming convention.

From-SVN: r213269

10 files changed, 104 insertions, 121 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index b13804b..073f8c0 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,28 @@
+2014-07-30  Bob Duff  <duff@adacore.com>
+
+	* s-taasde.adb (Timer_Queue): Don't use a
+	build-in-place function call to initialize the Timer_Queue.
+	* s-traent.adb, s-traent.ads, s-traent-vms.adb, s-traent-vms.ads:
+	Turn off polling in these units, because otherwise we get
+	elaboration circularities with Ada.Exceptions when the -gnatP
+	switch is used.
+	* s-tassta.adb (Create_Task): Make sure independent tasks
+	are created with Parent = Environment_Task. This was not true,
+	for example, in s-interr.adb, when Interrupt_Manager does "new
+	Server_Task"; the Server_Task had Parent = Interrupt_Manager,
+	which is wrong because the master is determined by the access
+	type, which is at library level.
+	* s-tasuti.adb (Make_Independent): Avoid setting Parent; it is
+	now set correctly by Create_Task.
+	(Make_Passive): Remove the workaround for the race condition in
+	Make_Independent.
+	* frontend.adb (Frontend): Revert to previous method of detecting
+	temporary configuration pragma files, recognizing such files by
+	".tmp" in the name. This is more general than detecting pragmas
+	Source_File_Name_Project, because it allows any tool to use
+	this naming convention, no matter the content of the file.
+	* gnat_ugn.texi: Document this naming convention.
+
 2014-07-30  Robert Dewar  <dewar@adacore.com>
 
 	* exp_ch7.adb, s-tataat.adb, s-tataat.ads, s-parame-vms-alpha.ads,
diff --git a/gcc/ada/frontend.adb b/gcc/ada/frontend.adb
index dd58c86..688f8cc 100644
--- a/gcc/ada/frontend.adb
+++ b/gcc/ada/frontend.adb
@@ -71,42 +71,6 @@ procedure Frontend is
    Config_Pragmas : List_Id;
    --  Gather configuration pragmas
 
-   function Need_To_Be_In_The_Dependencies
-     (Pragma_List : List_Id) return Boolean;
-   --  Check if a configuration pragmas file that contains the Pragma_List
-   --  should be a dependency for the source being compiled. Returns
-   --  False if Pragma_List is Error_List or contains only pragmas
-   --  Source_File_Name_Project, returns True otherwise.
-
-   ------------------------------------
-   -- Need_To_Be_In_The_Dependencies --
-   ------------------------------------
-
-   function Need_To_Be_In_The_Dependencies
-     (Pragma_List : List_Id) return Boolean
-   is
-      Prag  : Node_Id;
-      Pname : Name_Id;
-
-   begin
-      if Pragma_List /= Error_List then
-         Prag := First (Pragma_List);
-         while Present (Prag) loop
-            Pname := Pragma_Name (Prag);
-
-            if Pname /= Name_Source_File_Name_Project then
-               return True;
-            end if;
-
-            Next (Prag);
-         end loop;
-      end if;
-
-      return False;
-   end Need_To_Be_In_The_Dependencies;
-
---  Start of processing for Frontend
-
 begin
    --  Carry out package initializations. These are initializations which might
    --  logically be performed at elaboration time, were it not for the fact
@@ -180,6 +144,8 @@ begin
 
       Prag : Node_Id;
 
+      Temp_File : Boolean;
+
    begin
       --  We always analyze config files with style checks off, since
       --  we don't want a miscellaneous gnat.adc that is around to
@@ -253,6 +219,13 @@ begin
 
             Name_Len := Config_File_Names (Index)'Length;
             Name_Buffer (1 .. Name_Len) := Config_File_Names (Index).all;
+            Temp_File :=
+              Name_Len > 4
+                and then
+                  (Name_Buffer (Name_Len - 3 .. Name_Len) = ".TMP"
+                     or else
+                   Name_Buffer (Name_Len - 3 .. Name_Len) = ".tmp");
+
             --  Load the file, error if we did not find it
 
             Source_Config_File := Load_Config_File (Name_Enter);
@@ -262,30 +235,20 @@ begin
                  ("cannot find configuration pragmas file "
                   & Config_File_Names (Index).all);
 
-            --  If we did find the file, and it contains pragmas other than
-            --  Source_File_Name_Project, then we unconditionally add a
-            --  compilation dependency for it so that if it changes, we force
-            --  a recompilation. This is a fairly recent (2014-03-28) change.
-
-            else
-
-               --  Parse the config pragmas file, and accumulate results
-
-               Initialize_Scanner (No_Unit, Source_Config_File);
-
-               declare
-                  Pragma_List : constant List_Id :=
-                                  Par (Configuration_Pragmas => True);
-
-               begin
-                  if Need_To_Be_In_The_Dependencies (Pragma_List) then
-                     Prepcomp.Add_Dependency (Source_Config_File);
-                  end if;
+            --  If we did find the file, and it is not a temporary file, then
+            --  we unconditionally add a compilation dependency for it so
+            --  that if it changes, we force a recompilation. This is a
+            --  fairly recent (2014-03-28) change.
 
-                  Append_List_To (Config_Pragmas, Pragma_List);
-               end;
+            elsif not Temp_File then
+               Prepcomp.Add_Dependency (Source_Config_File);
             end if;
 
+            --  Parse the config pragmas file, and accumulate results
+
+            Initialize_Scanner (No_Unit, Source_Config_File);
+            Append_List_To
+              (Config_Pragmas, Par (Configuration_Pragmas => True));
          end loop;
       end if;
 
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index cc1f7fd..3ed4f15 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -12339,8 +12339,13 @@ It is allowable to specify several switches @option{-gnatec=}, all of which
 will be taken into account.
 
 Files containing configuration pragmas specified with switches
-@option{-gnatec=} are added to the dependencies, unless they contain
-only pragmas Source_File_Name_Project.
+@option{-gnatec=} are added to the dependencies, unless they are
+temporary files. A file is considered temporary if its name ends in
+@file{.tmp} or @file{.TMP}. Certain tools follow this naming
+convention because they pass information to @command{gcc} via
+temporary files that are immediately deleted; it doesn't make sense to
+depend on a file that no longer exists. Such tools include
+@command{gprbuild}, @command{gnatmake}, and @command{gnatcheck}.
 
 If you are using project file, a separate mechanism is provided using
 project attributes, see @ref{Specifying Configuration Pragmas} for more
diff --git a/gcc/ada/s-taasde.adb b/gcc/ada/s-taasde.adb
index 061ef0d..37b9430 100644
--- a/gcc/ada/s-taasde.adb
+++ b/gcc/ada/s-taasde.adb
@@ -75,19 +75,22 @@ package body System.Tasking.Async_Delays is
    --  time, so that the ordered insertion will always stop searching when it
    --  gets back to the queue header block.
 
-   function Empty_Queue return Delay_Block;
-   --  Initial value for Timer_Queue
+   Timer_Queue : aliased Delay_Block;
 
-   function Empty_Queue return Delay_Block is
+   package Init_Timer_Queue is end Init_Timer_Queue;
+   pragma Unreferenced (Init_Timer_Queue);
+   --  Initialize the Timer_Queue. This is a package to work around the
+   --  fact that statements are syntactically illegal here. We want this
+   --  initialization to happen before the Timer_Server is activated. A
+   --  build-in-place function would also work, but that's not supported
+   --  on all platforms (e.g. cil).
+
+   package body Init_Timer_Queue is
    begin
-      return Result : aliased Delay_Block do
-         Result.Succ := Result'Unchecked_Access;
-         Result.Pred := Result'Unchecked_Access;
-         Result.Resume_Time := Duration'Last;
-      end return;
-   end Empty_Queue;
-
-   Timer_Queue : aliased Delay_Block := Empty_Queue;
+      Timer_Queue.Succ := Timer_Queue'Unchecked_Access;
+      Timer_Queue.Pred := Timer_Queue'Unchecked_Access;
+      Timer_Queue.Resume_Time := Duration'Last;
+   end Init_Timer_Queue;
 
    ------------------------
    -- Cancel_Async_Delay --
diff --git a/gcc/ada/s-tassta.adb b/gcc/ada/s-tassta.adb
index b116569..a2ff687 100644
--- a/gcc/ada/s-tassta.adb
+++ b/gcc/ada/s-tassta.adb
@@ -557,14 +557,20 @@ package body System.Tasking.Stages is
             else System.Multiprocessors.CPU_Range (CPU));
       end if;
 
-      --  Find parent P of new Task, via master level number
+      --  Find parent P of new Task, via master level number. Independent tasks
+      --  should have Parent = Environment_Task, and all tasks created
+      --  by independent tasks are also independent. See, for example,
+      --  s-interr.adb, where Interrupt_Manager does "new Server_Task". The
+      --  access type is at library level, so the parent of the Server_Task
+      --  is Environment_Task.
 
       P := Self_ID;
 
-      if P /= null then
-         while P.Master_of_Task >= Master loop
+      if P.Master_of_Task <= Independent_Task_Level then
+         P := Environment_Task;
+      else
+         while P /= null and then P.Master_of_Task >= Master loop
             P := P.Common.Parent;
-            exit when P = null;
          end loop;
       end if;
 
diff --git a/gcc/ada/s-tasuti.adb b/gcc/ada/s-tasuti.adb
index e194025..40446fc 100644
--- a/gcc/ada/s-tasuti.adb
+++ b/gcc/ada/s-tasuti.adb
@@ -246,8 +246,6 @@ package body System.Tasking.Utilities is
       Self_Id               : constant Task_Id := STPO.Self;
       Environment_Task      : constant Task_Id := STPO.Environment_Task;
       Parent                : constant Task_Id := Self_Id.Common.Parent;
-      Parent_Needs_Updating : Boolean := False;
-      Master_of_Task        : Integer;
 
    begin
       if Self_Id.Known_Tasks_Index /= -1 then
@@ -263,23 +261,12 @@ package body System.Tasking.Utilities is
       Write_Lock (Environment_Task);
       Write_Lock (Self_Id);
 
-      pragma Assert (Parent = Environment_Task
-        or else Self_Id.Master_of_Task = Library_Task_Level);
-
-      Master_of_Task := Self_Id.Master_of_Task;
-      Self_Id.Master_of_Task := Independent_Task_Level;
-
       --  The run time assumes that the parent of an independent task is the
       --  environment task.
 
-      if Parent /= Environment_Task then
-
-         --  We cannot lock three tasks at the same time, so defer the
-         --  operations on the parent.
+      pragma Assert (Parent = Environment_Task);
 
-         Parent_Needs_Updating := True;
-         Self_Id.Common.Parent := Environment_Task;
-      end if;
+      Self_Id.Master_of_Task := Independent_Task_Level;
 
       --  Update Independent_Task_Count that is needed for the GLADE
       --  termination rule. See also pending update in
@@ -287,32 +274,12 @@ package body System.Tasking.Utilities is
 
       Independent_Task_Count := Independent_Task_Count + 1;
 
-      Unlock (Self_Id);
+      --  This should be called before the task reaches its "begin" (see spec),
+      --  which ensures that the environment task cannot race ahead and be
+      --  already waiting for children to complete.
 
-      --  Changing the parent after creation is not trivial. Do not forget
-      --  to update the old parent counts, and the new parent (i.e. the
-      --  Environment_Task) counts.
-
-      if Parent_Needs_Updating then
-         Write_Lock (Parent);
-         Parent.Awake_Count := Parent.Awake_Count - 1;
-         Parent.Alive_Count := Parent.Alive_Count - 1;
-         Environment_Task.Awake_Count := Environment_Task.Awake_Count + 1;
-         Environment_Task.Alive_Count := Environment_Task.Alive_Count + 1;
-         Unlock (Parent);
-      end if;
-
-      --  In case the environment task is already waiting for children to
-      --  complete.
-      --  ??? There may be a race condition if the environment task was not in
-      --  master completion sleep when this task was created, but now is
-
-      if Environment_Task.Common.State = Master_Completion_Sleep and then
-        Master_of_Task = Environment_Task.Master_Within
-      then
-         Environment_Task.Common.Wait_Count :=
-           Environment_Task.Common.Wait_Count - 1;
-      end if;
+      Unlock (Self_Id);
+      pragma Assert (Environment_Task.Common.State /= Master_Completion_Sleep);
 
       Unlock (Environment_Task);
 
@@ -511,12 +478,10 @@ package body System.Tasking.Utilities is
 
          --  If parent is in Master_Completion_Sleep, it cannot be on a
          --  terminate alternative, hence it cannot have Wait_Count of
-         --  zero. ???Except that the race condition in Make_Independent can
-         --  cause Wait_Count to be zero, so we need to check for that.
+         --  zero.
 
-         if P.Common.Wait_Count > 0 then
-            P.Common.Wait_Count := P.Common.Wait_Count - 1;
-         end if;
+         pragma Assert (P.Common.Wait_Count > 0);
+         P.Common.Wait_Count := P.Common.Wait_Count - 1;
 
          if P.Common.Wait_Count = 0 then
             Wakeup (P, Master_Completion_Sleep);
diff --git a/gcc/ada/s-traent-vms.adb b/gcc/ada/s-traent-vms.adb
index 9e13041..51f0e68 100644
--- a/gcc/ada/s-traent-vms.adb
+++ b/gcc/ada/s-traent-vms.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2003-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 2003-2014, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -29,6 +29,10 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+pragma Polling (Off);
+--  We must turn polling off for this unit, because otherwise we get
+--  elaboration circularities with Ada.Exceptions.
+
 package body System.Traceback_Entries is
 
    ------------
diff --git a/gcc/ada/s-traent-vms.ads b/gcc/ada/s-traent-vms.ads
index 07ab1c0..db327df 100644
--- a/gcc/ada/s-traent-vms.ads
+++ b/gcc/ada/s-traent-vms.ads
@@ -35,6 +35,10 @@
 
 --  This is the Alpha/OpenVMS version of this package
 
+pragma Polling (Off);
+--  We must turn polling off for this unit, because otherwise we get
+--  elaboration circularities with Ada.Exceptions.
+
 package System.Traceback_Entries is
    pragma Preelaborate;
 
diff --git a/gcc/ada/s-traent.adb b/gcc/ada/s-traent.adb
index cedb932..48abe8a 100644
--- a/gcc/ada/s-traent.adb
+++ b/gcc/ada/s-traent.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2003-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 2003-2014, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -29,6 +29,10 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+pragma Polling (Off);
+--  We must turn polling off for this unit, because otherwise we get
+--  elaboration circularities with Ada.Exceptions.
+
 pragma Compiler_Unit_Warning;
 
 package body System.Traceback_Entries is
diff --git a/gcc/ada/s-traent.ads b/gcc/ada/s-traent.ads
index 74f53fd..4d83426 100644
--- a/gcc/ada/s-traent.ads
+++ b/gcc/ada/s-traent.ads
@@ -38,6 +38,10 @@
 --  version of the package, an entry is a mere code location representing the
 --  address of a call instruction part of the call-chain.
 
+pragma Polling (Off);
+--  We must turn polling off for this unit, because otherwise we get
+--  elaboration circularities with Ada.Exceptions.
+
 pragma Compiler_Unit_Warning;
 
 package System.Traceback_Entries is