使用 Ada 的 My_Class'Class(This) cast 来模仿模板方法设计模式

Question

上下文

我最近遇到了一个基本的 OOP / Ada 2012 设计问题。

基本上，我有一个实现接口契约的父类。 这是在实现提供者 (ConcreteX) 内的几个步骤中完成的。 子类通过仅覆盖其中一个步骤（DerivedY、Step_2）来扩展此实现。 （试图获得一些 SOLID 属性）

我天真地假设会发生调度。它没有。 我重新发现分派不像 Java 或其他 OOP 那样，并且有一个解决方案。

在 Ada 中的调度经常被问到/回答/记录在几个问题中：Dynamic dispatching in Ada、Dynamic Dispatching in Ada with Access Types、Fundamentals of Ada's T'Class

而不是使用：

This.Step_1; This.Step_2;

我最终使用了：

T_Concrete_X'Class (This).Step_1; T_Concrete_X'Class (This).Step_2;

问题

在 Ada OOP 类设计中，我在这两个选择之间苦苦挣扎：

1. 在父类中，定义行为 + 原语并提供默认实现，即 Current_Class'Class(This).method()（= 下面提供的工作示例）

2. 使用模板设计模式，以便将执行步骤的实现委托给另一个类

即在给定的示例中：

-- T_Concrete_X does not have a child class (current example)
overriding procedure If_A_Proc_1 (This : in out T_Concrete_X) is
begin
   -- This.template_executor being set with different classes realizing the Step_1/Step_2 contracts(current example)
   This.template_executor.Step_1;
   This.template_executor.Step_2;
end If_A_Proc_1;

1 是为了实现预期行为而应避免的语法“技巧”吗？

当我写一个明确的演员表时，我总是觉得这是设计薄弱的标志。

---

工作示例：

src/interfacea.ads

package InterfaceA is

   type T_InterfaceA is interface;
   type T_InterfaceA_Class_Access is access all T_InterfaceA'Class;

   procedure If_A_Proc_1 (This : in out T_InterfaceA) is abstract;

end InterfaceA;

src/concretex.ads

with InterfaceA;
use InterfaceA;

package ConcreteX is
   type T_Concrete_X is new T_InterfaceA with private;

   package Constructor is
      function Create return access T_Concrete_X;
   end Constructor;

   overriding procedure If_A_Proc_1 (This : in out T_Concrete_X);
   procedure Step_1 (This : in out T_Concrete_X);
   procedure Step_2 (This : in out T_Concrete_X);
private
   type T_Concrete_X is new T_InterfaceA with null record;
end ConcreteX;

src/concretex.adb

with GNATColl.Traces;

package body ConcreteX is
   use GNATColl.Traces;
   Me : constant Trace_Handle := Create ("ConcreteX");

   package body Constructor is
      function Create return access T_Concrete_X is begin
         Set_Active (Me, True);
         Increase_Indent (Me, "T_Concrete_X Constructor");
         Decrease_Indent (Me);
         return new T_Concrete_X;
      end Create;
   end Constructor;

   overriding procedure If_A_Proc_1 (This : in out T_Concrete_X) is begin
      Increase_Indent (Me, "If_A_Proc_1");

      Trace (Me, "If_A_Proc_1 - use This directly");
      -- not dispatching
      This.Step_1;
      This.Step_2;

      -- dispatching
      --Trace (Me, "If_A_Proc_1 - cast This to ConcreteX'Class");
      --T_Concrete_X'Class (This).Step_1; -- equivalent to (This'Class).Step_1;
      --T_Concrete_X'Class (This).Step_2; -- equivalent to (This'Class).Step_2;
      Decrease_Indent (Me);
   end If_A_Proc_1;

   procedure Step_1 (This : in out T_Concrete_X) is begin
      Increase_Indent (Me, "Step_1");
      Decrease_Indent (Me);
   end Step_1;

   procedure Step_2 (This : in out T_Concrete_X) is begin
      Increase_Indent (Me, "Step_2");
      Decrease_Indent (Me);
   end Step_2;

