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

Question

上下文

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

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

我天真地以为会发生调度。它没有。我重新发现调度与 Java 或其他 OOP 不同，并且提供了解决方案。

在 Ada 中调度经常 asked/answered/documented 在几个问题中：Dynamic dispatching in Ada, ,

而不是使用：

This.Step_1; This.Step_2;

我最终使用了：

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

问题

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

在父级 class 中，定义行为 + 原语并提供默认实现，即 Current_Class'Class(This).method()（= 下面提供的工作示例）
使用模板设计模式，将执行步骤的实施委托给另一个 class

即在给定的示例中：

-- 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 是语法 "trick" 应该避免以实现预期的行为吗？

我总觉得当我写一个显式转换时，那是设计薄弱的标志。

工作示例：

src/interfacea.广告

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.广告

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\GNAT17\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 版本：

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 视为句法技巧。这只是更改标记类型视图的方法（类型与类型 class）。这个 "view conversion" 即 T 到 T'Class （带有 T 标记类型）将始终成功并且不会优化您对实例的看法。它不像（问题更大的）向下转换。

关于这两个选项：两者都是可行的，这取决于您的应用程序（可能还有偏好），如果您选择其中一个。我看到的唯一区别是 template pattern 使用抽象基 class 和必须由派生类型实现的抽象过程；也就是说，您不能在基础 class.

中定义默认实现

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

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;

main.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

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

return T_Concrete_X'(null record);

甚至

return (null record);

而不是

return new T_Concrete_X;

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

Use Ada's My_Class'Class(This) cast to mimic template method design pattern

oop

inheritance

ada

template-method-pattern

ada2012

上下文

问题