From: akonstan@news.cs.columbia.edu (Alexander V. Konstantinou)
Subject: Controlled Types & GNAT 3.09
Date: 1997/03/11
Date: 1997-03-11T00:00:00+00:00 [thread overview]
Message-ID: <5g3s2l$174@sutton.cs.columbia.edu> (raw)
-- 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
next reply other threads:[~1997-03-11 0:00 UTC|newest]
Thread overview: 8+ messages / expand[flat|nested] mbox.gz Atom feed top
1997-03-11 0:00 Alexander V. Konstantinou [this message]
1997-03-13 0:00 ` Controlled Types & GNAT 3.09 Robert Dewar
1997-03-14 0:00 ` Jerome Desquilbet
1997-03-14 0:00 ` Robert A Duff
1997-03-14 0:00 ` Tom Moran
1997-03-14 0:00 ` Pascal Ledru
1997-03-15 0:00 ` Alexander V. Konstantinou
1997-03-21 0:00 ` Jerome Desquilbet
replies disabled
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox