From mboxrd@z Thu Jan 1 00:00:00 1970 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on polar.synack.me X-Spam-Level: X-Spam-Status: No, score=-0.3 required=5.0 tests=BAYES_00, REPLYTO_WITHOUT_TO_CC autolearn=no autolearn_force=no version=3.4.4 X-Google-Language: ENGLISH,ASCII-7-bit X-Google-Thread: 103376,d6fce62235e109c0,start X-Google-Attributes: gid103376,public From: David Wallace Subject: Can you help with an Ada 95 OO Problem Date: 1997/01/18 Message-ID: X-Deja-AN: 210652047 distribution: world organization: ArgoNet, but does not reflect its views reply-to: David Wallace newsgroups: comp.lang.ada Date: 1997-01-18T00:00:00+00:00 List-Id: 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