Implement an interface with class wide operations in Ada 95

Question

I'm creating a program with Ada 95 and I have a problem. Specifically, I'm trying to implement a class which executes functors given as parameters.

The behavior I want to achieve is:

Declare an interface IF with a procedure Execute.
Derive from IF with a class C and implement Execute.
Create a class D which has a field that is an array of IF. Since IF cannot be instantiated, I use an array of access IF.
Instantiate an object of class D giving it several instances of C as parameters.
Call Execute on every instance of C contained in the array of D.

I've been able to implement the above and compile it, but when I execute it I obtain the error accessibility check failed when trying to assign an object of class C to a component of the array in D.

I know that the error I obtain is because the assignment I'm doing can lead to a danging pointer error according to the Ada policies, so my question is what is the proper way to implement this in Ada 95?

The source code is below. The error is raised in the file elevators.adb, in the procedure Add_Event_Handler, I have commented the statement that causes it.

Functors.ads

package Functors is

    type IFunctor is abstract tagged null record;

    procedure Execute(Self : in out IFunctor) is abstract;

end Functors;

Elevators.ads

with Functors; use Functors;

package Elevators is

    NOT_A_FLOOR : constant := -1;
    MAX_EVENT_HANDLERS : constant := 255;

    type Floor is new Integer range NOT_A_FLOOR .. 4; 

    type Elevator is private;

    subtype Event_Handler is IFunctor'Class; --'
    type Event_Handler_Index is new Integer range 0 .. MAX_EVENT_HANDLERS;
    type Event_Handers is array(Event_Handler_Index) of access Event_Handler;


    function Create_Elevator return Elevator;

    procedure Add_Stop_Handler(Self : in out Elevator; Handler : access Event_Handler);
    procedure Add_Moving_Handler(Self : in out Elevator; Handler : access Event_Handler);
    procedure Add_Called_Handler(Self : in out Elevator; Handler : access Event_Handler);
    procedure Add_Button_Pressed_Handler(Self : in out Elevator; Handler : access Event_Handler);

    procedure Run_Simulation(Self : in out Elevator);

    private
        type Elevator is
        record
            Current_Floor : Floor := 0;
            Is_Moving : Boolean := False;
            Next_Floor : Floor := NOT_A_FLOOR;

            Stop : Event_Handers := (others => null);
            Moving : Event_Handers := (others => null);
            Called : Event_Handers := (others => null);
            Button_Pressed : Event_Handers := (others => null);
        end record;

        procedure On_Stop(Self : in out Elevator);
        procedure On_Moving(Self : in out Elevator);
        procedure On_Called(Self : in out Elevator);
        procedure On_Button_Pressed(Self : in out Elevator);

        procedure Add_Event_Handler(Self : out Event_Handers; Handler : access Event_Handler);
        procedure Exec_All_Events(Self : in out Elevator; EH : in Event_Handers);

end Elevators;

Elevators.adb

with Ada.Text_IO; use Ada.Text_IO;

package body Elevators is

    function Create_Elevator return Elevator is
        elev : Elevator;
    begin
        return elev;
    end;

    procedure Add_Stop_Handler(self : in out Elevator; Handler : access Event_Handler) is
    begin
        Add_Event_Handler(self.Stop, Handler);
    end;

    procedure Add_Moving_Handler(self : in out Elevator; Handler : access Event_Handler) is
    begin
        Add_Event_Handler(self.Moving, Handler);
    end;

    procedure Add_Called_Handler(self : in out Elevator; Handler : access Event_Handler) is
    begin
        Add_Event_Handler(self.Called, Handler);
    end;

    procedure Add_Button_Pressed_Handler(self : in out Elevator; Handler : access Event_Handler) is
    begin
        Add_Event_Handler(self.Button_Pressed, Handler);
    end;

    procedure Run_Simulation(self : in out Elevator) is
    begin
        Put_Line("Floor: " & Floor'Image(self.Current_Floor)); --'
        self.Next_Floor := 3;

        On_Called(self);
        On_Moving(self);
        On_Stop(self);
    end;

    procedure On_Stop(self : in out Elevator) is
    begin
        self.Current_Floor := self.Next_Floor;
        self.Is_Moving := False;
        self.Next_Floor := NOT_A_FLOOR;

        Put_Line("Stopped. Current floor = " & Floor'Image(self.Current_Floor)); --'

        Exec_All_Events(self, self.Stop);
    end;

    procedure On_Moving(self : in out Elevator) is
    begin
        self.Is_Moving := True;
        self.Current_Floor := NOT_A_FLOOR;
        Put_Line("Moving to floor " & Floor'Image(self.Next_Floor)); --'

        Exec_All_Events(self, self.Moving);
    end;

    procedure On_Called(self : in out Elevator) is
    begin
        Put_Line("Calling button pressed (" & Floor'Image(self.Next_Floor) & ")..."); --'

        Exec_All_Events(self, self.Moving);
    end;

    procedure On_Button_Pressed(self : in out Elevator) is
    begin
        null;
    end;

    procedure Add_Event_Handler(Self : out Event_Handers; Handler : access Event_Handler) is
        I : Event_Handler_Index := Event_Handler_Index'First; --'
    begin
        while I < Event_Handler_Index'Last loop --'
            if Self(I) = null then
                Self(I) := Handler; -- ======> The error is raised here <======
                exit;
            end if;
            I := I + 1;
        end loop;
    end;

    procedure Exec_All_Events(self : in out Elevator; EH : in Event_Handers) is
        I : Event_Handler_Index := Event_Handler_Index'First; --'
    begin
         while I < Event_Handler_Index'Last loop --'
            if EH(I) /= null then
                EH(I).Execute;
            end if;
            I := I + 1;
        end loop;
    end;

end Elevators;

main.adb

with Ada.Text_IO; use Ada.Text_IO;
with Functors; use Functors;
with Elevators; use Elevators;

procedure Main is

    type My_Functor is new IFunctor with
    record
        I : Integer := 0;
    end record;

    overriding
    procedure Execute(Self : in out My_Functor) is
    begin
        Put_Line("Executing functor, I is " & Integer'Image(Self.I)); --'
        Self.I := Self.I + 1;
    end;

    Generic_Functor : aliased My_Functor;
    Elev : Elevator := Create_Elevator;
begin
    Add_Stop_Handler(elev, Generic_Functor'Access); --'
    Add_Moving_Handler(elev, Generic_Functor'Access); --'
    Add_Called_Handler(elev, Generic_Functor'Access); --'

    Run_Simulation(Elev);
end;

EDIT

I have done the following changes in order to fix the mentioned runtime error, but I still obtain the accessibility check failed.

elevators.ads

...
type Event_Handler_Generic_Ptr is access all Event_Handler;
type Event_Handers is array(Event_Handler_Index) of Event_Handler_Generic_Ptr;
...

elevators.adb

procedure Add_Event_Handler(Self : out Event_Handers; Handler : access Event_Handler) is
        I : Event_Handler_Index := Event_Handler_Index'First; --'
    begin
        while I < Event_Handler_Index'Last loop --'
            if Self(I) = null then
                -- Notice the casting here
                Self(I) := Event_Handler_Generic_Ptr(Handler); -- ======> The error is raised here <======
                exit;
            end if;
            I := I + 1;
        end loop;
    end;