A.1. Inheritance - JulTob/Ada GitHub Wiki
A subclass can inherit methods from a root class.
type Root is tagged record
F1: Integer;
end record
procedure Meth(Self: Root);
procedure R_Meth(Self: Root'class) is begin Self.Meth; end r_meth;
papa : Root;
...
papa.Meth;
papa.R_Meth;
type A_Tree is new Root with record
F2: Integer;
end Child;
overriding
procedure Meth(Self: A_Tree);
procedure A_Meth(Self: A_Tree);
Child: A_Tree;
...
Child.Meth;
Child.A_Meth;
Child.R_Meth;
type Root_Access is access all Root’Class;
V : Root_Access := new A_Tree;
begin
Proc (V.all);
procedure Method_2 (P : Root) is
begin
P.Method_1;
end;
procedure Method_2 (P : Root) is
begin
Root’Class (P).Method_1; --redispatching
end;
procedure Proc (P : Root’Class) is
begin
Root (P).Method_1; --primitive
end;
Example of inheritance
Creatures.ads
With Ada.Strings.Unbounded; Use Ada.Strings.Unbounded; package Creatures is type Creature is abstract tagged private; type Dragon is new Creature with private; procedure Health (AnyCreature : Creature'Class); function Make (Roar : String; health : integer) Return Dragon; private type Creature is tagged record Health : Integer; End Record; type Dragon is new Creature with record FireProof: Boolean := True; Roar: Unbounded_String; End Record; End Creatures;
Creatures.adb
with Text_io; Use Text_IO; package body Creatures is function Make (Roar : String; health : integer) Return Dragon is Fireproof: Boolean := True; begin return ( Fireproof, To_Unbounded_String(Roar), Health); end Make; procedure Health (AnyCreature : Creature'Class) is Put_Line( "Health: " & Integer'Image(AnyCreature.Health); If AnyCreature in Dragon'Class then If Dragon(AnyCreature).FireProof then Put_Line(" Fireproof"); End If; End If; end Health; End Creatures;