comp.lang.ada
 help / color / mirror / Atom feed
From: John McCabe <jgm@hayling.cwmbran.gecm.com>
Subject: A favour please.
Date: 1998/06/12
Date: 1998-06-12T00:00:00+00:00	[thread overview]
Message-ID: <6lqt61$2n2@gcsin3.geccs.gecm.com> (raw)


I have a small program (below) that I wrote just to see if it would work. 
To some extent it does, but I get the follwoing error message when I run 
it:

"Failed Runtime Assertion: GNULLI failure---pthread_mutex_destroy"

I am using DOS 6.2 with GNAT 3.05. I realise this version is out of date 
but it is the only one I have available at the moment.

I would appreciate it immensely if someone could try compiling and 
running the program with a later version of GNAT on DOS, or with a Unix 
version of GNAT and let me know either via c.l.a or email to 
john@assen.demon.co.uk what the results were.

The reason I ask is to find out whether it is just a fault with my setup 
/ that version of GNAT or whether there is a fundamental flaw in the 
program itself.

The command line I used was:

gnatmake t_proced.

TIA

-- 
Best Regards
John McCabe

=====================================================================
Not necessarily my company or service providers opinions.
=====================================================================

FILENAME: T_ACCESS.ADS
----------------------
with Ada.Text_IO;

package T_Access is

   type Parent_Task;
   type Parent_Task_Pointer is access Parent_Task;
   
   type Child_Task;
   type Child_Task_Pointer is access Child_Task;
   
   task type Child_Task is
      entry Set_Parent (Parent_Pointer : Parent_Task_Pointer);
      entry Shut_Down;
   end Child_Task;

   task type Parent_Task is
      entry Set_Child (Child_Pointer : Child_Task_Pointer);
      entry Print_Out (Print_String  : String);
   end Parent_Task;

end T_Access;
----------------------

FILENAME: T_ACCESS.ABD
----------------------
with Ada.Text_IO;

package body T_Access is

   task body Child_Task is
      Timeouts            : Integer := 0;
      Count               : Integer := 0;
      Parent              : Parent_Task_Pointer;
   begin
      accept Set_Parent (Parent_Pointer : T_Access.Parent_Task_Pointer) 
do
         Parent := Parent_Pointer;
      end Set_Parent;
      
      loop
         select
            Parent.Print_Out ("Hello" & Integer'IMAGE (Timeouts));
            Timeouts := 0;
         or
            delay 1.0;
            Timeouts := Timeouts + 1;
         end select;
         exit when Count = 100;
      end loop;
      Parent.Print_Out ("END");
   end Child_Task;
   
   task body Parent_Task is
      Shut_Down_Requested : Boolean := False;
      Quit                : String (1..40);
      Quit_Len            : Integer;
      Child               : Child_Task_Pointer;
   begin
      accept Set_Child (Child_Pointer : T_Access.Child_Task_Pointer) do
         Child := Child_Pointer;
      end Set_Child;
      
      loop
         accept Print_Out (Print_String : String) do
            Ada.Text_IO.Put_Line (Print_String);
            if (Print_String (1..3) = "END") then
               Shut_Down_Requested := True;
            end if;
         end Print_Out;
         exit when Shut_Down_Requested;
         delay 5.0;
      end loop;
   end Parent_Task;

end T_Access;
----------------------

FILENAME: T_PROCED.ADB
----------------------
with Ada.Text_IO;
with T_Access;

procedure T_Proced is
  The_Child_Pointer  : T_Access.Child_Task_Pointer;
  The_Parent_Pointer : T_Access.Parent_Task_Pointer;
begin
  Ada.Text_IO.Put_Line("Creating the Child Task...");
  The_Child_Pointer := new T_Access.Child_Task;

  Ada.Text_IO.Put_Line("Creating the Parent Task...");
  The_Parent_Pointer := new T_Access.Parent_Task;

  Ada.Text_IO.Put_Line("Pointing the Child to the Parent...");
  The_Child_Pointer.Set_Parent (The_Parent_Pointer);

  Ada.Text_IO.Put_Line("Pointing the Parent to the Child...");
  The_Parent_Pointer.Set_Child (The_Child_Pointer);

  -- Now just need to wait for them to finish!
end T_Proced;
----------------------







             reply	other threads:[~1998-06-12  0:00 UTC|newest]

Thread overview: 4+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
1998-06-12  0:00 John McCabe [this message]
1998-06-12  0:00 ` A favour please Gautier de Montmollin
1998-06-12  0:00   ` John McCabe
1998-06-15  0:00 ` John McCabe
replies disabled

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox