Ada: how to solve "Circular Unit Dependency"? - ada

Suppose I have two records: Person and Animal. Each record is in a separate package.
Package persons:
with animals;
use animals;
package persons is
type person is record
...
animalref: animalPOINTER;
...
end record;
type personPOINTER is access person;
end persons;
Package animals:
with persons;
use persons;
package animals is
type animal is record
...
ownerref: personPOINTER;
...
end record;
type animalPOINTER is access animal;
end animals;
I have Circular Unit Dependency here, and compiler produces fatal error.
Does anyone have a pattern to address such issue ?
Thanks!

You need limited with, which was introduced to address exactly this problem. See the Rationale for Ada 2005, section 4.2.
Animals and Persons are symmetric (my editor has adjusted the layout and casing; I’ve added one record component to each so the demo program, below, can print something):
limited with Animals;
package Persons is
-- One of the few things you can do with an incomplete type, which
-- is what Animals.Animal is in the limited view of Animals, is to
-- declare an access to it.
type AnimalPOINTER is access Animals.Animal;
type Person is record
Name : Character;
Animalref : AnimalPOINTER;
end record;
end Persons;
limited with Persons;
package Animals is
type PersonPOINTER is access Persons.Person;
type Animal is record
Name : Character;
Ownerref : PersonPOINTER;
end record;
end Animals;
The demo program has the full view of Animals and Persons. This example is pretty clumsy; you may be able to organise things better by adding subprograms to Animals and Persons. Note that the body of Animals can (and must) with Persons; if it needs to use anything in Persons.
with Ada.Text_IO; use Ada.Text_IO;
with Animals;
with Persons;
procedure Animals_And_Persons is
A : Persons.animalPOINTER := new Animals.Animal;
P : Animals.PersonPOINTER := new Persons.Person;
begin
A.all := (Name => 'a', Ownerref => P);
P.all := (Name => 'p', Animalref => A);
Put_Line (P.Name & " owns " & P.Animalref.Name);
Put_Line (A.Name & " is owned by " & A.Ownerref.Name);
end Animals_And_Persons;
which when compiled and run gives
$ ./animals_and_persons
p owns a
a is owned by p

Related

How to parse different parts of a string into separate variables?

