При внимательном рассмотрении показанной ранее реализации процедуры Show
не трудно заметить, что хотя она и использует средства тэговых типов, позволяющие определить фактический тип объекта во время выполнения программы, аналогичный результат мог бы быть получен путем использования вместо тэговых типов обычных записей с дискриминантами.
В данном случае, подразумевается, что если мы решим описать новый тип, производный от любого типа входящего в показанную иерархию (Root, Child_1, Child_2 и Grand_Child_2_1), то результатом работы такой реализации процедуры Show
всегда будет сообщение "Unknown type", извещающее о том, что фактический тип параметра Self - не известен.
Например, такая ситуация может возникнуть когда мы опишем новый тип Grand_Child_1_1, производный от типа Child_1, в каком-либо другом пакете.
С первого взгляда может показаться, что будет достаточно переписать процедуру Show
с учетом нового типа Grand_Child_1_1.
Действительно, такое решение будет работать, но это значит, что при описании каждого нового типа, входящего в эту иерархию, мы вынуждены вносить изменения в уже написанные и отлаженные модули.
Для того, чтобы избавиться от таких трудностей, реализацию процедуры Show
надо действительно переписать, но так, чтобы задействовать механизм динамической диспетчеризации вызовов подпрограмм, который предоставляет использование тэговых типов.
Вспомним, что при демонстрации примера иерархии типов, был также приведен пример спецификации пакета Simple_Objects, в котором эта иерархия типов описывается.
Теперь, перед непосредственным обсуждением механизма динамической диспетчеризации вызовов подпрограмм, предположим, что описание тела этого пакета имеет следующий вид:
|
with Ada.Text_IO; package body Simple_Objects is -- примитивные операции типа Root function The_Name (Self: in Root) return String is begin return ("Root"); end The_Name; procedure Show (Self: in Root'Class) is begin Ada.Text_IO.Put_Line ( The_Name(Self) ); end Show; -- примитивные операции типа Child_1 function The_Name (Self: in Child_1) return String is begin return ("Child_1"); end The_Name; -- примитивные операции типа Child_2 function The_Name (Self: in Child_2) return String is begin return ("Child_2"); end The_Name; -- примитивные операции типа Grand_Child_2_1 function The_Name (Self: in Grand_Child_2_1) return String is begin return ("Grand_Child_2_1"); end The_Name; end Simple_Objects; |