Наследование от родового класса
490 Глава 16. Объектно-ориентированное и аспектно-ориентированное программирование |
generic type T is private; -- любой нелимитир. тип Size : Positive := 4; -- указан тип и значение по умолчанию package Class_Stack is type Stack is tagged private; Stack_Error : exception; procedure Reset ( The : in out Stack ); procedure Push ( The : in out Stack; Item : in T ); procedure Pop ( The : in out Stack; Item : out T ); private type Stack_Index is new Integer range 0 .. Size; subtype Stack_Range is Stack_Index range 1 .. Stack_Index ( Size ); type Stack_Array is array ( Stack_Range ) of T; type Stack is tagged record Elements : Stack_Array; -- массив элементов Tos : Stack_Index := 0; -- указатель на вершину end record; end Class_Stack; Тело родового класса содержит реализацию его методов: package body Class_Stack is procedure Reset ( The : in out Stack ) is begin The.Tos := 0; -- установить указатель в нуль (нет элементов) end Reset; procedure Push ( The : in out Stack; Item : in T ) is begin if The.Tos /= Stack_Index ( Size ) then -- проверка заполнения The.Tos := The.Tos + 1; -- указатель вверх The.Elements (The.Tos) := Item; -- запись элемента else raise Stack_Error; -- ошибка переполнения end if; end Push; procedure Pop ( The : in out Stack; Item : out T ) is begin if The.Tos > 0 then Item := The.Elements (The.Tos ); --счит.верхн.элемен. The.Tos := The.Tos - 1; -- указатель внизelse raise Stack_Error; -- ошибка удаления из пустого стека end if; end Pop; end Class_Stack; generic package Class_Stack.Additions is function Top ( The : in Stack ) return T; function Items ( The : in Stack ) return Natural; private end Class_Stack.Additions; package body Class_Stack.Additions is function Top ( The : in Stack ) return T is |
ООП на языке Ада |
491 |
begin return The.Elements ( The.Tos ); end Top; function Items ( The : in Stack ) return Natural is begin return Natural ( The.Tos ); end Items; end Class_Stack.Additions; Положим, что теперь к родовому классу Class_Stack и его родовой дочери Class_Stack.Additions нужно добавить метод. |
Для решения этой задачи используем механизм наследования. Спецификацию наследника представим в виде: with Class_Stack, Class_Stack.Additions; generic type T is private; -- любой нелимитирован. тип Size : Positive := 4; -- указан тип и значение по умолчанию package Class_Best_Stack is package Class_Stack_D is new Class_Stack ( T, Size ); package Class_Stack_D_Additions is new Class_Stack_D.Additions; -- этот экземпляр становится независимым от родителя type Best_Stack is new Class_Stack_D.Stack with private; -- переопределяем метод procedure Push ( The : in out Best_Stack; Item : in T ); -- вводим новый метод function Max_Depth ( The : in Best_Stack ) return Natural; private type Best_Stack is new Class_Stack_D.Stack with record Depth : Natural := 0; -- новый атрибут end record; end Class_Best_Stack; ПРИМЕЧАНИЕ ------------------------------------------------------ 1. Таким образом, конкретизацию базового класса Stack и его родовой дочери мы разместили в теле класса-наследника. 2. Метод Push переопределен для того, чтобы он мог фиксировать максимальную достигнутую глубину. |
Реализация класса-наследника выглядит так: package body Class_Best_Stack is procedure Push ( The : in out Best_Stack; Item : in T ) is Dep : Natural; begin Dep := Class_Stack_D_Additions.Items (Class_Stack_D.Stack(The)); |
продолжение # |
492 Глава 16. Объектно-ориентированное и аспектно-ориентированное программирование |
if Dep > The.Depth then The.Depth := Dep; end if; Class_Stack_D.Push (Class_Stack_D.Stack (The),Item); end Push; function Max_Depth ( The : in Best_Stack ) return Natural is begin return The.Depth; end Max_Depth; end Class_Best_Stack; Конкретизация класса Class_Best_Stack для чисел типа Positive выполняется по объявлению: with Class_Best_Stack; package Class_Best_Stack_Pos is new Class_Best_Stack ( Positive, 15 ); Тестирование конкретизированного класса можно осуществить с помощью программы: with Ada.Text_IO, Ada.Integer_Text_IO, Class_Best_Stack_Pos; use Ada.Text_IO, Ada.Integer_Text_IO, Class_Best_Stack_Pos; procedure Main is Numbers : Best_Stack; Res : Positive; begin Put ("Максимальная глубина: "); Put_Line ( Max_Depth ( Numbers )); Push ( Numbers, 40 ); Push ( Numbers, 20 ); Put ("Максимальная глубина: "); Put_Line ( Max_Depth ( Numbers )); Push ( Numbers, 50 ); Put ("Максимальная глубина: "); Put_Line ( Max_Depth ( Numbers )); Pop ( Numbers, Res ); Put ("Максимальная глубина: "); Put_Line ( Max_Depth ( Numbers )); end Main; Данная программа выводит на экран следующие результаты: Максимальная глубина: 0 Максимальная глубина: 2 Максимальная глубина: 3 Максимальная глубина: 3 |