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=-1.3 required=5.0 tests=BAYES_00,INVALID_MSGID
	autolearn=no autolearn_force=no version=3.4.4
X-Google-Language: ENGLISH,ASCII-7-bit
X-Google-Thread: 103376,12301f67e4ba5adf,start
X-Google-Attributes: gid103376,public
From: akonstan@news.cs.columbia.edu (Alexander V. Konstantinou)
Subject: Controlled Types & GNAT 3.09
Date: 1997/03/11
Message-ID: <5g3s2l$174@sutton.cs.columbia.edu>#1/1
X-Deja-AN: 224675449
Organization: Columbia University Department of Computer Science
Newsgroups: comp.lang.ada
Date: 1997-03-11T00:00:00+00:00
List-Id: <comp.lang.ada>


-- Following is a "gnatchop-friendly" example of controlled types use.
-- When compiled with GNATMAKE 3.09 (970121) on
--	SunOS 5.5.1 Generic_103640-04 sun4m sparc
-- [*sutton:test-controlled] gnatmake test_controlled.adb 
-- gcc -c test_controlled.adb
-- gcc -c bar_controlled.adb
-- gcc -c foo_controlled.adb
-- gnatbind -x test_controlled.ali
-- gnatlink test_controlled.ali
-- 
-- produces the following output :
-- [*sutton:test-controlled] ./test_controlled 
-- Initialize(Foo)
-- Initialize(Foo)
-- Initialize(Foo)
-- Initialize(Bar)
-- Initialize(Foo)
-- Initialize(Bar)
-- Main Begin ----
-- F1 := F2
-- Finalize(Foo)
-- Adjust(Foo)
-- B1 := B2
-- Main End ----
-- [*sutton:test-controlled] 
--
-- Note that the Finalize and Adjust functions where never called on B1.
-- Is that a GNAT bug, or is it a problem with my understanding of controlled
-- types ?

with Ada.Text_IO; use Ada.Text_IO;
with Foo_Controlled;
with Bar_Controlled;

procedure Test_Controlled is
   F1, F2 : Foo_Controlled.Foo;
   B1, B2 : Bar_Controlled.Bar;
begin
   Put_Line("Main Begin ----");

   Put_Line("F1 := F2");
   F1 := F2;

   Put_Line("B1 := B2");
   B1 := B2;

   Put_Line("Main End ----");

end Test_Controlled;
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Finalization;

package Foo_Controlled  is

   type Foo is private;
   procedure Initialize(F: in out Foo);
   procedure Adjust(F: in out Foo);
   procedure Finalize(F: in out Foo);

private

   type Integer_Access_Type is access Integer;

   type Foo is new Ada.Finalization.Controlled with
      record
         P : Integer_Access_Type;
      end record;


end Foo_Controlled;
with Unchecked_Deallocation;
package body Foo_Controlled is

   procedure Free is new Unchecked_Deallocation(Integer, Integer_Access_Type);

   procedure Initialize(F: in out Foo) is
   begin
      Put_Line("Initialize(Foo)");
      F.P := new Integer'(100);
   end Initialize;

   procedure Adjust(F: in out Foo) is
   begin
      Put_Line("Adjust(Foo)");
   end Adjust;

   procedure Finalize(F: in out Foo) is
   begin
      Put_Line("Finalize(Foo)");
      Free(F.P);
   end Finalize;

end Foo_Controlled;
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Finalization;
with Foo_Controlled;

package Bar_Controlled is

   type Bar is private;

   procedure Initialize(B: in out Bar);
   procedure Adjust(B: in out Bar);
   procedure Finalize(B: in out Bar);

private
   type Bar is new Ada.Finalization.Controlled with
      record
         I : Integer;
         F : Foo_Controlled.Foo;
      end record;


end Bar_Controlled;
package body Bar_Controlled is

   procedure Initialize(B: in out Bar) is
   begin
      Put_Line("Initialize(Bar)");
   end Initialize;

   procedure Adjust(B: in out Bar) is
   begin
      Put_Line("Adjust(Bar)");
   end Adjust;

   procedure Finalize(B: in out Bar) is
   begin
      Put_Line("Finalize(Bar)");
   end Finalize;

end Bar_Controlled;

-- 
Alexander V. Konstantinou              http://www.cs.columbia.edu/~akonstan/
akonstan@cs.columbia.edu               akonstan@acm.org