end ConcreteX;

src/concretex-derivedy.ads

package ConcreteX.DerivedY is
   type T_Derived_Y is new T_Concrete_X with private;

   package Constructor is
      function Create return access T_Derived_Y;
   end Constructor;

   overriding procedure Step_2 (This : in out T_Derived_Y);

private
   type T_Derived_Y is new T_Concrete_X with null record;
end ConcreteX.DerivedY;

src/concretex-derivedy.adb

with GNATColl.Traces;

package body ConcreteX.DerivedY is
   use GNATColl.Traces;
   Me : constant Trace_Handle := Create ("DerivedY");

   package body Constructor is
      function Create return access T_Derived_Y is begin
         Set_Active (Me, True);
         Increase_Indent (Me, "Constructor");
               Decrease_Indent (Me);
         return new T_Derived_Y;
      end Create;
   end Constructor;

   overriding procedure Step_2 (This : in out T_Derived_Y) is begin
      Increase_Indent (Me, "Step_2");
      Decrease_Indent (Me);
   end Step_2;

end ConcreteX.DerivedY;

src/main.adb

with InterfaceA;
with ConcreteX;
with ConcreteX.DerivedY;

with Ada.Text_IO;
with GNATColl.Traces;

procedure Main is
   use ConcreteX;
   use InterfaceA;
   use Ada.Text_IO;
   use GNATCOLL.Traces;
   Me  : constant Trace_Handle := Create ("MAIN");

   C : T_InterfaceA'Class := T_InterfaceA'Class(Constructor.Create.all);
   D : T_InterfaceA'Class := T_InterfaceA'Class(DerivedY.Constructor.Create.all);
begin
   Parse_Config_File;
   Set_Active (Me, True);

   Trace (Me, "");
   Trace (Me, "Call IF on C");
   Trace (Me, "");

   C.If_A_Proc_1;

   Trace (Me, "");
   Trace (Me, "Call IF on D");
   Trace (Me, "");

   D.If_A_Proc_1;
   Trace (Me, "");
end Main;

inheritanceanddispatch.gpr

limited with "F:\DEV\GNAT\2017\lib\gnat\gnatcoll.gpr";

project Inheritanceanddispatch is

   for Source_Dirs use ("src");
   for Object_Dir use "obj";
   for Main use ("main.adb");
   for Exec_Dir use "exe";

end Inheritanceanddispatch;

蚊虫版本：

GNAT GPL 2017 (20170515-63)
GPRBUILD GPL 2017 (20170515) (i686-pc-mingw32)
gcc (GCC) 6.3.1 20170510 (for GNAT GPL 2017 20170515)

输出：

[MAIN]
[MAIN] Call IF on C
[MAIN]
[CONCRETEX] If_A_Proc_1
   [CONCRETEX] If_A_Proc_1 - use This directly
   [CONCRETEX] Step_1
   [CONCRETEX] Step_2
   [CONCRETEX] If_A_Proc_1 - cast This to ConcreteX'Class
   [CONCRETEX] Step_1
   [CONCRETEX] Step_2
[MAIN]
[MAIN] Call IF on D
[MAIN]
[CONCRETEX] If_A_Proc_1
   [CONCRETEX] If_A_Proc_1 - use This directly
   [CONCRETEX] Step_1
   [CONCRETEX] Step_2
   [CONCRETEX] If_A_Proc_1 - cast This to ConcreteX'Class
   [CONCRETEX] Step_1
   [DERIVEDY] Step_2
[MAIN]

Answer 1

我个人不会将T_Concrete_X'Class 的演员表视为一种句法技巧。这只是更改标记类型（类型与类型类）的视图的方法。这种“视图转换”，即 T 到 T'Class（T 标记类型）将始终成功，并且不会优化您对实例的视图。这不像（更成问题的）垂头丧气。

