Ada：多态回调答案

【问题标题】：Ada: polymorphic callbacksAda：多态回调
【发布时间】：2023-02-10 08:44:12
【问题描述】：

我正在尝试使用 OOP 和动态调度实现观察者模式，但我无法创建子程序访问常量，因为命名访问的参数类型和类型扩展的过程不匹配。

我提供了一个最小的可重现示例，省略了订阅：

package Alarms is

  type time_t is mod 2**32;

  type AlarmObserver_t is interface;
  type Callback_t is access procedure (this : in out AlarmObserver_t);

  type AlarmPublisher_t (<>) is tagged limited private;
  function fConstructor (capacity : in Positive) return AlarmPublisher_t;

private

  type AlarObserverAcc_t is access AlarmObserver_t'Class;

  type dummy_t is new AlarmObserver_t with null record;
  procedure pEventDummy (this : in out dummy_t) is Null;

  dummy : constant AlarObserverAcc_t := new dummy_t;
  dummyCallback : constant Callback_t := pEventDummy'Access; --Fails

  type Node_t is limited
    record
      Observer : AlarObserverAcc_t := dummy;
      Callback : Callback_t := dummyCallback;
      time : time_t := time_t'Last;
    end record;

  defaultNode : constant Node_t := Node_t' (Observer => dummy,
                                            Callback => dummyCallback,
                                            time     => time_t'Last);

  type ObserverArray_t is array (Positive range <>) of Node_t;

  type AlarmPublisher_t (capacity : Positive) is tagged limited 
    record
      --Member "observers" has default initialisation because Node_t is initialised
      observers : ObserverArray_t (Positive'First .. capacity);
    end record;

end Alarms;

以及让您重现它的实现：

package body Alarms is
  
  function fConstructor (capacity : in Positive) return AlarmPublisher_t is
  begin
    return Obj : AlarmPublisher_t (capacity => capacity) do
      Null;
    end return;
  end fConstructor;

end Alarms;

我在Matthew Heaney callbacks Observer pattern 中受到鼓舞

他为访问子程序过程使用类范围的参数，但我想使用 OOP 符号并让具体的观察者将这些过程作为原语。

如果 dummy_t 实现了 AlarmObserver_t 接口，为什么过程 pEventDummy 不兼容？我可以做我想做的事吗？

【问题讨论】：

我可以将回调参数设置为全类，然后实现一个兼容的包装程序来向下转换并执行调度调用，但这有点烦人，我不喜欢它

标签： design-patterns ada

【解决方案1】：

我建议向您的接口类型添加一个多态操作：

package Alarms is

  type time_t is mod 2**32;

  type AlarmObserver_t is interface;
  procedure Callback(This : in out AlarmObserver_t) is abstract; -- polymorphic operation

  type AlarmPublisher_t (<>) is tagged limited private;
  function fConstructor (capacity : in Positive) return AlarmPublisher_t;

private

  type AlarObserverAcc_t is access AlarmObserver_t'Class;

  type dummy_t is new AlarmObserver_t with null record;
  overriding procedure Callback(This : in out dummy_t) is null;  -- local type override

  dummy : constant AlarObserverAcc_t := new dummy_t;

  type Node_t is limited
    record
      Observer : AlarObserverAcc_t := dummy;
      time : time_t := time_t'Last;
    end record;

  defaultNode : constant Node_t := Node_t' (Observer => dummy,
                                            time     => time_t'Last);

  type ObserverArray_t is array (Positive range <>) of Node_t;

  type AlarmPublisher_t (capacity : Positive) is tagged limited 
    record
      --Member "observers" has default initialisation because Node_t is initialised
      observers : ObserverArray_t (Positive'First .. capacity);
    end record;

end Alarms;

package body Alarms is

    function fConstructor (capacity : in Positive) return AlarmPublisher_t is
    begin
        return Obj : AlarmPublisher_t (capacity => capacity) do
            Null;
        end return;
    end fConstructor;

end Alarms;

您可以使用 Object.Operation 表示法为您的 AlarmPublisher_t 对象调用 Callback。前任：

observers(1).observer.Callback;

【讨论】：