1 files changed, 134 insertions, 0 deletions
diff --git a/gcc/testsuite/gnat.dg/curr_task.adb b/gcc/testsuite/gnat.dg/curr_task.adb
new file mode 100644
index 000000000..628be1759
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/curr_task.adb
@@ -0,0 +1,134 @@
+-- { dg-do run }
+-- { dg-options "-gnatws" }
+
+with Ada.Exceptions;
+with Ada.Text_IO;
+with Ada.Task_Identification;
+
+procedure Curr_Task is
+
+   use Ada.Task_Identification;
+
+   --  Simple semaphore
+
+   protected Semaphore is
+      entry Lock;
+      procedure Unlock;
+   private
+      TID        : Task_Id := Null_Task_Id;
+      Lock_Count : Natural := 0;
+   end Semaphore;
+
+   ----------
+   -- Lock --
+   ----------
+
+   procedure Lock is
+   begin
+      Semaphore.Lock;
+   end Lock;
+
+   ---------------
+   -- Semaphore --
+   ---------------
+
+   protected body Semaphore is
+
+      ----------
+      -- Lock --
+      ----------
+
+      entry Lock when Lock_Count = 0
+        or else TID = Current_Task
+      is
+      begin
+         if not
+           (Lock_Count = 0
+            or else TID = Lock'Caller)
+         then
+            Ada.Text_IO.Put_Line
+              ("Barrier leaks " & Lock_Count'Img
+                 & ' ' & Image (TID)
+                 & ' ' & Image (Lock'Caller));
+         end if;
+
+         Lock_Count := Lock_Count + 1;
+         TID := Lock'Caller;
+      end Lock;
+
+      ------------
+      -- Unlock --
+      ------------
+
+      procedure Unlock is
+      begin
+         if TID = Current_Task then
+            Lock_Count := Lock_Count - 1;
+         else
+            raise Tasking_Error;
+         end if;
+      end Unlock;
+
+   end Semaphore;
+
+   ------------
+   -- Unlock --
+   ------------
+
+   procedure Unlock is
+   begin
+      Semaphore.Unlock;
+   end Unlock;
+
+   task type Secondary is
+      entry Start;
+   end Secondary;
+
+   procedure Parse (P1 : Positive);
+
+   -----------
+   -- Parse --
+   -----------
+
+   procedure Parse (P1 : Positive) is
+   begin
+      Lock;
+      delay 0.01;
+
+      if P1 mod 2 = 0 then
+         Lock;
+         delay 0.01;
+         Unlock;
+      end if;
+
+      Unlock;
+   end Parse;
+
+   ---------------
+   -- Secondary --
+   ---------------
+
+   task body Secondary is
+   begin
+      accept Start;
+
+      for K in 1 .. 20 loop
+         Parse (K);
+      end loop;
+
+      raise Constraint_Error;
+
+   exception
+      when Program_Error =>
+         null;
+   end Secondary;
+
+   TS : array (1 .. 2) of Secondary;
+
+begin
+   Parse (1);
+
+   for J in TS'Range loop
+      TS (J).Start;
+   end loop;
+end Curr_Task;