Can you help with an Ada 95 OO Problem

[David Wallace <averon@argonet.co.uk>]

Hello

   I am attempting to get to grip with the new Ada 95 OO extensions, but 
   appear to be having a problem understanding correctly how views of, and
   dispatching of class wide type operations work on procedures which use
   an access parameter.

   Below is the example code I have been playing with to attempt to use the
   features I am experiencing problems with. The Noddy example is based
   around a simple OO abstraction of elements of a http protocol.

   The problem is described in the example source where the following text
   appears.

                ****** HELP ****

   Thanks,

       Davsid Wallace.


--
-- Start for main application.
--
with Http;
procedure Start is

begin

   Http.STart;

end Start;

--
-- Define Abstract Class to enforce Java/Eiffel style OO representation.
--
package Ada_Classes is

    type Ada_Class is abstract tagged null record;

    type Ada_Class_Access is access all Ada_Class'Class;

    function Create return Ada_Class_Access is abstract;


    procedure Init (Obj : access Ada_Class) is abstract;



end Ada_Classes;


--
-- Top Level Http Package
--
package Http is


   procedure Start;

end Http;

--
-- Internals to create object instances !!.
--
with Http.Headers.General_Headers;
package body Http is

   procedure Start is

        General_Header : Http.Headers.General_Headers.General_Header_Access
:=
        Http.Headers.General_Headers.Create;

   begin

        --
        -- Initialise an instance of a general Header.
        --
        -- Here I have attempted to initialise the General Header Instance,
        -- which would also attempt to initialise its parent type component.
        --
        Http.Headers.General_Headers.Init (Obj => General_Header);

   end Start;


end Http;
     

--
-- This package is simply to define the
with Ada_Classes;
package Http.Headers is

   type Header is new Ada_Classes.Ada_Class with  private; 

   type Header_Access is access all Header'Class;

   function Create return Header_Access;
   
   procedure init(Obj : access Header);

   procedure Debug(Obj : access Header);

private

   type Header is new Ada_Classes.Ada_Class with 
      record
         Header_Data : Integer;
      end record ;

end Http.Headers;

with Text_Io;
package body  Http.Headers is

   function Create return Header_Access is

      New_Header : Header_Access;

   begin

      Text_Io.Put_Line("Allocatting Header Instance");
      New_Header := new Header'(Header_Data => 0);

      return New_Header;

   end Create;
   
   procedure init(Obj : access Header) is

   begin
      Text_Io.Put_Line("Header Object has be initialised");
      --
      -- Initialise the Header Data object with an abritary value.
      --
      Obj.Header_Data := 4;

   end Init;

end Http.Headers;

package Http.Headers.General_Headers is

   type General_Header is new Headers.Header with private;
   type General_Header_Access is access all General_Header'Class;

   function Create return General_Header_Access;

   procedure init(Obj : access General_Header);

private

   type General_Header is new Headers.Header with
      record
         General_Header_Data : Integer;
      end record ;

end Http.Headers.General_Headers;

with Text_Io;
package body Http.Headers.General_Headers is

   function Create return General_Header_Access is

      New_General_Header : General_Header_Access;

   begin

      Text_Io.Put_Line("Allocatting General_Header Instance");

      New_General_Header := new General_Header;

      return New_General_Header;

   end Create;

   procedure init(Obj : access General_Header)is

      Header_Ref : Header_Access := Obj;

   begin


      --
      -- Init Standard Header Component.
      --
      Text_Io.Put_Line("General Header initialising Header Object");

      -- ***************** HELP *********** HELP ***************************
      --
      -- This is the crux of the problem.
      --
      -- How do I get the General_Header to Init the Header component of
      -- the parent type Header, using its Init operation.
      --
      -- The Call below invokes Infinite recursion to the operation,
      -- Http.Headers.General_Header, even though the parent operation
      -- is referenced.
      --
      -- I assume the Class Wide Type is using the Tag of the Created object
      -- to dispatch on the operation Http.Headers.General_Headers.Init.
      -- I initialy believed that the Conversion of Header_Access on the
access
      -- parameter would, allow it to have the correct view on the classwide
      -- type, and dispatch the appropriate problem.
      --
      -- Can anybody put me on the right path please. Use of access
parameters
      -- on this procedure appears to be confusing the matter. I would
      -- appreciate your help, since this problem has been giving me a
headache
      -- for a couple of days now.
      --
      -- NB.
      --    I know the Header component is visible from this procedure,
      --    and can be directly assigned, but that is not what I am trying
to
      --    achieve. This would not have been the case If I had not used
Child
      --    Libraries.
      --
      -- ***************** HELP *********** HELP ***************************
      --
      Http.Headers.Init(Obj => Header_Ref);

      Text_Io.Put_Line("General Header Object has be initialised");

      Obj.General_Header_Data := 4;


   end Init;


   procedure Debug(Obj : access Header)is

   begin

      Text_Io.Put_Line
        ("Obj.Header      => " &
         Integer'Image (Obj.Header_Data));

      Text_Io.Put_Line
        ("Obj.General_Header      => " &
         Integer'Image (Obj.General_Header_Data));

   end Debug;

end Http.Headers.General_Headers;
     
              

--
--. --. --. --. : : --- --- .---------------------------------------------.
|_| |_| | _ | | | | |_   |  |Internet provider for all Acorn RISC machines|
| | |\  | | | | |\| |    |  '---------------------------------------------'
| | | \ |_| |_| | | |__  |  averon@argonet.co.uk