-- ----------------------------------------------------------------- --
--                                                                   --
-- This is free software; you can redistribute it and/or             --
-- modify it under the terms of the GNU General Public               --
-- License as published by the Free Software Foundation; either      --
-- version 2 of the License, or (at your option) any later version.  --
--                                                                   --
-- This software is distributed in the hope that it will be useful,  --
-- but WITHOUT ANY WARRANTY; without even the implied warranty of    --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU --
-- General Public License for more details.                          --
--                                                                   --
-- You should have received a copy of the GNU General Public         --
-- License along with this library; if not, write to the             --
-- Free Software Foundation, Inc., 59 Temple Place - Suite 330,      --
-- Boston, MA 02111-1307, USA.                                       --
--                                                                   --
-- ----------------------------------------------------------------- --

-- ----------------------------------------------------------------- --
-- This is a translation, to the Ada programming language, of the    --
-- original C test files written by Sam Lantinga - www.libsdl.org    --
-- translation made by Antonio F. Vargas - www.adapower.net/~avargas --
-- ----------------------------------------------------------------- --

with System.Address_To_Access_Conversions;
with Ada.Text_IO; use Ada.Text_IO;
with SDL.Thread;

package body TortureThread_Sprogs is

   package Tr renames SDL.Thread;
   function To_int is new Ada.Unchecked_Conversion (System.Address, C.int);

   type Volatile_int is new C.int;
   pragma Volatile (Volatile_int);
 
   package int_Ptrs is
      new System.Address_To_Access_Conversions (Volatile_int);
   use int_Ptrs;
      
   --  ======================================
   function SubThreadFunc (data : System.Address) return C.int is
   begin
      while To_Pointer (data).all = 0 loop
         null; --  SDL.Timer.SDL_Delay (10); --  do nothing
      end loop;
      return 0;
   end SubThreadFunc;
   
   --  ======================================
   type flags_Array is
      array (C.int range 0 .. NUMTHREADS - 1) of aliased Volatile_int;
   pragma Convention (C, flags_Array);
   flags : flags_Array;
   --  ======================================
   
   function ThreadFunc (data : System.Address) return C.int is
   
      type sub_threads_Array is
         array (C.int range 0 .. NUMTHREADS - 1) of Tr.SDL_Thread_ptr;
      pragma Convention (C, sub_threads_Array);
      sub_threads : sub_threads_Array;
      
      tid : C.int := To_int (data);
      
   begin
      
      Put_Line ("Creating Thread " & C.int'Image (tid));
      for i in flags'Range loop
         flags (i) := 0;
         sub_threads (i) :=
            Tr.CreateThread (SubThreadFunc'Access,
                             To_Address (Object_Pointer'(flags (i)'Access)));
      end loop;
      
      Put_Line ("Thread '" & C.int'Image (tid) & "' waiting for signals");
      while time_for_threads_to_die (tid) /= 1 loop
         null; -- do nothing
      end loop;
      
      Put_Line ("Thread '" & C.int'Image (tid) & "' sending signals to subthreads");
      for i in flags'Range loop
         flags (i) := 1;
         Tr.WaitThread (sub_threads (i), null);
      end loop;

      Put_Line ("Thread '" & C.int'Image (tid) & "' exiting");
      
      return 0;
   end ThreadFunc;
   
   --  ======================================

end TortureThread_Sprogs;


syntax highlighted by Code2HTML, v. 0.9.1