关于这两个选项：两者都是可行的，并且取决于您的应用程序（可能还有偏好），您是否会选择其中一个。我看到的唯一区别是template pattern 使用抽象基类和必须由派生类型实现的抽象过程；即你不能在你的基类中定义一个默认实现。

除了这两个选项之外，您还可以考虑使用组合而不是继承。一旦您需要改变多个独立方面（目前只有一个方面，即步骤，但您永远不知道将来需要添加什么），继承通常可扩展性较差。出于这个原因，组合通常比继承更受欢迎。因此，您也可以考虑这样的事情：

action.ads

package Action is

   type I_Action is interface;   
   procedure Action (This : I_Action) is abstract;

end Action;

exec.ads

with Action; use Action;

package Exec is

   type T_Exec is new I_Action with private;

   type T_Step_Fcn is access procedure (Exec : T_Exec'Class);


   --  Possible implementations of steps. Note that these functions 
   --  are not primitives of T_Exec. Use the factory function of 
   --  T_Exec to composite the behavior of an instance of T_Exec.
   --  Some OOP programmers would define a separate abstract (base) type 
   --  "T_Step" from which concrete step implementations will be derived.
   --  I think this is too much in this case.

   procedure No_Effect (Exec : T_Exec'Class) is null;
   procedure Step_A (Exec : T_Exec'Class);    
   procedure Step_B (Exec : T_Exec'Class);      
   procedure Step_C (Exec : T_Exec'Class);
   -- ...


   --  Factory function.
   function Create 
     (Step_1 : T_Step_Fcn := No_Effect'Access;
      Step_2 : T_Step_Fcn := No_Effect'Access) return T_Exec;

   overriding
   procedure Action (This : T_Exec);  

private

   type T_Exec is new I_Action with
      record
         Step_1_Fcn : T_Step_Fcn;
         Step_2_Fcn : T_Step_Fcn;
      end record;

end Exec;

exec.adb

with Ada.Text_IO; use Ada.Text_IO;

package body Exec is   

   ------------
   -- Step_N --
   ------------

   procedure Step_A (Exec : T_Exec'Class) is 
   begin
      Put_Line ("Step_A");
   end Step_A;

   procedure Step_B (Exec : T_Exec'Class) is 
   begin
      Put_Line ("Step_B");
   end Step_B;

   procedure Step_C (Exec : T_Exec'Class) is 
   begin
      Put_Line ("Step_C");
   end Step_C;

   ------------
   -- Create --
   ------------

   function Create 
     (Step_1 : T_Step_Fcn := No_Effect'Access; 
      Step_2 : T_Step_Fcn := No_Effect'Access) return T_Exec 
   is
   begin
      Put_Line ("Create");
      return (Step_1, Step_2);
   end Create;

   ------------
   -- Action --
   ------------

   procedure Action (This : T_Exec) is      
   begin 
      Put_Line ("Action");
      This.Step_1_Fcn (This);
      This.Step_2_Fcn (This);
   end Action;

end Exec;

ma​​in.adb

with Ada.Text_IO; use Ada.Text_IO;

with Action;  use Action;
with Exec;    use Exec;

procedure Main is
begin

   Put_Line ("---- Instance of T_Exec with Step A and Step B");
   declare
      A1 : I_Action'Class :=
        Create (Step_1 => Step_A'Access,
                Step_2 => Step_B'Access);
   begin
      A1.Action;
   end;
   New_Line;

   Put_Line ("---- Instance of T_Exec with Step A and Step C");
   declare
      A2 : I_Action'Class :=
        Create (Step_1 => Step_A'Access,
                Step_2 => Step_C'Access);
   begin
      A2.Action;
   end;
   New_Line;

end Main;

输出

---- Instance of T_Exec with Step A and Step B
Create
Action
Step_A
Step_B

---- Instance of T_Exec with Step A and Step C
Create
Action
Step_A
Step_C

注意：关于问题中示例的最后评论。您不妨删除所有（匿名）访问类型和“新”关键字并使用

return T_Concrete_X'(null record);

甚至

return (null record);

而不是

return new T_Concrete_X;