Реализовать интерфейс с широкими классами операций в Аде 95 - PullRequest
Новая
       74

Реализовать интерфейс с широкими классами операций в Аде 95

0 голосов
/ 03 июля 2018

Я создаю программу с Ada 95 , и у меня проблема. В частности, я пытаюсь реализовать класс, который выполняет функторы, заданные в качестве параметров.

Я хочу добиться поведения:

  • Объявить интерфейс IF с процедурой Execute.
  • Получите из IF с классом C и внедрите Execute.
  • Создайте класс D, который имеет поле, являющееся массивом IF. Поскольку IF не может быть создан, я использую массив access IF.
  • Создание экземпляра объекта класса D с несколькими экземплярами C в качестве параметров.
  • Вызовите Execute для каждого экземпляра C, содержащегося в массиве D.

Мне удалось реализовать вышеизложенное и скомпилировать его, но при его выполнении я получаю ошибку проверки доступности, при попытке назначить объект класса C компоненту массива в D.

Я знаю, что ошибка, которую я получаю, заключается в том, что выполняемое мною назначение может привести к появлению ошибки указателя в соответствии с правилами Ada, поэтому мой вопрос , как правильно реализовать это в Ada 95

Исходный код приведен ниже. Ошибка возникает в файле elevators.adb, в процедуре Add_Event_Handler я прокомментировал утверждение, которое ее вызывает.

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

Я внес следующие изменения, чтобы исправить указанную ошибку времени выполнения, но все равно получаю 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;

1 Ответ

0 голосов
/ 03 июля 2018

Поскольку вы храните указатель, сгенерированный с помощью 'Access в Event_Handlers, вы должны объявить его с помощью access all, так что это общий тип доступа : 

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

Если вы пропустите all, это будет тип доступа для пула. См. Ada 95 RM, 3.10 Типы доступа , (8) и (10). специфичные для пула типы доступа могут содержать только указатели на объекты, выделенные в пуле хранения, а ваш объект - нет.

...