Используйте Ada My_Class'Class (This) приведение к имитации шаблона дизайна метода шаблона

Question

Контекст

Недавно я столкнулся с основной проблемой проектирования ООП / Ада 2012.

По сути, у меня есть родительский класс, который реализует контракт интерфейса. Это делается в несколько этапов внутри поставщика реализации (ConcreteX). Дочерний класс расширяет эту реализацию, переопределяя только один из шагов (DerivedY, Step_2). (пытаясь получить некоторые свойства SOLID)

Я наивно предполагал, что диспетчеризация произойдет. Это не так. Я заново обнаружил, что диспетчеризация НЕ похожа на Java или другие ООП, и пришел с решением.

Диспетчеризация в Аде часто задается / отвечает / документируется в нескольких вопросах: Динамическая диспетчеризация в Аде, Динамическая диспетчеризация в 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 я борюсь между этими двумя вариантами:

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-производный.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:

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;