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.7 required=5.0 tests=BAYES_00,MSGID_RANDY,
	T_FILL_THIS_FORM_SHORT autolearn=no autolearn_force=no version=3.4.4
X-Google-Language: ENGLISH,ASCII-7-bit
X-Google-Thread: 103376,8b843668b02b23b5
X-Google-Attributes: gid103376,public
From: David C. Hoos, Sr. <david.c.hoos.sr@ada95.com>
Subject: Re: Constructors in Ada95
Date: 2000/02/22
Message-ID: <88u0hk$rcc$1@nnrp1.deja.com>
X-Deja-AN: 588363101
References: <h414bsc31c83a96l429kfeflk8rsfbk7fq@4ax.com>
To: ajaskey@mindspring.com
X-Http-User-Agent: Mozilla/4.0 (compatible; MSIE 5.0; Windows NT; DigExt)
X-Http-Proxy: 1.1 x24.deja.com:80 (Squid/1.1.22) for client 205.149.60.17
Organization: Deja.com - Before you buy.
X-Article-Creation-Date: Tue Feb 22 12:47:49 2000 GMT
X-MyDeja-Info: XMYDJUIDdhoossr
Reply-To: david.c.hoos.sr@ada95.com
Newsgroups: comp.lang.ada
Date: 2000-02-22T00:00:00+00:00
List-Id: <comp.lang.ada>

In article <h414bsc31c83a96l429kfeflk8rsfbk7fq@4ax.com>,
  Andy Askey <ajaskey@mindspring.com> wrote:
> Hello,
> I am sure this has been asked/answered several hundred times but
> nothing current appears in DejaNews.
>
> I want to call a procedure each time an object is instantiated for a
> specific class/type and pass the current instance into the procedures.
> (I could call the procedure after the object is instantiated, but it
> will be easier on the user of my class/type if the procedure is
> automatically called after instantiation.)  I looked into using a
> Controlled type, but I still cannot figure out how to work on a
> specific object instance's data.
>
Here is a fairly complete example:

with Ada.Finalization;
package Constructor_Example is

   type String_Access is access all String;

   type Example
     (Initial_Name  : String_Access;
      Initial_Value : Integer)
   is new Ada.Finalization.Limited_Controlled with private;

   function Image (Object : Example) return String;

   procedure Copy (Object : in out Example; From : Example);

   procedure Set (Object : in out Example; Name : String);

   procedure Set (Object : in out Example; Value : Integer);

private

   type Example
     (Initial_Name  : String_Access;
      Initial_Value : Integer)
   is new Ada.Finalization.Limited_Controlled with record
      Name  : String_Access;
      Value : Integer;
   end record;

   procedure Initialize (Object : in out Example);

   procedure Finalize (Object : in out Example);

end Constructor_Example;

with Ada.Text_IO;
with Ada.Strings.Unbounded;
with Ada.Unchecked_Deallocation;
package body Constructor_Example is

   procedure Free is new Ada.Unchecked_Deallocation
     (Object => String,
      Name   => String_Access);

   ----------
   -- Copy --
   ----------

   procedure Copy (Object : in out Example; From : Example)
   is
   begin
      Free (Object.Name);
      Object.Name := new String '(From.Name.all);
      Object.Value := From.Value;
   end Copy;

   -----------
   -- Image --
   -----------

   function Image (Object : Example) return String is
      Unbounded_String : Ada.Strings.Unbounded.Unbounded_String;
   begin
      if Object.Name = null then
        Ada.Strings.Unbounded.Append
        (Source => Unbounded_String,
         New_Item => "Object is un-named;");
      else
        Ada.Strings.Unbounded.Append
        (Source => Unbounded_String,
         New_Item => Object.Name.all);
      end if;
      Ada.Strings.Unbounded.Append
        (Source => Unbounded_String,
         New_Item => " has the value" &
         Integer'Image (Object.Value));
      return Ada.Strings.Unbounded.To_String (Unbounded_String);
   end Image;

   ---------
   -- Set --
   ---------

   procedure Set (Object : in out Example; Name : String) is
   begin
      Free (Object.Name);
      Object.Name := new String '(Name);
   end Set;

   ---------
   -- Set --
   ---------

   procedure Set (Object : in out Example; Value : Integer) is
   begin
      Object.Value := Value;
   end Set;

   ----------------
   -- Initialize --
   ----------------

   procedure Initialize (Object : in out Example)
   is
   begin
      if Object.Initial_Name /= null then
         Object.Name := new String '(Object.Initial_Name.all);
      end if;
      Object.Value := Object.Initial_Value;
      Ada.Text_IO.Put_Line
        ("Initialized object """ & Image (Object) & """.");
   end Initialize;

   --------------
   -- Finalize --
   --------------

   procedure Finalize (Object : in out Example)
   is
   begin
      Ada.Text_IO.Put_Line
        ("Finalizing object """ & Image (Object) & """.");
      Free (Object.Name);
   end Finalize;

end Constructor_Example;

with Ada.Text_IO;
with Constructor_Example;
procedure Test_Constructor_Example is
   Instance_1_Initial_Name : aliased String := "Instance_1";
   Instance_1 : Constructor_Example.Example
     (Instance_1_Initial_Name'Unchecked_Access, 1234);
begin
   declare
   Instance_2 : Constructor_Example.Example
     (null, 4321);
   begin
      Ada.Text_IO.Put_Line (Constructor_Example.Image (Instance_2));
      Constructor_Example.Set (Instance_2, "INSTANCE_2");
      Constructor_Example.Set (Instance_2, 5678);
      Ada.Text_IO.Put_Line (Constructor_Example.Image (Instance_2));
      Constructor_Example.Copy (Instance_2, Instance_1);
      Ada.Text_IO.Put_Line
        ("Image of Instance_2, after Instance_1 has been copied to
it:");
      Ada.Text_IO.Put_Line (Constructor_Example.Image (Instance_2));
      Ada.Text_IO.Put_Line ("Leaving inner scope.");
   end;
   Ada.Text_IO.Put_Line (Constructor_Example.Image (Instance_1));
   Ada.Text_IO.Put_Line ("Leaving outer scope.");
end Test_Constructor_Example;







Sent via Deja.com http://www.deja.com/
Before you buy.