How do I get "IL" then saving it to TempCode which is a string and so on to giving each word, integer and float a Temporary variable. Then get the next TempCode and so on. The whole point is to get a certain code under Code Column then do that operation and get the Department, Name/Vendor,Title,ID and Payrate to be use.
with Ada.Text_IO; use Ada.Text_IO;
with GNAT.String_Split; use GNAT.String_Split;
procedure TextFile is
File : File_Type;
Tokens : Slice_Set;
--Index : Slice_Number;
TempCode: String := "";
begin
Open (File, In_File, "DynList.txt");
-- Skip the file header
Skip_Line (File);
-- Read the data
while not End_Of_File (File) loop
-- Split the line from the file on array which contains separated
-- words. Treat multiple spaces as a single separator (don't
-- create empty elements).
Create (Tokens, Get_Line (File), " ", Multiple);
-- Print each of the array's values
for I in 1 .. Slice_Count (Tokens) loop
--I have try using function Separators
Put_Line (Slice (Tokens, I));
end loop;
end loop;
Close (File);
end TextFile;
Store.txt
Code Department Name/Vendor Title ID Payrate
IL Sales John Sales_person 1378 25.46
IR Crew Jesse Sales_person 1379 25.46
First you want to define a type for your payrate. A float will work, but I would recommend making a fixed point type instead as it prints cleaner for what you want.
type Payrate_Type is delta 0.01 range 0.00 .. 1000.00;
To read in values for your type, you will need to instantiate the generic Ada.Text_IO.Fixed_IO:
package Payrate_IO is new Ada.Text_IO.Fixed_IO(Payrate_Type);
Next I would group all your variables for each field in a single record. Use Unbounded_String to store the strings, Natural for the ID, and your pay rate type for your pay rate.
type Line_Info is record
Code : Unbounded_String;
Department : Unbounded_String;
Name : Unbounded_String;
Title : Unbounded_String;
ID : Natural;
Payrate : Payrate_Type;
end record;
A_Line : Line_Info;
Then for each iteration of your while loop, instead of the for loop, you just do individual assignments for each of the various slice pieces:
A_Line.Code := To_Unbounded_String(Slice(Tokens, 1));
A_Line.Department := To_Unbounded_String(Slice(Tokens, 2));
A_Line.Name := To_Unbounded_String(Slice(Tokens, 3));
A_Line.Title := To_Unbounded_String(Slice(Tokens, 4));
A_Line.ID := Natural'Value(Slice(Tokens, 5));
Payrate_IO.Get(Slice(Tokens,6),A_Line.Payrate,Last);
You'll need to do some exception handling logic to cover when your input is not correct. I'll leave that up to you to figure out.
Here's a test program for your input set:
with Ada.Text_IO; use Ada.Text_IO;
with GNAT.String_Split; use GNAT.String_Split;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
procedure Hello is
Tokens : Slice_Set;
--Index : Slice_Number;
TempCode: String := "";
type Payrate_Type is delta 0.01 range 0.00 .. 1000.00;
type Line_Info is record
Code : Unbounded_String;
Department : Unbounded_String;
Name : Unbounded_String;
Title : Unbounded_String;
ID : Natural;
Payrate : Payrate_Type;
end record;
A_Line : Line_Info;
package Payrate_IO is new Ada.Text_IO.Fixed_IO(Payrate_Type);
Last : Positive;
begin
Put_Line("Hello, world!");
Skip_Line;
-- Read the data
while not End_Of_File loop
-- Split the line from the file on array which contains separated
-- words. Treat multiple spaces as a single separator (don't
-- create empty elements).
Create (Tokens, Get_Line, " ", Multiple);
-- Print each of the array's values
A_Line.Code := To_Unbounded_String(Slice(Tokens, 1));
A_Line.Department := To_Unbounded_String(Slice(Tokens, 2));
A_Line.Name := To_Unbounded_String(Slice(Tokens, 3));
A_Line.Title := To_Unbounded_String(Slice(Tokens, 4));
A_Line.ID := Natural'Value(Slice(Tokens, 5));
Payrate_IO.Get(Slice(Tokens,6),A_Line.Payrate,Last);
Put_Line(To_String(A_Line.Code));
Put_Line(To_String(A_Line.Department));
Put_Line(To_String(A_Line.Name));
Put_Line(To_String(A_Line.Title));
Put_Line(A_Line.ID'Image);
Put_Line(A_Line.Payrate'Image);
end loop;
end Hello;
And the output:
$gnatmake -o hello *.adb
gcc -c hello.adb
gnatbind -x hello.ali
gnatlink hello.ali -o hello
$hello
Hello, world!
IL
Sales
John
Sales_person
1378
25.46
IR
Crew
Jesse
Sales_person
1379
25.46
Note that I took out your File type and calls so I could test really quick using standard in as the input source.

Builder pattern in Ada

I am still new to Ada and not very proficient in the way object orientation is handled in Ada. :(
I would like to know if it is possible to implement a builder like pattern in Ada? This pattern is quite common in the Java programming language.
A simple example: Let's say I want to model a person object. A person has the following attributes:
First name
Middle name (optional)
Last name
Date of birth
Place of birth (optional)
I could implement four (overloaded) Create functions to cover all possible combinations:
declare
Person_1 : Person;
Person_2 : Person;
Person_3 : Person;
Person_4 : Person;
begin
Person_1 := Create(First_Name => "John",
Last_Name => "Doe",
Date_Of_Birth => "1990-02-27");
Person_2 := Create(First_Name => "John",
Middle_Name => "Michael",
Last_Name => "Doe",
Date_Of_Birth => "1990-02-27");
Person_3 := Create(First_Name => "John",
Last_Name => "Doe",
Date_Of_Birth => "1990-02-27",
Place_Of_Birth => "New York");
Person_4 := Create(First_Name => "John",
Middle_Name => "Michael",
Last_Name => "Doe",
Date_Of_Birth => "1990-02-27",
Place_Of_Birth => "New York");
end;
Builder pattern like (don't know if this is possible in Ada):
declare
Person_1 : Person;
Person_2 : Person;
Person_3 : Person;
Person_4 : Person;
begin
Person_1 := Person.Builder.First_Name("John")
.Last_Name("Doe")
.Date_Of_Birth("1990-02-27")
.Build();
Person_2 := Person.Builder.First_Name("John")
.Middle_Name("Michael")
.Last_Name("Doe")
.Date_Of_Birth("1990-02-27")
.Build();
Person_3 := Person.Builder.First_Name("John")
.Last_Name("Doe")
.Date_Of_Birth("1990-02-27")
.Place_Of_Birth("New York")
.Build();
Person_4 := Person.Builder.First_Name("John")
.Middle_Name("Michael")
.Last_Name("Doe")
.Date_Of_Birth("1990-02-27")
.Place_Of_Birth("New York")
.Build();
end;
First question: How could this example be implemented in Ada?
The Build function could check (at runtime) if all required attributes where initialized by the belonging functions.
Second question: Could this check be delegated (in a magic way) to the compiler so the following example would not compile?
declare
Person : Person;
begin
-- Last_Name function not called
Person := Person.Builder.First_Name("John")
.Date_Of_Birth("1990-02-27")
.Build();
end;
One Ada way of supporting the problem as stated would be to use default values for the parameters whose values aren’t required:
function Create (First_Name : String;
Middle_Name : String := "";
Last_Name : String;
Date_Of_Birth : String;
Place_Of_Birth : String := "")
return Person;
which accepts all your examples.
So yes, this is possible.
I strongly recommend you do not go with this approach. It have very bad performance problems, not to mention is harder to maintain. That being said, it is in fact possible (and should be in any language with dispatching). It's accomplished by an extension to a fluent pattern, which uses an intermediary type, to keep the primary type readonly. Because Ada does not have readonly fields, you will also need to use a property pattern to expose the fields in a readonly way.
Here's the spec
with Ada.Strings.Unbounded;
use Ada.Strings.Unbounded;
package Persons is
type Person is tagged private;
function First_Name(Self : in Person) return String;
function Middle_Name(Self : in Person) return String;
function Last_Name(Self : in Person) return String;
function Date_of_Birth(Self : in Person) return String;
function Place_of_Birth(Self : in Person) return String;
type Person_Builder is tagged private;
function Builder return Person_Builder;
function First_Name(Self : in Person_Builder; Value : in String) return Person_Builder;
function Middle_Name(Self : in Person_Builder; Value : in String) return Person_Builder;
function Last_Name(Self : in Person_Builder; Value : in String) return Person_Builder;
function Date_of_Birth(Self : in Person_Builder; Value : in String) return Person_Builder;
function Place_of_Birth(Self : in Person_Builder; Value : in String) return Person_Builder;
function Build(Source : in Person_Builder'Class) return Person;
private
type Person is tagged record
First_Name : Unbounded_String;
Middle_Name : Unbounded_String;
Last_Name : Unbounded_String;
Date_of_Birth: Unbounded_String;
Place_of_Birth: Unbounded_String;
end record;
type Person_Builder is tagged record
First_Name : Unbounded_String;
Middle_Name : Unbounded_String;
Last_Name : Unbounded_String;
Date_of_Birth: Unbounded_String;
Place_of_Birth: Unbounded_String;
end record;
end Persons;
and the body
package body Persons is
function First_Name(Self : in Person) return String is (To_String(Self.First_Name));
function Middle_Name(Self : in Person) return String is (To_String(Self.Middle_Name));
function Last_Name(Self : in Person) return String is (To_String(Self.Last_Name));
function Date_of_Birth(Self : in Person) return String is (To_String(Self.Date_of_Birth));
function Place_of_Birth(Self : in Person) return String is (To_String(Self.Place_of_Birth));
function Builder return Person_Builder is
begin
return Person_Builder'(To_Unbounded_String(""), To_Unbounded_String(""), To_Unbounded_String(""), To_Unbounded_String(""), To_Unbounded_String(""));
end Builder;
function First_Name(Self : in Person_Builder; Value : in String) return Person_Builder is
begin
return Person_Builder'(To_Unbounded_String(Value), Self.Middle_Name, Self.Last_Name, Self.Date_of_Birth, Self.Place_of_Birth);
end First_Name;
function Middle_Name(Self : in Person_Builder; Value : in String) return Person_Builder is
begin
return Person_Builder'(Self.First_Name, To_Unbounded_String(Value), Self.Last_Name, Self.Date_of_Birth, Self.Place_of_Birth);
end Middle_Name;
function Last_Name(Self : in Person_Builder; Value : in String) return Person_Builder is
begin
return Person_Builder'(Self.First_Name, Self.Middle_Name, To_Unbounded_String(Value), Self.Date_of_Birth, Self.Place_of_Birth);
end Last_Name;
function Date_of_Birth(Self : in Person_Builder; Value : in String) return Person_Builder is
begin
return Person_Builder'(Self.First_Name, Self.Middle_Name, Self.Last_Name, To_Unbounded_String(Value), Self.Place_of_Birth);
end Date_of_Birth;
function Place_of_Birth(Self : in Person_Builder; Value : in String) return Person_Builder is
begin
return Person_Builder'(Self.First_Name, Self.Middle_Name, Self.Last_Name, Self.Date_of_Birth, To_Unbounded_String(Value));
end Place_of_Birth;
function Build(Source : in Person_Builder'Class) return Person is
begin
return Person'(Source.First_Name, Source.Middle_Name, Source.Last_Name, Source.Date_of_Birth, Source.Place_of_Birth);
end Build;
end Persons;
Then an example program using that package
with Ada.Text_IO, Persons;
use Ada.Text_IO, Persons;
procedure Proof is
P : Person;
begin
P := Builder
.First_Name("Bob")
.Last_Name("Saget")
.Place_of_Birth("Philadelphia, Pennsylvania")
.Build;
Put_Line("Hello, my name is " & P.First_Name & " " & P.Last_Name & " and I am from " & P.Place_of_Birth);
Put_Line("Middle Name: " & P.Middle_Name);
Put_Line("Date of Birth: " & P.Date_of_Birth);
end Proof;
And here's the command line output
Now let me explain. Your primary type is of course Person, with Person_Builder acting as the mutable form of it. Builder converts from Person to Person_Builder and Build converts from Person_Builder back to Person. Person only supports readonly access to the fields through a property pattern. Similarly, Person_Builder supports mutation but not through a property pattern, rather through a fluent pattern which returns the new instance each call. These modifications can then be chained as a result of fluent application.
I believe Java has the Builder pattern because it does not support parameters with defaults. The Builder pattern in Java creates a workaround for those who do not want to use function overloading.
Ada does have default parameters, so an Ada way to address this need, (without using overloadding) is to use default parameters, as was suggested by Simon Wright.
A benefit of this approach, is that this gives you compile time checking, whereas using the Builder pattern, apparently it is a run-time check. Using the Create function as suggested by Simon, one cannot create a Person that doesn't have a first name, for example.
So in Ada, I'd say there isn't a need to implement a Builder pattern, since better mechanisms are built into the syntax. However, if one did want to implement a builder pattern, my approach would be to use Ada streaming capabilities to build a stream of attribute objects that can be passed into a Build procedure which reads the stream, and builds an object. That is essentially what the Java Build pattern is doing. This however puts the error checking back in the run-time, rather than at compile time, as it does in Java.
From my point of view at first sight, this would require the compiler to know the content of your builder object at compilation time and so this is not possible but I may be wrong.
One solution though, which is not really a builder pattern, might be to declare intermediate types such as
type Person_with_name is tagged record
First_name : String(1..50);
end record;
type Person_with_last_name is new Person_With_First_Name with
record
Last_Name : String(1..50);
end record;
type Person_with_last_name is new Person_With_Birth with
record
Date_Of_Birth : Date;
end record;
And then each you would have in your Builder object, functions returning these types
function LastName(with_first : Person_With_First_Name, last_name : String(1..50)) return Person_With_Last_Name;
function Date_Of_Birth(with_last : Person_With_Last_Name, date_Of_Birth : Date) return Person_With_Birth;
And so on... But that's a bit ugly :D
Please keep in mind that I didn't compile such a code :)
On the other hand, by writing pre- and post- conditions, you could be able to check this property using Spark and then prove that, when calling Build on your Builder object, this latter is correctly initialized.

PLS-00487 Error-Invalid reference to Variable 'CHAR'

I'm designing a function that is part of a larger package. The function is intended to take a District Code and return a collection of unique IDs for 10-15 stores that are assigned to that district. The function is intended to return a collection that can be queried like a table, i.e., using the TABLE function in a SQL statement.
I've created the following Types:
Schema Level type:
create or replace TYPE HDT_CORE_ORGIDS AS TABLE OF CHAR(20);
and a Type inside the Package
TYPE CORE_ORGIDS IS TABLE OF CHAR(20) INDEX BY BINARY_INTEGER;
Here's the function code:
FUNCTION FindDistrictOrgs(
ParamOrgCode VARCHAR2
)
RETURN HDT_CORE_ORGIDS
AS
ReturnOrgs HDT_CORE_ORGIDS := HDT_CORE_ORGIDS();
FDOTemp HDT_CORE_MAIN.CORE_ORGIDS;
i BINARY_INTEGER := 0;
CURSOR FDOCurr IS
SELECT org.id AS OrgID
FROM tp2.tpt_company org
WHERE LEVEL = 2
START WITH org.name = ParamOrgCode
CONNECT BY PRIOR org.id = org.parent_id;
BEGIN
OPEN FDOCurr;
LOOP
i := i +1;
FETCH FDOCurr INTO FDOTemp(i);
EXIT WHEN FDOCurr%NOTFOUND;
END LOOP;
IF FDOTemp.EXISTS(FDOTemp.FIRST) THEN
ReturnOrgs.EXTEND(FDOTemp.LAST);
FOR x IN FDOTemp.FIRST .. FDOTemp.LAST LOOP
ReturnOrgs(x) := FDOTemp(x).OrgID;
END LOOP;
END IF;
CLOSE FDOCurr;
RETURN ReturnOrgs;
END FindDistrictOrgs ;
I'm getting the PLS-00487:Invalid Reference to variable 'CHAR' at the line:
ReturnOrgs(x) := FDOTemp(x).OrgID;
I've double-checked at the value returned by the SQL (the org.id AS OrgID) is of the CHAR(20 BYTE) datatype.
So...what's causing the error?
Any help is appreciated! :)
OrgID is the alias you gave the column in your cursor, it has no meaning to the collection. Since both collections are of simple types you should just be doing:
ReturnOrgs(x) := FDOTemp(x);
The syntax you're using is implying FDOTemp is a collection of objects and you're trying to reference the OrgID attribute of an object; but since CHAR isn't an object type, this errors. The error message even makes some sense when viewed like that, though it's not terribly helpful if you don't already know what's wrong... and not entirely helpful when you do.
Incidentally, you could use a bulk collect to populate the collection without the cursor or loops, or the extra collection:
SELECT org.id
BULK COLLECT INTO ReturnOrgs
FROM tp2.tpt_company org
WHERE LEVEL = 2
START WITH org.name = ParamOrgCode
CONNECT BY PRIOR org.id = org.parent_id;
RETURN ReturnOrgs;

Reading in a record from a file in Ada?

Whenever I go to read in record from a file in Ada, I always get an error. The goal of the program is to read (from a file) an integer which is how many items needed to be recorded, in a last name consisting of (at most) 12 letters, a first name consisting of (at most) 12 letters, and a float value, then store those into a record.
This was from AdaGIDE:
record2.adb:32:04: invalid parameter list in call (use -gnatf for details)
My code:
with Ada.Text_IO, Ada.float_Text_IO, ada.Integer_Text_IO;
use Ada.Text_IO, Ada.float_Text_IO, ada.Integer_Text_IO;
procedure Record2 is
TYPE Testrec IS
record
test1 : string (1..12);
test2 : string (1..12);
test3 : float;
END RECORD;
T: Testrec;
Lt: Integer;
numitem: integer;
random1: Ada.Text_IO.File_Type;
begin -- Record2
Ada.Text_IO.Open(File => random1, Mode => Ada.Text_IO.In_File, Name => "info1.dat");
Get_Line(File => random1, Item => Testrec, Last => Lt);
Put(T.test1);
Put(T.Test2);
Put(T.Test3);
end Record2;
info1.dat's contents (no extra spaces or lines, just from "L" to "0":
LastName FirstName 4.00
My problems is the Get_Line, that I know. LastName is padded with spaces, filling the 12 characters, the same goes for FirstName. Then the float is taken for its value in general. What exactly am I doing wrong?
Basically, you're using Get_Line, which reads strings, to attempt to read an instance of a record.
Since this looks like a homework assignment (which is okay), I'll give you a hint:
Try reading the fields individually.
That's not enough to totally solve your problem, but it'll get you further, from which point you can try to work out the rest.

Dynamic dispatching in Ada

I am having trouble getting dynamic dispatching to work, even with this simple example. I believe the problem is in how i have set up the types and methods, but cannot see where!
with Ada.Text_Io;
procedure Simple is
type Animal_T is abstract tagged null record;
type Cow_T is new Animal_T with record
Dairy : Boolean;
end record;
procedure Go_To_Vet (A : in out Cow_T) is
begin
Ada.Text_Io.Put_Line ("Cow");
end Go_To_Vet;
type Cat_T is new Animal_T with record
Fur : Boolean;
end record;
procedure Go_To_Vet (A : in out Cat_T)
is
begin
Ada.Text_Io.Put_Line ("Cat");
end Go_To_Vet;
A_Cat : Cat_T := (Animal_T with Fur => True);
A_Cow : Cow_T := (Animal_T with Dairy => False);
Aa : Animal_T'Class := A_Cat;
begin
Go_To_Vet (Aa); -- ERROR This doesn't dynamically dispatch!
end Simple;
Two things:
The first is that you have to have an abstract specification of Go_To_Vet, so that delegation can take place (this has caught me a couple times as well :-):
procedure Go_To_Vet (A : in out Animal_T) is abstract;
And the second is that Ada requires the parent definition be in its own package:
package Animal is
type Animal_T is abstract tagged null record;
procedure Go_To_Vet (A : in out Animal_T) is abstract;
end Animal;
The type definitions in your Simple procedure then need to be adjusted accordingly (here I just withed and used the Animal package to keep it simple):
with Ada.Text_Io;
with Animal; use Animal;
procedure Simple is
type Cow_T is new Animal_T with record
Dairy : Boolean;
end record;
procedure Go_To_Vet (A : in out Cow_T) is
begin
Ada.Text_Io.Put_Line ("Cow");
end Go_To_Vet;
type Cat_T is new Animal_T with record
Fur : Boolean;
end record;
procedure Go_To_Vet (A : in out Cat_T)
is
begin
Ada.Text_Io.Put_Line ("Cat");
end Go_To_Vet;
A_Cat : Cat_T := (Animal_T with Fur => True);
A_Cow : Cow_T := (Animal_T with Dairy => False);
Aa : Animal_T'Class := A_Cat;
begin
Go_To_Vet (Aa); -- ERROR This doesn't dynamically dispatch! DOES NOW!! :-)
end Simple;
Compiling:
[17] Marc say: gnatmake -gnat05 simple
gcc -c -gnat05 simple.adb
gcc -c -gnat05 animal.ads
gnatbind -x simple.ali
gnatlink simple.ali
And finally:
[18] Marc say: ./simple
Cat
how to assign A_Cow to Aa ? (Aa := A_Cow; complains!)
You can't and shouldn't. Although they share a common base class, they are two different types. By comparison to Java, an attempt to convert a cat to a cow would cause a ClassCastException at run time. Ada precludes the problem at compile time, much as a Java generic declaration does.
I've expanded #Marc C's example to show how you can invoke base class subprograms. Note the use of prefixed notation in procedure Simple.
Addendum: As you mention class wide programming, I should add a few points related to the example below. In particular, class wide operations, such as Get_Weight and Set_Weight, are not inherited, but the prefixed notation makes them available. Also, these subprograms are rather contrived, as the tagged record components are accessible directly, e.g. Tabby.Weight.
package Animal is
type Animal_T is abstract tagged record
Weight : Integer := 0;
end record;
procedure Go_To_Vet (A : in out Animal_T) is abstract;
function Get_Weight (A : in Animal_T'Class) return Natural;
procedure Set_Weight (A : in out Animal_T'Class; W : in Natural);
end Animal;
package body Animal is
function Get_Weight (A : in Animal_T'Class) return Natural is
begin
return A.Weight;
end Get_Weight;
procedure Set_Weight (A : in out Animal_T'Class; W : in Natural) is
begin
A.Weight := W;
end Set_Weight;
end Animal;
with Ada.Text_IO; use Ada.Text_IO;
with Animal; use Animal;
procedure Simple is
type Cat_T is new Animal_T with record
Fur : Boolean;
end record;
procedure Go_To_Vet (A : in out Cat_T)
is
begin
Ada.Text_Io.Put_Line ("Cat");
end Go_To_Vet;
type Cow_T is new Animal_T with record
Dairy : Boolean;
end record;
procedure Go_To_Vet (A : in out Cow_T) is
begin
Ada.Text_Io.Put_Line ("Cow");
end Go_To_Vet;
A_Cat : Cat_T := (Weight => 5, Fur => True);
A_Cow : Cow_T := (Weight => 200, Dairy => False);
Tabby : Animal_T'Class := A_Cat;
Bossy : Animal_T'Class := A_Cow;
begin
Go_To_Vet (Tabby);
Put_Line (Tabby.Get_Weight'Img);
Go_To_Vet (Bossy);
Put_Line (Bossy.Get_Weight'Img);
-- feed Bossy
Bossy.Set_Weight (210);
Put_Line (Bossy.Get_Weight'Img);
end Simple;

Resources