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;