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

Question

上下文

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

基本上，我有一个实现接口契约的父类。这是在实现提供程序(ConcreteX)中通过几个步骤完成的。子类仅通过重写其中的一个步骤(DerivedY、Step_2)来扩展此实现。(试图获得一些固体特性)

我天真地以为会发生调度。事实并非如此，我重新发现，调度与Java或其他OOP不同，并提供了解决方案。

在Ada中的调度经常被问/回答/记录在几个问题中：https://stackoverflow.com/questions/5920457/dynamic-dispatching-in-ada、https://stackoverflow.com/questions/35898525/dynamic-dispatching-in-ada-with-access-types、https://stackoverflow.com/questions/28468799/fundamentals-of-adas-tclass/28473115#28473115

而不是使用：

This.Step_1; This.Step_2;

最后我用了：

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

问题

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

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;

是一个应该避免的语法“技巧”，以达到预期的行为？。

我总是觉得，当我写一个明确的演员，这是一个迹象，薄弱的设计。

工作实例：

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

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;

钢筋混凝土/混凝土

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/混凝土-衍生产品

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/混凝土-衍生.src

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 )总是成功的，不会细化实例上的视图。这不像(更有问题的)下注。

关于这两个选项:这两个选项都是可行的，这取决于您的应用程序(可能是首选项)是否接受其中一个选项。我看到的唯一不同是，模板模式使用抽象基类，抽象过程必须由派生类型实现；也就是说，不能在基类中定义默认实现。

除了这两个选项之外，您还可以考虑使用组合而不是继承。如果您需要更改多个独立的方面(目前只有一个方面，步骤，但是您永远不知道将来需要添加什么)，继承通常就不那么可伸缩了。由于这个原因，组合常常比继承更好。因此，您还可以考虑这样的事情：

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

注:关于问题中的例子的最后一点意见。您最好删除所有(匿名)访问类型和“新”关键字，并使用

return T_Concrete_X'(null record);

甚至是

return (null record);

而不是

return new T_Concrete_X;