Suspension_Object problem

Suspension_Object problem

[Philippe Laval]

The following program compiles without error in gnat 3.14p.
However the line "From H: P is now released" never shows up. What is
wrong?

-- File Susp_O.adb
with P_Pkg;
with H_Pkg;
procedure Susp_O is
begin
   null;
end Susp_O;
----------------------------------------------------------------------------------------------

-- File P_Pkg.ads
with Ada.Synchronous_Task_Control; use Ada.Synchronous_Task_Control;
package P_Pkg is
   protected type Protected_Lock is
      procedure Set_Lock;
      procedure Release;
   private
      Lock : Suspension_Object;
   end Protected_Lock;

   type Lock_Access is access Protected_Lock;
   Attack_Lock : Lock_Access;

   task P;

end P_Pkg;

------------------------------------------------------------------------------------------------

-- File P_Pkg.ads
package H_Pkg is
   task H;
end H_Pkg;
------------------------------------------------------------------------------------------------

-- File P_Pkg.adb
with Ada.Text_IO; use Ada.Text_IO;
package body P_Pkg is
   protected body Protected_Lock is
      procedure Set_Lock is
      begin
         Suspend_Until_True (Lock);
      end Set_Lock;

      procedure Release is
      begin
         Set_True (Lock);
      end Release;
   end Protected_Lock;

   task body P is
   begin
      Attack_Lock := new Protected_Lock;
      Put_Line ("P is being suspended.");
      Put_Line ("Waiting to be released by H...");
      Attack_Lock.Set_Lock;

      Put_Line ("P is now released.");
   end P;
end P_Pkg;
------------------------------------------------------------------------------------------------

-- File H_Pkg.adb
with Ada.Text_IO; use Ada.Text_IO;
with P_Pkg;
package body H_Pkg is
   task body H is
   begin
      delay 1.0;
      P_Pkg.Attack_Lock.Release;
      Put_Line ("From H : P is released now!");
   end H;
end H_Pkg;
------------------------------------------------------------------------------------------------

Philippe Laval
Observatoire Oc�anologique
F-06234 Villefranche-sur-Mer CEDEX
laval@obs-vlfr.fr

Re: Suspension_Object problem

[Jean-Pierre Rosen]

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1: Type: text/plain, Size: 1607 bytes --]


"Philippe Laval" <laval@obs-vlfr.fr> a �crit dans le message de news: 3E257FD5.8765352C@obs-vlfr.fr...
> The following program compiles without error in gnat 3.14p.
> However the line "From H: P is now released" never shows up. What is
> wrong?
>
> -- File Susp_O.adb
> with P_Pkg;
> with H_Pkg;
> procedure Susp_O is
> begin
>    null;
> end Susp_O;
> ----------------------------------------------------------------------------------------------
>
> -- File P_Pkg.ads
> with Ada.Synchronous_Task_Control; use Ada.Synchronous_Task_Control;
> package P_Pkg is
>    protected type Protected_Lock is
>       procedure Set_Lock;
>       procedure Release;
>    private
>       Lock : Suspension_Object;
>    end Protected_Lock;
>
>    type Lock_Access is access Protected_Lock;
>    Attack_Lock : Lock_Access;
>
>    task P;
>
> end P_Pkg;
>
> ------------------------------------------------------------------------------------------------
>
> -- File P_Pkg.ads
> package H_Pkg is
>    task H;
> end H_Pkg;
> ------------------------------------------------------------------------------------------------
>
> -- File P_Pkg.adb
> with Ada.Text_IO; use Ada.Text_IO;
> package body P_Pkg is
>    protected body Protected_Lock is
>       procedure Set_Lock is
>       begin
>          Suspend_Until_True (Lock);
>       end Set_Lock;
>
Suspend_Until_True is a potentially blocking operation, and therefore not allowed in a protected procedure.
(D.10(10))

--
---------------------------------------------------------
           J-P. Rosen (rosen@adalog.fr)
Visit Adalog's web site at http://www.adalog.fr

Re: Suspension_Object problem

[Jeffrey Carter]

Philippe Laval wrote:
> The following program compiles without error in gnat 3.14p.
> However the line "From H: P is now released" never shows up. What is
> wrong?
> 
> -- File Susp_O.adb
> with P_Pkg;
> with H_Pkg;
> procedure Susp_O is
> begin
>    null;
> end Susp_O;
> ----------------------------------------------------------------------------------------------
> 
> -- File P_Pkg.ads
> with Ada.Synchronous_Task_Control; use Ada.Synchronous_Task_Control;
> package P_Pkg is
>    protected type Protected_Lock is
>       procedure Set_Lock;
>       procedure Release;
>    private
>       Lock : Suspension_Object;
>    end Protected_Lock;
> 
>    type Lock_Access is access Protected_Lock;
>    Attack_Lock : Lock_Access;
> 
>    task P;
> 
> end P_Pkg;
> 
> ------------------------------------------------------------------------------------------------
> 
> -- File P_Pkg.ads
> package H_Pkg is
>    task H;
> end H_Pkg;
> ------------------------------------------------------------------------------------------------
> 
> -- File P_Pkg.adb
> with Ada.Text_IO; use Ada.Text_IO;
> package body P_Pkg is
>    protected body Protected_Lock is
>       procedure Set_Lock is
>       begin
>          Suspend_Until_True (Lock);
>       end Set_Lock;
> 
>       procedure Release is
>       begin
>          Set_True (Lock);
>       end Release;
>    end Protected_Lock;
> 
>    task body P is
>    begin
>       Attack_Lock := new Protected_Lock;
>       Put_Line ("P is being suspended.");
>       Put_Line ("Waiting to be released by H...");
>       Attack_Lock.Set_Lock;
> 
>       Put_Line ("P is now released.");
>    end P;
> end P_Pkg;
> ------------------------------------------------------------------------------------------------
> 
> -- File H_Pkg.adb
> with Ada.Text_IO; use Ada.Text_IO;
> with P_Pkg;
> package body H_Pkg is
>    task body H is
>    begin
>       delay 1.0;
>       P_Pkg.Attack_Lock.Release;
>       Put_Line ("From H : P is released now!");
>    end H;
> end H_Pkg;

This seems entirely inappropriate. Either your 2 tasks should operate on 
a shared Suspension_Object or they should operate on a shared protected 
object. Mixing the 2 seems inappropriate, especially as some operations 
on Suspension_Objects are intended to be blocking operations, and 
therefore illegal to call from a protected object.

I suspect that your problem comes because the call to Suspend_Until_True 
blocks P before it completes executing Set_Lock, so it never frees the 
protected object to allow H to execute Release.

There is also no need to use access types in this example.

-- 
Jeff Carter
"Pray that there's intelligent life somewhere up in
space, 'cause there's bugger all down here on earth."
Monty Python's Meaning of Life