Re: Controlled types for resource locking

["Matthew Heaney" <matthew_heaney@acm.org>]

In article <rtff5h311iv34@corp.supernews.com> , "Pat Rogers" 
<progers@NOclasswideSPAM.com> wrote:

> with Ada.Finalization;
> with Lockable;
>
> generic
>   type Unmanaged_Resource is new Lockable.Thing with private;
> package Locking_Manager is
>
>   type Managed_Resource( Resource : access Unmanaged_Resource ) is
>     tagged limited private;
>
...
> end Locking_Manager;

Realize that there's no reason to import a formal tagged derived type.  A
simpler approach is to just import a private type and some operations:

generic
  type Resource_Type (<>) is limited private;
  with procedure Lock (Resource : in out Resource_Type) is <>;
  with procedure Unlock (Resource : in out Resource_Type) is <>;
package Locking_Manager is ...;

This will work for resources that are tagged or untagged.

If you want to dispatch lock and unlock, that's possible too.  Just import a
class-wide op that calls the primitive op:

package P is

  type Root_Resource_Type is abstract tagged limited private;

  procedure Lock (Resource : in out ...);
  procedure Unlock (Resource : ...);

...
end P;

Just write two small class-wide ops:

package P.Dispatching_Utils is

  procedure Call_Lock (Resource : in out Resource_Type'Class);

  procedure Call_Unclock (Resource : in out Resource_Type'Class);

end;

package body P.Dispatching_Utils is

  procedure Call_Lock (Resource : in out Resource_Type'Class) is
  begin
    Lock (Resource);
  end;

  ...
end;

Now just supply the class-wide type and the util ops to the instantiation:

with P.Dispatching_Utils, Locking_Manager;

package Lock_Resources is
  new Locking_Manager (Resource_Type'Class, Call_Lock, Call_Unlock);


Et viola!  The calls to Lock and Unlock dispatch.

In general, I prefer not to import a type hierarchy unless I really have to.

I'll be discussing this technique in my Design Patterns tutorial at this
year's SIGAda conference.


> package body Locking_Manager is
>
>
>   procedure Initialize( This : in out Managed_Resource ) is
>   begin
>     Lockable.Lock( Lockable.Thing'Class(This.Resource.all) );
>   end Initialize;

   procedure Init (...) is
   begin
     Lock (This);
   end;


>   procedure Finalize( This : in out Managed_Resource ) is
>   begin
>     Lockable.Unlock( Lockable.Thing'Class(This.Resource.all) );
>   end Finalize;
>
>
> end Locking_Manager;