I'm trying to hide some aspects of a library to the users and reading the RM for type conversions, I can't understand why the following code fails.
A user will instantiate root.child.concrete.concrete_t and then will call to root.p_userInterface passing that instance, but a compilation error is being thrown on root.adb:
invalid tagged conversion, not compatible with type "child_t'class" defined at root-child.ads:4
root.ads:
limited with root.child;
package root is
procedure p_userInterface (obj : in out root.child.child_t'Class);
private
type root_t is abstract tagged null record;
procedure p_primitive (this : in out root_t) is abstract;
end root;
root.adb:
with root.child;
package body root is
procedure p_userInterface (obj : in out root.child.child_t'Class) is
begin
-- error: invalid tagged conversion, not compatible with type "child_t'class" defined at root-child.ads:4
root_t'Class(obj).p_primitive;
end p_userInterface;
end root;
root-child.ads:
package root.child is
type child_t is abstract tagged private;
function f_getComponent(this : in child_t) return Integer;
private
type child_t is abstract new root_t with
record
component : Integer;
end record;
overriding
procedure p_primitive (this : in out child_t) is abstract;
end root.child;
root-child.adb:
package body root.child is
function f_getComponent(this : in child_t) return Integer is
begin
return this.component;
end f_getComponent;
end root.child;
root-child-concrete.ads:
package root.child.concrete is
type concrete_t is new child_t with private;
procedure p_setAnotherComponent (this : in out concrete_t;
c : Boolean);
function f_getAnotherComponent (this : concrete_t) return Boolean;
private
type concrete_t is new child_t with
record
anotherComponent : Boolean;
end record;
overriding
procedure p_primitive (this : in out concrete_t);
end root.child.concrete;
root-child-concrete.adb:
package body root.child.concrete is
procedure p_primitive (this : in out concrete_t) is
begin
-- for example
this.anotherComponent := True;
end p_primitive;
procedure p_setAnotherComponent (this : in out concrete_t;
c : Boolean) is
begin
this.anotherComponent := c;
end p_setAnotherComponent;
function f_getAnotherComponent (this : concrete_t) return Boolean is
begin
return this.anotherComponent;
end f_getAnotherComponent;
end root.child.concrete;
Why? I understand that the implementation of root is not able to see the private part of its root.child child package, thus is not able to see that type child_t is extending root_t privately. Am I right?
Can I achieve something like this differently? I would like to hide p_primitive to the users because is to perform internal things, but I would like to dispatch it internally if it's possible.
I think I have finally achieved it. Here is the solution that works for me, only on changed units, commenting out the old parts, as I can't use html strike tag to cross out code:
root.ads:
--limited with root.child;
package root is
type root_t is abstract tagged null record;
procedure p_userInterface (obj : in out root_t'Class); --root.child.child_t'Class);
private
--type root_t is abstract tagged null record;
--procedure p_primitive (this : in out root_t) is abstract;
type hiddenRoot_t is abstract new root_t with null record;
procedure p_primitive (this : in out hiddenRoot_t) is abstract;
end root;
root.adb:
--with root.child; It was not needed before neither
package body root is
procedure p_userInterface (obj : in out root_t'Class) is --root.child.child_t'Class) is
begin
--root_t'Class(obj).p_primitive; -- invalid tagged conversion, not compatible with type "child_t'class"
hiddenRoot_t'Class(obj).p_primitive;
end p_userInterface;
end root;
root-child.ads:
package root.child is
--type child_t is abstract tagged private;
type child_t is abstract new root_t with private;
function f_getComponent(this : in child_t) return Integer;
private
--type child_t is abstract new root_t with
type child_t is abstract new hiddenRoot_t with
record
component : Integer;
end record;
overriding
procedure p_primitive (this : in out child_t) is abstract;
end root.child;
This way I'm able to dispatch privately to the implementation of p_primitive of a concrete_t type, and on a main I can ensure that an instance of concrete_t has no visibility of p_primitive.
Any further comment to this solution will be appreciated, I do not know if I'm missing something important, but seems to work. I have no idea if it is the correct solution.
Related
I'm trying to use generics to 'genericize' a var that instantiates network transports of different types. I'm not sure if the "generic=no RTTI" rule would invalidate the approach or not, as I'm not yet up to speed with generics.
I've read this post:
What is the correct way to structure this generic object creation , which states the following in the question:
One other thing I would like to do if possible, is to change two
creations:
LAdapter := TSQLiteNativeConnectionAdapter.Create(LFilename)
LAdapter := TFireDacConnectionAdapter.Create(FDatabaseLink.FConnection as TFDConnection, FDatabaseLink.OwnedComponent)
to use an abstract "GetAdapterClass" type function in the parent
TModelDatabaseConnection and just declare the class of adapter in the
child to do something like:
LAdapter := GetAdapterClass.Create...
This is exactly what I would like to do as well. So if you can picture this:
type
TTransport<T> = class(TComponent)
private
...
function GetTransport: TTransport;
procedure SetTransport(AValue: TTransport);
...
public
...
property Transport: TTransport read GetTransport write SetTransport;
...
end;
TTCPIPTransport = class(TTransport<T>)
private
function GetSocket(Index: Integer): String;
procedure SetSocket(Index: Integer; AValue: String);
public
property Socket[Index: Integer]: String read GetSocket write SetSocket;
end;
TServiceTransport = class(TTransport<T>)
private
function GetServiceName: String;
procedure SetServiceName(AValue: String);
public
property ServiceName: String read GetServiceName write SetServiceName;
end;
TISAPITransport = class(TServiceTransport<T>);
THTTPSysTransport = class(TServiceTransport<T>)
private
function GetURL(Index: Integer): String;
procedure SetURL(Index: Integer; AValue: String);
public
property URL[Index: Integer]: read GetURL write SetURL;
end;
etc.
The idea is to create a base class that has all fields/properties/methods that are common to all transports, then have intermediate classes that contain fields/methods/properties that are common only to a certain subset of transports, then have the final version of each transport be specific to the type.
So when I call:
var
trans: TTransport<T> // or TTransport<TTCPIPTransport> etc.
begin
trans := TTransport<TTCPIPTransport>.Create(AOwner,....);
trans.Transport.Socket[0] := '127.0.0.1:8523';
OR
trans := TTransport<TISAPITransport>.Create(AOwner,...);
trans.Transport.ServiceName = 'Foo';
...
etc.
end;
or perhaps even more generic then that, but have each instance of trans - without typecasting - have properties/fields/methods that are specific to the subclass automagically show up.
This way I can have a config screen that allows an administrator to select the type of transport say in a combo box, the have that variable value set the type inside the <> in code, and one set of code handles creation of the object by it's type.
Is this possible using generics?
Here is my first (feeble) attempt at a class factory, never done this before. It works partially (generates the correct class) but isn't accessible as a distinct subclass of the base class without typecasting, which defeats the purpose. Please see inline comments
TWSTransport = class(TComponent)
...
public
constructor Create(AOwner: TComponent); virtual;
....
end;
TWSTransportClass = Class of TWSTransport;
TWSTCPIPTransportClass = class of TWSTCPIPTransport;
TWSHTTPSysTransport = class(TWSServiceTransport);
TWSServiceTransport = class(TWSTransport);
TWSTransportStringConversion = class(TWSTransport);
TWSTransportStreamFormat = class(TWSTransportStringConversion);
TTransportFactory = class(TClassList)
private
function GetTransport(Index: TWSTransportClass; AOwner: TkbmMWServer): TWSTransportClass;
public
procedure RegisterTransportClass(ATransportClass: TWSTransportClass);
property Transport[Index: TWSTransportClass; AOwner: TkbmMWServer]: TWSTransportClass read GetTransport;
end;
function TTransportFactory.GetTransport(Index: TWSTransportClass; AOwner: TkbmMWServer): TWSTransportClass;
begin
if IndexOf(Index) > -1 then
Result := TWSTransportClass(Items[IndexOf(Index)])
else
Result := TWSTransportClass(Index.Create(AOwner));
end;
procedure TTransportFactory.RegisterTransportClass(ATransportClass: TWSTransportClass);
var
index: Integer;
begin
// is the transport registered?
index := IndexOf(ATransportClass);
if index < 0 then
// the transport is not registered, add it to the list
Add(ATransportClass);
end;
initialization
factory := TTransportFactory.Create;
factory.RegisterTransportClass(TWSHTTPSysTransport);
factory.RegisterTransportClass(TWSISAPIRESTTransport);
factory.RegisterTransportClass(TWSTCPIPTransport);
finalization
FreeAndNil(factory);
end.
Here's how I tested it:
procedure TForm4.FormCreate(Sender: TObject);
var
//trans: TWSTCPIPTransport; // this doesn't work
trans: TWSTransport; // this works
begin
trans := factory.Transport[TWSTCPIPTransport,Self];
showmessage(trans.classname); // this shows the correct classname - TWSTCPIPTransport
trans.AddSocket('127.0.0.1:80'); // the compiler gives an error here because this call is specific to a subclass of TWSTransport, TWSTCPIPTransport.
end;
So I'm still missing something... anyone see the mistake?
I'm trying to understand how object oriented works in Ada. I have found a situation that I'm unable to resolve.
I know how to use class wide types for enabling polymorphism, and I know how to override a parent class' method from a derived one.
The thing I don't know how to do is to override a procedure that receives a class wide type as an argument, because I always obtain compilation errors. I explain this deeply below:
What I have tried
Type 1
package Pack1
type Type1 is tagged
record
i : Integer := 20;
end record;
function get_number(self : Type1) return Integer;
procedure do_something(self : Type1'class);
end Pack1;
----------------------------------------------------
package body Pack1 is
function get_number(self : Type1) return Integer is
begin
return 200;
end get_number;
procedure do_something(self : Type1'class) is
begin
Put_Line("Calling from Type1, " & (Integer'Image(self.i + self.get_number)));
end do_something;
end Pack1;
Type 2
package Pack2
type Type2 is new Type1 with
record
ii : Integer := 20;
end record;
overriding function get_number(self : Type2) return Integer;
overriding procedure do_something(self : Type2'class);
end Pack2;
----------------------------------------------------
package body Pack2 is
function get_number(self : Type2) return Integer is
begin
return 300;
end get_number;
procedure do_something(self : Type2'class) is
begin
Put_Line("Calling from Type2, " & (Integer'Image(self.i + self.ii + self.get_number)));
end do_something;
end Pack2;
Main
procedure Main is
t1 : Type1;
t2 : Type2;
begin
t1.do_something;
t2.do_something;
end Main;
Obtained error
I obtain an error during compilation time:
possible interpretation at Type1.ads
possible interpretation at Type2.ads
Expected output
I'm expecting to obtain the following, when I can compile the code:
Calling from Type1, 220
Calling from Type2, 350
How can I achieve the behavior I want?
Subprograms taking class-wide arguments are not primitive operations of the parent of the class, and can thus not be inherited.
If a subprogram takes a class-wide argument, the point is that its implementation is written in term of operations defined for the parent of the class. If you want to change its behaviour for a derived type, you do it by overriding the relevant primitive operations of the derived type.
Specifications:
package A is
type Values is range 0 .. 999;
type Instance is tagged private;
subtype Class is Instance'Class; --'
function Name (Item : in Instance) return String;
function Get_Number (Item : in Instance) return Values;
function Get_Sum (Item : in Instance) return Values;
private
type Instance is tagged
record
First : Values := 20;
end record;
end A;
with A;
package B is
subtype Parent is A.Instance;
type Instance is new Parent with private;
subtype Class is Instance'Class; --'
overriding
function Name (Item : in Instance) return String;
overriding
function Get_Number (Item : in Instance) return A.Values;
overriding
function Get_Sum (Item : in Instance) return A.Values;
private
type Instance is new Parent with
record
Second : A.Values := 20;
end record;
end B;
with Ada.Text_IO;
with A;
procedure Do_Something (Item : in A.Class);
Implementations:
package body A is
function Name (Item : in Instance) return String is ("Class A");
function Get_Number (Item : in Instance) return Values is (200);
function Get_Sum (Item : in Instance) return Values is (Item.First);
end A;
package body B is
use all type A.Values;
overriding
function Name (Item : in Instance) return String is ("Class B");
overriding
function Get_Number (Item : in Instance) return A.Values is (300);
overriding
function Get_Sum (Item : in Instance) return A.Values is (Parent (Item).Get_Sum + Item.Second);
end B;
procedure Do_Something (Item : in A.Class) is
use all type A.Values;
begin
Ada.Text_IO.Put_Line
("Calling from " & Item.Name & ", " & A.Values'Image (Item.Get_Number + Item.Get_Sum));
end Do_Something;
And finally a demonstrator:
with A;
with B;
with Do_Something;
procedure Inheritance_Demo_2018_06_13 is
O : A.Instance;
P : B.Instance;
begin
Do_Something (O);
Do_Something (P);
end Inheritance_Demo_2018_06_13;
As Jacob said in this answer, you can’t override Do_Something because it’s not primitive, because its controlling parameter is classwide.
If you remove Pack2.Do_Something altogether, your program will compile. However, the output is
$ ./main
Calling from Type1, 220
Calling from Type1, 320
which is getting closer to what you want.
A better solution would be to eliminate ’Class in Pack2.Do_Something, which makes it a primitive (dispatchable) operation.
I still don’t get the result you want:
$ ./main
Calling from Type1, 220
Calling from Type2, 340
Perhaps you meant to initialise Pack2.Type2.ii to 30?
(By the way, the code you posted doesn’t compile. Please make it easier for us to help you by submitting compilable examples!)
The problem is you are trying to use class types a bit too early. You want your Do_Something procedures to take an input of Type1 and Type2, not Type1'Class or Type2'Class. Then you can call those procedures from within another one that takes a class type parameter (which will give you your polymorphism).
Jacob Sparre Andersen showed you this in his answer, but I wanted to gen up something closer to your original code as an extra reference.
Below is a test program based on your original (compiled in the jdoodle online compiler) that shows the various ways to call the function polymorphically.
Code:
with Ada.Text_IO; use Ada.Text_IO;
procedure jdoodle is
package Pack1 is
type Type1 is tagged
record
i : Integer := 20;
end record;
type Type1_Class_Access is access all Type1'Class;
function get_number(self : Type1) return Integer;
procedure do_something(self : Type1); -- note the change here
end Pack1;
----------------------------------------------------
package body Pack1 is
function get_number(self : Type1) return Integer is
begin
return 200;
end get_number;
procedure do_something(self : Type1) is -- note the change here
begin
Put_Line("Calling from Type1, " & (Integer'Image(self.i + self.get_number)));
end do_something;
end Pack1;
package Pack2 is
use Pack1;
type Type2 is new Type1 with
record
ii : Integer := 20;
end record;
overriding function get_number(self : Type2) return Integer;
overriding procedure do_something(self : Type2); -- note the change here
end Pack2;
----------------------------------------------------
package body Pack2 is
function get_number(self : Type2) return Integer is
begin
return 300;
end get_number;
procedure do_something(self : Type2) is
begin
Put_Line("Calling from Type2, " & (Integer'Image(self.i + self.ii + self.get_number)));
end do_something;
end Pack2;
t1 : aliased Pack1.Type1;
t2 : aliased Pack2.Type2;
p1 : Pack1.Type1'Class := Pack1.Type1'(others => <>);
p2 : Pack1.Type1'Class := Pack2.Type2'(others => <>);
procedure Do_Something(Object : Pack1.Type1'Class) is
begin
Object.Do_Something; -- polymorphically calls Do_Something
end Do_Something;
type Class_Array is array(Integer range <>) of Pack1.Type1_Class_Access;
a : Class_Array(1..2) := (1 => t1'Access, 2 => t2'Access);
begin
-- Non Polymorphic calls
t1.do_something;
t2.do_something;
-- Polymorphic variable calls
-- both variables are of type Pack1.Type1'Class
p1.do_something;
p2.do_something;
-- Polymorphic procedure calls
-- the input type of the procedure is Pack1.Type1'Class
Do_Something(t1);
Do_Something(t2);
-- Polymorphic array of class access variable calls
for e of a loop
e.Do_Something;
end loop;
for e of a loop
Do_Something(e.all);
end loop;
end jdoodle;
Output:
Calling from Type1, 220
Calling from Type2, 340
Calling from Type1, 220
Calling from Type2, 340
Calling from Type1, 220
Calling from Type2, 340
Calling from Type1, 220
Calling from Type2, 340
Calling from Type1, 220
Calling from Type2, 340
I have the following code:
// irrelevant code ...
type
Zombie = class
private
...
Age : Integer;
Alive : Boolean;
TotalDeadZombies, TotalZombieAge : Double;
public
...
procedure ZombieGrow();
procedure CheckIfDead();
...
Function AvgLife() : Double;
end;
procedure Zombie.ZombieGrow();
begin
...
if (Alive = false) then
begin
TotalDeadZombies := TotalDeadZombies + 1;
TotalZombieAge := TotalZombieAge + Age;
end;
end;
procedure Zombie.CheckIfDead();
begin
if Random(100) < 20 then
Alive := False;
end;
function Zombie.AvgLife() : Double;
begin
Result := TotalZombieAge / TotalDeadZombie;
end;
The problem I have is I want to display the average age of dead zombies. This would be done via something like :
Write('Average age '+Floattostr(Round(AvgLife)))
However, this is called in another class (not shown here), and from my understanding of OOP, it would require me to specify an instantiated object, e.g zombies[1].AvgLife if they were stored in, say, a Zombies[] array (just an example).
Is there a way of making it so the variables TotalDeadZombies and TotalZombieAge are not tied to any instantiated zombies, but rather to a class variable that I can then just call AvgLife somehow? Is it as simple as just making them global variables? Or can it be done another way?
You just have to declare the variables as class var; then they belong to the class, and not to a particular instance of a class.
type
TZombie = class
public
class var TotalDeadZombies, TotalZombieAge: Double;
end;
You can access these like TZombie.TotalDeadZombies. Similarly, there are class methods, class properties, etc.
Have a look at the official documentation.
I am trying to create a package that has Dynamic dispatching using access types. I have achieved Dynamic Dispatching using Class Types using This Q/A as a guide.
I keep getting a compilation error that says: cannot call abstract subprogram. This makes me think that the compiler either doesnt recognize the specialized subprogram, or doesnt recognize the type as a specialized type. But both seem right to me... I dont get it.
main.2.ada
with Ada.Text_IO;
with Animal.Cat;
procedure Main is
Tabby : aliased Animal.Cat.Cat_t;
Animal_Ref : Animal.Any_Animal_Ptr := Tabby'Unchecked_Access;
Result : Boolean;
begin
Animal.Stroke_Fur (Animal => Animal_Ref.all);
Result := Animal.Is_Happy(Ptr => Animal_Ref);
Ada.Text_IO.Put_Line ("Happy Animal = " & Boolean'Image (Result));
end Main;
animal.1.ada
package Animal is
type base_t is abstract tagged limited null record;
type Animal_t is abstract new
base_t with private;
type Any_Animal_Ptr is access all Animal_t'Class;
----
procedure Stroke_Fur (Animal : in out Animal_t) is abstract;
----
function Is_Happy (Ptr : in Any_Animal_Ptr) return boolean is abstract;
private
type Animal_t is abstract new base_t with
record
Index : integer;
end record;
end Animal;
animal.cat.1.ada
package Animal.Cat is
type Cat_t is new Animal.Animal_t with private;
type Cat_Ptr is access all Cat_t;
----
procedure Stroke_Fur (Cat : in out Cat_t);
----
function Is_Happy (Ptr : in Cat_Ptr) return Boolean;
private
type Cat_t is new Animal.Animal_t with
record
Purr : Boolean := False;
end record;
end Animal.Cat;
animal.cat.2.ada
package body Animal.Cat is
----
procedure Stroke_Fur (Cat : in out Cat_t) is
begin
Cat.Purr := True;
end Stroke_Fur;
----
function Is_Happy (Ptr : in Cat_Ptr) return Boolean is
begin
return Ptr.Purr;
end Is_Happy;
end Animal.Cat;
Error
main.2.ada:13:21: cannot call abstract subprogram "Is_Happy"
function Is_Happy (Ptr : in Any_Animal_Ptr) return boolean is abstract;
isn’t a primitive operation (ARM3.2.3(2)) of Animal_t, and so it isn’t dispatching; it’s merely an abstract subprogram (which therefore can’t be called).
Why would you want to make a non-dispatching subprogram abstract? Perhaps you might have a type Metres, in which case the predefined ”*” is inappropriate (multiplying two distances in metres returns an area, not a distance) and you might want to make it abstract to prevent inadvertent misuse.
Anyway, you can declare a primitive operation of Animal_t using accesses as
function Is_Happy (Ptr : access Animal_t) return boolean is abstract;
and then for cats
function Is_Happy (Ptr : access Cat_t) return Boolean;
(or even
overriding
function Is_Happy (Ptr : access Cat_t) return Boolean;
if you want the compiler to check that it really is overriding).
By the way, if you are using Ada 2005 or later you can use the prefixed notation to write the calls as
Animal_Ref.Stroke_Fur;
Result := Animal_Ref.Is_Happy;
which is prettier.
Dont know what this oop pattern is called but how can I do the same pattern in Ada?
For example this code:
interface Vehicle{
string function start();
}
class Tractor implements Vehicle{
string function start(){
return "Tractor starting";
}
}
class Car implements Vehicle{
string function start(){
return "Car starting";
}
}
class TestVehicle{
function TestVehicle(Vehicle vehicle){
print( vehicle.start() );
}
}
new TestVehicle(new Tractor);
new TestVehicle(new Car);
my failed attempt in Ada:
How to fix it properly?
with Ada.Text_IO;
procedure Main is
package packageVehicle is
type Vehicle is interface;
function Start(Self : Vehicle) return String is abstract;
end packageVehicle;
type Tractor is new packageVehicle.Vehicle with null record;
overriding -- optional
function Start(Self : Tractor) return string is
begin
return "Tractor starting!";
end Start;
type Car is new packageVehicle.Vehicle with null record;
overriding -- optional
function Start(Self : Car) return string is
begin
return "Car starting!";
end Start;
procedure TestVehicle(Vehicle : packageVehicle.Vehicle) is
begin
Ada.Text_IO.Put_Line( "Testing a vehicle" );
Ada.Text_IO.Put_Line( Start(Vehicle) );
end;
Tractor0 : Tractor;
Car0 : Car;
begin
Ada.Text_IO.Put_Line( TestVehicle(Tractor0) );
Ada.Text_IO.Put_Line( TestVehicle(Car0) );
end Main;
Compiler says:
Builder results warning: declaration of "TestVehicle" is too late
Builder results warning: spec should appear immediately after declaration of "Vehicle"
The key thing to be aware of is "All user-defined primitive subprograms of an interface type shall be abstract subprograms or null procedures." (Ref) I.e. you can't define a subprogram that takes the interface itself as a parameter (yes, I know this is different from Java.) This is why you're getting the error on the TestVehicles declaration.
Essentially, you have to define a type that implements the interface(s), then work with that type.
The Ada Rationale chapter on Interfaces discusses this in some detail.
Here's a working example based on your question--I renamed some things and fixed a couple errors that were probably getting lost amongst the error messages you were seeing :-) Note the addition of a type 'Concrete_Vehicles' that instantiates the Vehicle interface.
with Ada.Text_IO; use Ada.Text_IO;
procedure Interface_Test is
package Package_Vehicle is
type Vehicle is interface;
function Start(Self : Vehicle) return String is abstract;
end Package_Vehicle;
type Concrete_Vehicles is abstract new Package_Vehicle.Vehicle with null record;
type Tractor is new Concrete_Vehicles with null record;
overriding -- optional
function Start(Self : Tractor) return string is
begin
return "Tractor starting!";
end Start;
type Car is new Concrete_Vehicles with null record;
overriding -- optional
function Start(Self : Car) return string is
begin
return "Car starting!";
end Start;
procedure TestVehicle(Vehicle : Concrete_Vehicles'Class) is
begin
Ada.Text_IO.Put_Line( "Testing a vehicle" );
Ada.Text_IO.Put_Line( Start(Vehicle) );
end;
Tractor0 : Tractor;
Car0 : Car;
begin
TestVehicle(Tractor0);
TestVehicle(Car0);
end Interface_Test;
Compiling and running:
[22] Marc say: gnatmake interface_test.adb
gcc -c interface_test.adb
gnatbind -x interface_test.ali
gnatlink interface_test.ali
[23] Marc say: ./interface_test
Testing a vehicle
Tractor starting!
Testing a vehicle
Car starting!
Java-style interfaces was introduced in Ada2005:
type Vehicle is interface;
Any operations on the interface must be abstract:
function start(Self : Vehicle) return String is abstract;
When inheriting the interface, you must specify it as a parent, and implement the
operations defined for the interface ("overriding" tells the compiler that the parent must have a corresponding "start". The keyword is optional, however):
type Tractor is new Vehicle with null record;
overriding -- optional
function start(Self : Tractor) return String;
I will leave the rest as an exercise, you can read more about interfaces in the wikibook
Below is a working version of your program, using pointers (called "access" in Ada). You don't need an implementation of the interface to work with the interface, same as in your Java example, which is the main point of object oriented programming and polymorphism.
with Ada.Text_IO;
procedure Main is
package packageVehicle is
type Vehicle is interface;
function Start(Self : Vehicle) return String is abstract;
end packageVehicle;
type Tractor is new packageVehicle.Vehicle with null record;
overriding -- optional
function Start(Self : Tractor) return string is
begin
return "Tractor starting!";
end Start;
type Car is new packageVehicle.Vehicle with null record;
overriding -- optional
function Start(Self : Car) return string is
begin
return "Car starting!";
end Start;
procedure TestVehicle(Vehicle : Access packageVehicle.Vehicle'class) is
begin
Ada.Text_IO.Put_Line( "Testing a vehicle" );
Ada.Text_IO.Put_Line( Vehicle.Start );
end;
Tractor0 : access Tractor'Class := new Tractor;
Car0 : access Car'Class := new Car;
begin
TestVehicle(Tractor0);
TestVehicle(Car0);
end Main;
PS: I'm new to Ada, I might be wrong with things, but I have the idea from https://github.com/raph-amiard/ada-synth-lib where this concept is used a lot.