В этом случае, необходима возможность расширения операций по получению сообщений от интерфейса.
Таким образом, следует создать процедуру Get, которая получает сообщение от интерфейса основываясь на тэговом типе, что обеспечит ее полиморфность:
|
with Message; package Generic_Interface is type Flag is tagged null record; procedure Get (Which_Interface: Flag; Data: Message.Data_Type); end Generic_Interface; |
Теперь можно написать функцию Summarizer как надклассовую, которая, для получения сообщений от различных интерфейсов, использует соответствующую диспетчеризацию:
|
with Generic_Interface; package Extension_Approach is function Summarizer (Interface_To_Use: Generic_Interface.Flag'Class) return Summary_Type; end Extension_Approach; - - - - - - with Messages; package body Extension_Approach is function Summarizer (Interface_To_Use: Generic_Interface.Flag'Class) return Summary_Type is Data: array (1..20) of Message.Data_Type; begin for I in 1 .. 20 loop Get (Interface_To_Use, Data (I)); exit when Data (I).Last_Message; end loop; ... |
Тело процедуры Get, в пакете Generic_Interface, может возвращать исключение, или получать сообщение от интерфейса по умолчанию (в этом случае пакет, наверное, должен быть назван Default_Interface).
Для расширения Summarizer с целью получения сообщений от какого-либо нового интерфейса, необходимо просто расширить тип Generic_Interface.Flag
и переопределить его процедуру Get:
|
with Message; with Generic_Interface; package Disk_Interface is type Flag is new Generic_Interface.Flag with null record; procedure Get (Which_Interface: Flag; Data: Message.Data_Type); end Disk_Interface; |
В результате этого, тип Flag способен хранить различные фактические данные для любых случаев.
Теперь мы можем обеспечить, чтобы Summarizer получал сообщения от диска и возвращал нам итоговый результат:
|
Summary := Extension_Approach.Summarizer (Disk_Interface.Flag'(null record)); |
Благодаря этому, даже в случае написания Disk_Interface после Summarizer, не возникает нужды переписывать Summarizer.