summaryrefslogtreecommitdiff
path: root/gcc/testsuite/gnat.dg/curr_task.adb
diff options
context:
space:
mode:
authorupstream source tree <ports@midipix.org>2015-03-15 20:14:05 -0400
committerupstream source tree <ports@midipix.org>2015-03-15 20:14:05 -0400
commit554fd8c5195424bdbcabf5de30fdc183aba391bd (patch)
tree976dc5ab7fddf506dadce60ae936f43f58787092 /gcc/testsuite/gnat.dg/curr_task.adb
downloadcbb-gcc-4.6.4-554fd8c5195424bdbcabf5de30fdc183aba391bd.tar.bz2
cbb-gcc-4.6.4-554fd8c5195424bdbcabf5de30fdc183aba391bd.tar.xz
obtained gcc-4.6.4.tar.bz2 from upstream website;upstream
verified gcc-4.6.4.tar.bz2.sig; imported gcc-4.6.4 source tree from verified upstream tarball. downloading a git-generated archive based on the 'upstream' tag should provide you with a source tree that is binary identical to the one extracted from the above tarball. if you have obtained the source via the command 'git clone', however, do note that line-endings of files in your working directory might differ from line-endings of the respective files in the upstream repository.
Diffstat (limited to 'gcc/testsuite/gnat.dg/curr_task.adb')
-rw-r--r--gcc/testsuite/gnat.dg/curr_task.adb134
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;