Lon*_*rer 1 oop inheritance ada template-method-pattern ada2012
我最近遇到了一个基本的OOP / Ada 2012设计问题。
基本上，我有一个实现接口协定的父类。这是在实现提供程序（ConcreteX）中分几个步骤完成的。子类通过仅覆盖其中一个步骤（DerivedY，Step_2）来扩展此实现。（试图获得一些SOLID属性）
我天真地认为会发生调度。没有。我重新发现调度与Java或其他OOP中的调度不同，并提供了解决方案。
在阿达调度经常问/回答/记录了几个问题：动态调度Ada中，动态调度Ada中，访问类型，阿达T'Class基础
而不是使用：
This.Step_1; This.Step_2;
我最终使用：
T_Concrete_X'Class (This).Step_1; T_Concrete_X'Class (This).Step_2;
在Ada OOP类设计中，我在两种选择之间挣扎：
在父类中，定义行为+原语并提供默认实现，即Current_Class'Class(This).method()（=下面提供的工作示例）
使用模板设计模式，以便将执行步骤的实现委派给另一个类
即在给定的示例中：
-- 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;
继承与调度
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版本：
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]
我个人并不认为强制转换T_Concrete_X'Class只是一种语法技巧。这是更改标记类型（类型与类型类）视图的方法。这种“视图转换”，即T到T'Class（带有T标记类型的）转换将始终成功，并且不会优化实例上的视图。这不像（更麻烦的）垂头丧气。
关于这两个选项：两者都是可行的，如果您要选择其中一个，则取决于您的应用程序（并且可能是首选项）。我看到的唯一区别是模板模式使用带有抽象过程的抽象基类，该抽象过程必须由派生类型实现。即您不能在基类中定义默认实现。
除了这两个选项，您还可以考虑使用组合而不是继承。通常，一旦您需要改变多个独立方面（现在只有一个方面，即步骤，但您永远不知道将来需要添加什么），则继承的可伸缩性将降低。因此，与继承相比，组合通常更可取。因此，您还可以考虑以下内容：
动作广告
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;
可执行文件
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;