我正在使用 Ada 95 创建程序，但遇到了问题。具体来说，我正在尝试实现一个类，该类执行作为参数给出的仿函数。
我要实现的行为是：
IF声明接口Execute。IF派生一个类C并实现Execute。D，该类的字段为IF的数组。由于无法实例化IF，因此我使用access IF的数组。D的对象，并为其提供多个C实例作为参数。Execute数组中包含的C的每个实例调用D。我已经可以实现上面的内容并对其进行编译，但是当我执行它时，尝试将类C的对象分配给{{ 1}}。
我知道我得到的错误是因为根据Ada策略，我正在做的赋值可能导致指针指针错误，所以我的问题是在Ada 95中实现此错误的正确方法是什么< / strong>？
下面是源代码。在过程D中的文件elevators.adb中引发了错误，我已注释了引起该错误的语句。
Add_Event_Handlerpackage Functors is
type IFunctor is abstract tagged null record;
procedure Execute(Self : in out IFunctor) is abstract;
end Functors;
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;
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;
为了解决上述运行时错误，我进行了以下更改，但仍获得了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;
。
accessibility check failed...
type Event_Handler_Generic_Ptr is access all Event_Handler;
type Event_Handers is array(Event_Handler_Index) of Event_Handler_Generic_Ptr;
...
答案 0 :(得分：2)
由于将由'Access生成的指针存储在Event_Handlers中，因此必须使用 access all 对其进行声明，这样它才是常规访问权限输入：
type Event_Handers is array(Event_Handler_Index) of access all Event_Handler;
如果您错过了 all ，则它是特定于池的访问类型。参见Ada 95 RM, 3.10 Access Types，（8）和（10）。 特定于池的访问类型只能保存指向存储池中分配的对象的指针，而对象不是。