一个类范围过程
-- Chapter 23 - Program 1
with Ada.Text_IO, Ada.Integer_Text_IO, Ada.Float_Text_IO;
use Ada.Text_IO, Ada.Integer_Text_IO, Ada.Float_Text_IO;
package Conveyance4 is
-- A very simple transportation record.
type TRANSPORT is tagged private;
procedure Set_Values(Vehicle_In : in out TRANSPORT;
Wheels_In : INTEGER;
Weight_In : FLOAT);
function Get_Wheels(Vehicle_In : TRANSPORT) return INTEGER;
function Get_Weight(Vehicle_In : TRANSPORT) return FLOAT;
-- Extend TRANSPORT to a CAR type.
type CAR is new TRANSPORT with private;
procedure Set_Values(Vehicle_In : in out CAR;
Passenger_Count_In : INTEGER);
function Get_Passenger_Count(Vehicle_In : CAR) return INTEGER;
-- Extend TRANSPORT to a TRUCK type.
type TRUCK is new TRANSPORT with private;
procedure Set_Values(Vehicle_In : in out TRUCK;
Wheels_In : INTEGER;
Weight_In : FLOAT;
Passenger_Count_In : INTEGER;
Payload_In : FLOAT);
function Get_Passenger_Count(Vehicle_In : TRUCK) return INTEGER;
-- Derive an identical type for BICYCLE.
type BICYCLE is new TRANSPORT with private;
-- Print_Values is a class-wide operation. It can accept objects
-- of any type within the TRANSPORT heirarchy.
procedure Print_Values(Any_Vehicle : TRANSPORT'Class);
private
type TRANSPORT is tagged
record
Wheels : INTEGER;
Weight : FLOAT;
end record;
type CAR is new TRANSPORT with
record
Passenger_Count : INTEGER;
end record;
type TRUCK is new TRANSPORT with
record
Passenger_Count : INTEGER;
Payload : FLOAT;
end record;
type BICYCLE is new TRANSPORT with null record;
end Conveyance4;
package body Conveyance4 is
-- Subprograms for the TRANSPORT record
procedure Set_Values(Vehicle_In : in out TRANSPORT;
Wheels_In : INTEGER;
Weight_In : FLOAT) is
begin
Vehicle_In.Wheels := Wheels_In;
Vehicle_In.Weight := Weight_In;
end Set_Values;
function Get_Wheels(Vehicle_In : TRANSPORT) return INTEGER is
begin
return Vehicle_In.Wheels;
end Get_Wheels;
function Get_Weight(Vehicle_In : TRANSPORT) return FLOAT is
begin
return Vehicle_In.Weight;
end Get_Weight;
-- Subprograms for the CAR record
procedure Set_Values(Vehicle_In : in out CAR;
Passenger_Count_In : INTEGER) is
begin
Vehicle_In.Passenger_Count := Passenger_Count_In;
end Set_Values;
function Get_Passenger_Count(Vehicle_In : CAR) return INTEGER is
begin
return Vehicle_In.Passenger_Count;
end Get_Passenger_Count;
-- Subprograms for the TRUCK record
procedure Set_Values(Vehicle_In : in out TRUCK;
Wheels_In : INTEGER;
Weight_In : FLOAT;
Passenger_Count_In : INTEGER;
Payload_In : FLOAT) is
begin
-- This is one way to set the values in the base class
Vehicle_In.Wheels := Wheels_In;
Vehicle_In.Weight := Weight_In;
-- This is another way to set the values in the base class
Set_Values(TRANSPORT(Vehicle_In), Wheels_In, Weight_In);
-- This sets the values in this class
Vehicle_In.Passenger_Count := Passenger_Count_In;
Vehicle_In.Payload := Payload_In;
end Set_Values;
function Get_Passenger_Count(Vehicle_In : TRUCK) return INTEGER is
begin
return Vehicle_In.Passenger_Count;
end Get_Passenger_Count;
-- Print_Values is a class-wide operation. It can accept objects
-- of any type within the TRANSPORTheirarchy.
procedure Print_Values(Any_Vehicle : TRANSPORT'Class) is
begin
Put("This vehicle has");
Put(Any_Vehicle.Wheels, 2);
Put(" wheels, and weighs");
Put(Any_Vehicle.Weight, 5, 1, 0);
Put(" pounds.");
New_Line;
-- The following line of code will produce an error because TRANSPORT
-- and BICYCLE do not contain this variable.
-- Put(Any_Vehicle.Passenger_Count, 5);
end Print_Values;
end Conveyance4;
-- Result of execution
--
-- (This program cannot be executed alone.)
检查名为e_c23_p1.ada的示例程序，了解ada95中的另一个新构造，即类范围的过程。这时您应该已经非常熟悉包规范中的记录定义了，我们在第8、18、26和38行中声明了4条记录，其中3条是父记录的后代，父记录是TRANSPORT类型。Ada将这四个记录的组合称为一个类，因为它们都来自一个共同的父级。事实上，它们都是TRANSPORT类型的后代，因此这四种类型的组合称为TRANSPORT类。
名为Print_Values的过程在第43行中声明，它使用一个具有非常奇怪类型的参数，即类型TRANSPORT'Class。这表示TRANSPORT 类的任何类型的实际参数都可以传递到此过程中，这意味着直接或间接继承TRANSPORT 的任何类型都是此参数的候选类型。第136行到第149行给出了Print_Values程序的实现，其中监视器上显示了名为Any_Vehicle 的参数的一些组件。
在研究这一过程时，必须考虑几个事实。第一个问题是，当一个类型被继承到另一个类型时，不可能删除任何数据组件。可以添加元素，但不能删除。接下来，TRANSPORT 类中四种类型中的任何一种类型的变量都可以作为实际参数传入，所有四种类型中唯一存在的组件是父类型本身中的组件。例如，CAR 类型可能有不属于父类型的附加组件，因此这些组件在所有四种类型中都不可用。因此，在此过程中使用任何组件都是不合法的，除非它们是父类型的一部分，因为只有那些组件才保证是类的所有类型的一部分。因此，Wheels 和Weight 是本程序中唯一可以使用的变量。作为一个简单的例子，监视器上会显示一条非常简短的消息，其中包含这两个值。您会注意到，第147行被注释掉了，因为名为Passenger_Count 的组件在某些类型中不可用，并且不能在本过程中使用，本过程旨在容纳这四种类型中任何一种类型的任何变量。
此软件包的其余部分与本教程上一章中研究的内容非常相似。勤奋的学生现在应该彻底理解它了。
使用类范围的过程
Example program ------> e_c23_p2.ada
-- Chapter 23 - Program 2
with Ada.Text_IO, Ada.Integer_Text_IO, Conveyance4;
use Ada.Text_IO, Ada.Integer_Text_IO, Conveyance4;
procedure Vehicle4 is
Hummer : TRANSPORT;
Limo : CAR;
Chevy : CAR;
Dodge : TRUCK;
Ford : TRUCK;
begin
Set_Values(Hummer, 4, 5760.0);
Set_Values(Limo, 8);
Set_Values(TRANSPORT(Limo), 4, 3750.0);
Set_Values(Chevy, 5);
Set_Values(TRANSPORT(Chevy), 4, 2560.0);
Set_Values(Dodge, 6, 4200.0, 3, 1800.0);
Set_Values(Ford, 4, 2800.0, 3, 1100.0);
-- Print out the data for the Ford truck just to pick on one
-- of the objects for demonstration purposes.
Put("The Ford truck has");
Put(Get_Wheels(Ford), 2);
Put(" wheels, and can carry");
Put(Get_Passenger_Count(Ford), 2);
Put(" passengers.");
New_Line;
-- Now, let's call the class-wide procedure 5 times.
Print_Values(Hummer);
Print_Values(Limo);
Print_Values(Chevy);
Print_Values(Dodge);
Print_Values(Ford);
end Vehicle4;
-- Result of execution
--
-- The Ford truck has 4 wheels and can carry 3 passengers.
-- This vehicle has 4 wheels, and weighs 5760.0 pounds.
-- This vehicle has 4 wheels, and weighs 3750.0 pounds.
-- This vehicle has 4 wheels, and weighs 2560.0 pounds.
-- This vehicle has 6 wheels, and weighs 4200.0 pounds.
-- This vehicle has 4 wheels, and weighs 2800.0 pounds.
如果您刚刚完成上一章的学习，那么名为e_c23_p2.ada的示例程序应该非常熟悉。从第36行到第40行给出了与e_c22_p7.ada的唯一真正区别，其中使用三种不同类型的对象调用相同的过程。名为Print_Values 的类范围过程能够接受TRANSPORT 类中任何类型的参数，并且所有五个变量都符合此条件。
当程序执行时，您将看到它确实正确地打印了每个变量的数据值，即使它们的类型不同。因此，将任何类型的变量传递到此过程中都是合法的，前提是该类型是TRANSPORT 类的后代，而不管它位于行的下方多远。
动态调度？
Example program ------> e_c23_p3.ada
-- Chapter 23 - Program 3
with Ada.Text_IO, Ada.Integer_Text_IO, Ada.Float_Text_IO;
use Ada.Text_IO, Ada.Integer_Text_IO, Ada.Float_Text_IO;
package Conveyance5 is
-- Begin with a basic transportation type.
type TRANSPORT is tagged private;
procedure Set_Values(Vehicle_In : in out TRANSPORT;
Wheels_In : INTEGER);
function Get_Wheels(Vehicle_In : TRANSPORT) return INTEGER;
procedure Describe(Vehicle_In : TRANSPORT);
-- Extend the basic type to a CAR type.
type CAR is new TRANSPORT with private;
procedure Set_Values(Vehicle_In : in out CAR;
Passenger_Count_In : INTEGER);
function Get_Passenger_Count(Vehicle_In : CAR) return INTEGER;
procedure Describe(Vehicle_In : CAR);
-- Extend the basic type to a TRUCK type.
type TRUCK is new TRANSPORT with private;
procedure Set_Values(Vehicle_In : in out TRUCK;
Wheels_In : INTEGER;
Passenger_Count_In : INTEGER);
function Get_Passenger_Count(Vehicle_In : TRUCK) return INTEGER;
procedure Describe(Vehicle_In : TRUCK);
-- Extend the basic type to the BICYCLE type.
type BICYCLE is new TRANSPORT with private;
procedure Describe(Vehicle_In : BICYCLE);
-- Print_Values is a class-wide operation. It can accept objects
-- of any type within the TRANSPORT heirarchy.
procedure Print_Values(Any_Vehicle : TRANSPORT'Class);
private
type TRANSPORT is tagged
record
Wheels : INTEGER;
end record;
type CAR is new TRANSPORT with
record
Passenger_Count : INTEGER;
end record;
type TRUCK is new TRANSPORT with
record
Passenger_Count : INTEGER;
end record;
type BICYCLE is new TRANSPORT with null record;
end Conveyance5;
package body Conveyance5 is
-- Subprograms for the TRANSPORT record
procedure Set_Values(Vehicle_In : in out TRANSPORT;
Wheels_In : INTEGER) is
begin
Vehicle_In.Wheels := Wheels_In;
end Set_Values;
function Get_Wheels(Vehicle_In : TRANSPORT) return INTEGER is
begin
return Vehicle_In.Wheels;
end Get_Wheels;
procedure Describe(Vehicle_In : TRANSPORT) is
begin
Put("We are in the TRANSPORT procedure.");
new_Line;
end Describe;
-- Subprograms for the CAR record
procedure Set_Values(Vehicle_In : in out CAR;
Passenger_Count_In : INTEGER) is
begin
Vehicle_In.Passenger_Count := Passenger_Count_In;
end Set_Values;
function Get_Passenger_Count(Vehicle_In : CAR) return INTEGER is
begin
return Vehicle_In.Passenger_Count;
end Get_Passenger_Count;
procedure Describe(Vehicle_In : CAR) is
begin
Put("We are in the CAR procedure.");
new_Line;
end Describe;
-- Subprograms for the TRUCK record
procedure Set_Values(Vehicle_In : in out TRUCK;
Wheels_In : INTEGER;
Passenger_Count_In : INTEGER) is
begin
-- This is one way to set the values in the base class
Vehicle_In.Wheels := Wheels_In;
-- This is another way to set the values in the base class
Set_Values(TRANSPORT(Vehicle_In), Wheels_In);
-- This sets the values in this class
Vehicle_In.Passenger_Count := Passenger_Count_In;
end Set_Values;
function Get_Passenger_Count(Vehicle_In : TRUCK) return INTEGER is
begin
return Vehicle_In.Passenger_Count;
end Get_Passenger_Count;
procedure Describe(Vehicle_In : TRUCK) is
begin
Put("We are in the TRUCK procedure.");
new_Line;
end Describe;
-- Subprograms for the BICYCLE record
procedure Describe(Vehicle_In : BICYCLE) is
begin
Put("We are in the BICYCLE procedure.");
New_Line;
end Describe;
-- Print_Values is a class-wide operation. It can accept objects
-- of any type within the TRANSPORT heirarchy.
procedure Print_Values(Any_Vehicle : TRANSPORT'Class) is
begin
-- Describe(Any_Vehicle);
Put("This vehicle has");
Put(Any_Vehicle.Wheels, 2);
Put(" wheels.");
New_Line;
-- The following line of code will produce an error because TRANSPORT
-- and BICYCLE do not contain this variable.
-- Put(Any_Vehicle.Passenger_Count, 5);
end Print_Values;
end Conveyance5;
-- Result of execution
--
-- (This program cannot be executed alone.)
名为e_c23_p3.ada的示例程序将另一个ada构造引入到我们的库中，即动态绑定或多态性的概念。在上一个程序中，我们用几个不同的类型调用了一个过程，但在这个程序中，我们将用一个调用调用几个不同的过程，方法是让系统确定要为我们调用哪个过程。
这个例子与 e_c23_p1.ada相同，只是增加了四个新的过程，每种类型一个。这些程序的规范在第14、23、33和39行中给出。您将注意到，它们都是相同的，只是每个都对要传入的单个参数使用不同的类型。还要注意，所有参数类型都在TRANSPORT类中。这四个过程之一的实现在第85行到第89行中给出，您可以很容易地找到其他三个实现。您将注意到，由于要打印的字符串不同，每个过程的实现都不同。需要注意的是，在每种情况下，主体中的代码是不同的，但是接口是相同的。
使用动态调度
Example program ------> e_c23_p4.ada
-- Chapter 23 - Program 4
with Ada.Text_IO, Ada.Integer_Text_IO, Conveyance5;
use Ada.Text_IO, Ada.Integer_Text_IO, Conveyance5;
procedure Vehicle5 is
Hummer : aliased TRANSPORT;
Limo : aliased CAR;
Chevy : aliased CAR;
Dodge : aliased TRUCK;
Ford : aliased TRUCK;
Schwinn : aliased BICYCLE;
type TRANSPORT_ACCESS is access all TRANSPORT'Class;
Any_Pt : TRANSPORT_ACCESS;
begin
Set_Values(Hummer, 4);
Set_Values(Limo, 8);
Set_Values(TRANSPORT(Limo), 4);
Set_Values(Chevy, 5);
Set_Values(TRANSPORT(Chevy), 4);
Set_Values(Dodge, 6, 3);
Set_Values(Ford, 4, 3);
Set_Values(Schwinn, 2);
-- Print out the data for the Ford truck just to pick on one.
Put("The Ford truck has");
Put(Get_Wheels(Ford), 2);
Put(" wheels, and can carry");
Put(Get_Passenger_Count(Ford), 2);
Put(" passengers.");
New_Line;
-- Now, let's call the class-wide procedure 6 times.
Print_Values(Hummer);
Print_Values(Limo);
Print_Values(Chevy);
Print_Values(Dodge);
Print_Values(Ford);
Print_Values(Schwinn);
Any_Pt := Hummer'Access;
Describe(Any_Pt.all);
Any_Pt := Limo'Access;
Describe(Any_Pt.all);
Any_Pt := Chevy'Access;
Describe(Any_Pt.all);
Any_Pt := Dodge'Access;
Describe(Any_Pt.all);
Any_Pt := Ford'Access;
Describe(Any_Pt.all);
Any_Pt := Schwinn'Access;
Describe(Any_Pt.all);
end Vehicle5;
-- Result of execution
--
-- The Ford truck has 4 wheels and can carry 3 passengers.
-- This vehicle has 4 wheels.
-- This vehicle has 4 wheels.
-- This vehicle has 4 wheels.
-- This vehicle has 6 wheels.
-- This vehicle has 4 wheels.
-- This vehicle has 2 wheels.
-- We are in the TRANSPORT procedure.
-- We are in the CAR procedure.
-- We are in the CAR procedure.
-- We are in the TRUCK procedure.
-- We are in the TRUCK procedure.
-- We are in the BICYCLE procedure.
名为e_c23_p4.ada的示例程序需要很好的解释，因为这里有很多新的资料。在第8行到第13行中，我们使用TRANSPORT 类的四种类型定义了6个变量。我们还明确声明每个变量都有别名aliased，这是我们在本教程中讨论访问类型时研究的保留字。您还记得，这允许access 类型变量间接访问这些变量。
我们在第15行定义了一个新的access 类型，它可以访问任何正确类型的变量，只要它有别名，包括在堆、堆栈或全局上分配的变量。此外，它访问TRANSPORT'Class，这意味着它可以访问该类中任何类型的变量，前提是该变量已定义为aliased。最后，为了完成我们的数据定义，我们定义了一个新类型的access 变量，以便在程序中使用。
示例程序与e_c23_p2.ada相同，直到我们到达第47行，在那里有趣的事情开始发生。第47行中的代码将悍Hummer的地址分配给Any_Pt，第48行使用该地址调用名为descripe的过程。您会记得，我们有四个不同的过程名为descripe，但只有一个过程的参数具有TRANSPORT 类型。因为Hummer是这种类型的，所以这里将调用这个过程，并且动态地选择要执行的过程。在第49行中，我们将Limo的地址分配给Any_Pt ，并将其用作descripe调用的参数。这一次将调用与CAR 类型相关联的过程。这将继续与所有六个变量和程序是完整的。
到底发生了什么？
您将注意到第48、50、52、54、56和58行是相同的。这六行代码中唯一的区别是调用时指针的类型，指针的类型用于选择要执行的过程。这种选择是在运行时完成的，通常称为运行时绑定或多态性。似乎我们为此付出了很多努力，我们做到了，但我们会发现这对于某些编程环境来说是一种非常有价值的技术。
因为这是新材料，所以这里需要稍微重复一下。在第40行到第45行中，我们对一个过程进行了许多不同的调用，但在第48行到第58行中，我们对一个调用进行了多次重复，每次调用都被分派到几个不同的过程。这有时称为动态选择，因为选择是在运行时进行的，而不是在编译时进行选择的静态选择。它通常被称为多态性，意味着许多形式的相似实体。
动态基类
Example program ------> e_c23_p5.ada
-- Chapter 23 - Program 5
with Ada.Text_IO;
use Ada.Text_IO;
package Person is
type EMPLOYEE is tagged private;
procedure Display(Person_In : EMPLOYEE);
private
type EMPLOYEE is tagged
record
Name : STRING(1..25);
Name_Length : INTEGER;
Salary : INTEGER;
end record;
end Person;
package body Person is
procedure Display(Person_In : EMPLOYEE) is
begin
Put("This message should never be displayed!");
end Display;
end Person;
-- Result of execution
--
-- (This package cannot be executed alone.)
检查名为e_c23_p5.ada的文件，查看动态绑定最终检查的开始包，至少目前是这样。您会注意到，我们声明了一个名为EMPLOYEE的简单类型，其中包含三个组件和一个过程。它被声明为被标记的，这将允许我们将这个类型继承到其他类型中来构建一个类型类。这将再次用于说明动态绑定。该过程打印的消息声明永远不应显示它。我们稍后将返回到这一点，并说明一个方法，通过该方法编译器将防止这种情况发生。
类型扩展
Example program ------> e_c23_p6.ada
-- Chapter 23 - Program 6
with Ada.Text_IO, Ada.Integer_Text_IO;
use Ada.Text_IO, Ada.Integer_Text_IO;
package Person.Positions is
-- The SUPERVISOR type has a title.
type SUPERVISOR is new EMPLOYEE with private;
procedure Init_Data(In_Person : in out SUPERVISOR;
In_Name : STRING;
In_Salary : INTEGER;
In_Title : STRING);
procedure Display(In_Person : SUPERVISOR);
-- The PROGRAMMER type has a language preference.
type PROGRAMMER is new EMPLOYEE with private;
procedure Init_Data(In_Person : in out PROGRAMMER;
In_Name : STRING;
In_Salary : INTEGER;
In_Title : STRING;
In_Language : STRING);
procedure Display(In_Person : PROGRAMMER);
-- The SECRETARY type has a typing speed.
type SECRETARY is new EMPLOYEE with private;
procedure Init_Data(In_Person : in out SECRETARY;
In_Name : STRING;
In_Salary : INTEGER;
In_ShortHand : BOOLEAN;
In_Speed : INTEGER);
procedure Display(In_Person : SECRETARY);
private
type SUPERVISOR is new EMPLOYEE with
record
Title : STRING(1..25);
Title_Length : INTEGER;
end record;
type PROGRAMMER is new EMPLOYEE with
record
Title : STRING(1..25);
Title_Length : INTEGER;
Language : STRING(1..25);
Language_Length : INTEGER;
end record;
type SECRETARY is new EMPLOYEE with
record
Shorthand : BOOLEAN;
Typing_Speed : INTEGER;
end record;
end Person.Positions;
package body Person.Positions is
-- Subprograms for the SUPERVISOR type.
procedure Init_Data(In_Person : in out SUPERVISOR;
In_Name : STRING;
In_Salary : INTEGER;
In_Title : STRING) is
begin
In_Person.Name_Length := In_Name'Length;
for Index in In_Name'Range loop
In_Person.Name(Index) := In_Name(Index);
end loop;
In_Person.Salary := In_Salary;
In_Person.Title_Length := In_Title'Length;
for Index in In_Title'Range loop
In_Person.Title(Index) := In_Title(Index);
end loop;
end Init_Data;
procedure Display(In_Person : SUPERVISOR) is
begin
for Index in 1..In_Person.Name_Length loop
Put(In_Person.Name(Index));
end loop;
Put(" is a supervisor, and is the ");
for Index in 1..In_Person.Title_Length loop
Put(In_Person.Title(Index));
end loop;
Put(" of the company");
New_Line;
end Display;
-- Subprograms for the PROGRAMMER type.
procedure Init_Data(In_Person : in out PROGRAMMER;
In_Name : STRING;
In_Salary : INTEGER;
In_Title : STRING;
In_Language : STRING) is
begin
In_Person.Name_Length := In_Name'Length;
for Index in In_Name'Range loop
In_Person.Name(Index) := In_Name(Index);
end loop;
In_Person.Salary := In_Salary;
In_Person.Title_Length := In_Title'Length;
for Index in In_Title'Range loop
In_Person.Title(Index) := In_Title(Index);
end loop;
In_Person.Language_Length := In_Language'Length;
for Index in In_Language'Range loop
In_Person.Language(Index) := In_Language(Index);
end loop;
end Init_Data;
procedure Display(In_Person : PROGRAMMER) is
begin
for Index in 1..In_Person.Name_Length loop
Put(In_Person.Name(Index));
end loop;
Put(" is a programmer specializing in ");
for Index in 1..In_Person.Language_Length loop
Put(In_Person.Language(Index));
end loop;
Put(". He makes ");
Put(In_Person.Salary, 6);
Put(" dollars per year.");
New_Line;
end Display;
-- Subprograms for the SECRETARY type.
procedure Init_Data(In_Person : in out SECRETARY;
In_Name : STRING;
In_Salary : INTEGER;
In_ShortHand : BOOLEAN;
In_Speed : INTEGER) is
begin
In_Person.Name_Length := In_Name'Length;
for Index in In_Name'Range loop
In_Person.Name(Index) := In_Name(Index);
end loop;
In_Person.Salary := In_Salary;
In_Person.Shorthand := In_Shorthand;
In_Person.Typing_Speed := In_Speed;
end Init_Data;
procedure Display(In_Person : SECRETARY) is
begin
for Index in 1.. In_Person.Name_Length loop
Put(In_Person.Name(Index));
end loop;
Put(" is a secretary that does ");
if not In_Person.Shorthand then
Put("not ");
end if;
Put("take shorthand.");
New_Line;
Put(" ");
for Index in 1..In_Person.Name_Length loop
Put(In_Person.Name(Index));
end loop;
Put(" is paid ");
Put(In_Person.Salary, 6);
Put(" dollars per year.");
New_Line;
end Display;
end Person.Positions;
-- Result of execution
--
-- (This package cannot be executed alone.)
上面提到的EMPLOYEE类型位于Person包中，文件e_c23_p6.ada中的三种类型位于名为Person.Positions如第6行所示。我们使用ADA95提供的分层库，可以用来防止名称冲突的可能性。包装规范Person.Positions是非常直接的，你应该能够理解这个包。请注意，有三个名为Display的过程，每个过程的形式参数的类型不同，但在其他方面接口是相同的。
Person.Positions 由于Ada中定义字符串的方式，包并不是那么简单。我们在本教程前面提到，字符串不能分配给变量，除非它们的长度都相同，否则Ada编译器将发出类型不兼容错误。如果我们要建立一个地址表，要求每个人的名字中有相同数量的字母，姓氏中有相同数量的字母是不太合适的。必须改进Ada可用的STRING 类型，以便在有意义的Ada程序中方便地使用字符串。我们将很快看到如何做到这一点，但与此同时，我们将通过这个示例程序和当前的STRING 类型实现来向您展示如何处理它们。因为我们希望使用可变长度的字符串，所以我们将定义每个字符串的长度略长于它们需要的长度，并将计数器与每个字符串变量相关联，以存储字符串的当前长度。
第43行定义了一个名为Title的字符串变量，该变量最多可存储25个字符，第44行包含一个名为 Title_Length变量，该变量将存储字符串的当前长度。如果要存储名称“John”，我们会将这四个字符放在Title的前四个位置，并将值4存储在 Title_Length变量中。然后，我们必须努力定义一个长度变量来与这个程序中使用的每个字符串相关联，这正是我们要做的。在第75行中，我们使用Length属性来确定从调用程序传入的字符数，并执行循环将输入字符串中的字符逐个复制到内部存储字符串。您将注意到在第80行中，Salary存储工资的值是微不足道的。
当我们进入Display 程序时，我们需要将字符一次复制到监视器上，如第92行到第94行所示。这不是很方便，而且有点容易出错，因为很容易对某些特定字符串使用错误的计数。尽管过程比实际应该的要长，但它们非常简单，因此您应该能够理解包体的作用。
一个简单的测试程序
Example program ------> e_c23_p7.ada
-- Chapter 23 - Program 7 with Ada.Text_IO, Person, Person.Positions; use Ada.Text_IO, Person, Person.Positions; procedure Busines1 is Big_John : SUPERVISOR; Jessica : SUPERVISOR; Steve : PROGRAMMER; Patrick : PROGRAMMER; Gwen : SECRETARY; begin Init_Data(Big_John, "John", 54000, "President"); Init_Data(Jessica, "Jessica", 47500, "CEO"); Init_Data(Steve, "Steve", 52000, "Chief Programmer", "Ada"); Init_Data(Patrick, "Patrick", 33000, "Assistant Debugger","C++"); Init_Data(Gwen, "Gwendolyn", 27000, TRUE, 85); Display(Big_John); Display(Jessica); Display(Steve); Display(Patrick); Display(Gwen); end Busines1; -- Result of execution -- -- John is a supervisor, and is the President of the company -- Jessica is a supervisor, and is the CEO of the company -- Steve is a programmer specializing in Ada. He makes 52000 dollars per year. -- Patrick is a programmer specializing in C++. He makes 33000 dollars per year. -- Gwendolyn is a secretary that does take shorthand. -- Gwendolyn is paid 27000 dollars per year.
名为e_c23_p7.ada的文件是一个非常简单的程序，它使用了我们刚刚定义的EMPLOYEE类，但实际上并没有使用太多。它在第8行到第12行中定义了一些变量，在第16行到第20行中用数据填充它们，并在监视器的第22行到第26行中显示数据。对Display的调用并没有什么特别之处，实际上它们只说明了子程序名重载。这里没有使用多态性。
您应该编译这三个文件（e_c23_p5.ada、e_c23_p6.ada和BUSINESS1.ada）并将它们链接在一起，因为它们是我们将在本章其余部分研究的一些附加操作的基础。
使用动态调度
Example program ------> e_c23_p8.ada
-- Chapter 23 - Program 8 with Ada.Text_IO, Person, Person.Positions; use Ada.Text_IO, Person, Person.Positions; procedure Busines2 is Big_John : aliased SUPERVISOR; Jessica : aliased SUPERVISOR; Steve : aliased PROGRAMMER; Patrick : aliased PROGRAMMER; Gwen : aliased SECRETARY; type EMPLOYEE_ACCESS is access all EMPLOYEE'Class; Employee_Point : EMPLOYEE_ACCESS; begin Init_Data(Big_John, "John", 54000, "President"); Init_Data(Jessica, "Jessica", 47500, "CEO"); Init_Data(Steve, "Steve", 52000, "Chief Programmer", "Ada"); Init_Data(Patrick, "Patrick", 33000, "Assistant Debugger", "C++"); Init_Data(Gwen, "Gwendolyn", 27000, TRUE, 85); Employee_Point := Big_John'Access; Display(Employee_Point.all); Employee_Point := Jessica'Access; Display(Employee_Point.all); Employee_Point := Steve'Access; Display(Employee_Point.all); Employee_Point := Patrick'Access; Display(Employee_Point.all); Employee_Point := Gwen'Access; Display(Employee_Point.all); end Busines2; -- Result of execution -- -- John is a supervisor, and is the President of the company -- Jessica is a supervisor, and is the CEO of the company -- Steve is a programmer specializing in Ada. He makes 52000 dollars per year. -- Patrick is a programmer specializing in C++. He makes 33000 dollars per year. -- Gwendolyn is a secretary that does take shorthand. -- Gwendolyn is paid 27000 dollars per year.
检查名为BUSINESS2.ADA的文件，了解另一个动态调度示例。在最后三个示例程序中，我们没有为动态调度做任何特别的准备，但是我们将使用前两个不变的文件来说明动态调度的用法。名为e_c23_p8.ada的文件首先将所有变量声明为别名，以便ada访问变量可以在程序中访问它们。我们在第14行中为EMPLOYEE类定义一个访问类型，并在第15行中使用该类型定义一个名为Employee_Point 的变量。我们像以前一样初始化所有变量，并准备好显示数据。
我们使用相同的访问变量连续访问每个变量，并显示每个变量中的数据。您将注意到，中的代码行与第26、28、30、32和34行中使用的代码行完全相同，但它不会在每次执行其中一行时调用相同的实际过程。当然，这是因为动态调度的工作方式。与access变量的当前值的类型匹配的过程就是将被调用的过程。
最后两个主程序的类型定义使用了相同的两个文件，但一个使用动态调度，另一个没有。这个程序的目的是说明将用于动态调度的类元素没有什么魔力，关键部分在调用程序中。
不要使用此过程
Example program ------> e_c23_p9.ada
-- Chapter 23 - Program 9
package Person is
type EMPLOYEE is abstract tagged private;
procedure Display(Person_In : EMPLOYEE) is abstract;
private
type EMPLOYEE is abstract tagged
record
Name : STRING(1..25);
Name_Length : INTEGER;
Salary : INTEGER;
end record;
end Person;
-- Result of execution
--
-- (This package cannot be executed alone.)
返回到名为e_c23_p5.ada的文件，讨论一个我们在讨论时完全忽略的小问题。第29行包含一个字符串，表示我们不希望有人调用此过程，如果有人调用，我们会将其解释为错误。事实上，我们不希望任何人创建这种类型的对象，因为我们不关心使用EMPLOYEE类型，只关心e_c23_p6.ada中定义的更具体的类型。
名为e_c23_p9.ada的示例程序包含一个新的保留字abstract，它在第5行和第11行中用于指示这是一个abstract 记录。因为它是abstract 的，所以不允许创建这种类型的变量，尝试这样做会导致编译错误。abstract一词也用于第7行，它表示过程是abstract 的，永远不能调用。因为它永远不会被调用，所以过程甚至不需要实现。由于不需要过程的主体，所以包主体是空的，因此完全消除了它。这样就不需要上下文子句了Ada.Text_IO文件包，因此它们被删除。
任何继承EMPLOYEE类型的类型都必须提供一个用于显示的实现或包含它的抽象定义。包含用于Display 的抽象定义将使新类型也成为abstract 记录，并且我们不能创建新类型的对象。但是，包括用于显示的实现将使新类型成为可用于定义一个或多个对象的普通类型。编译器将阻止您忽略显示子程序，并要求您将其包含在EMPLOYEE的每个子记录中。
这个修改最令人惊讶的部分是，它仍然可以与名为e_c23_p6.ada和e_c23_p7.ada或e_c23_p8.ada的文件一起使用，其中任何一个都没有更改。由于我们从未尝试创建EMPLOYEE类型的变量，因此这些文件中没有任何可更改的内容。您应该编译、链接和执行这两组文件，以向自己证明它实际上是按规定工作的。
这就结束了面向对象编程课程
这就完成了我们在本教程中对面向对象编程的研究。关于面向对象编程以及如何使用它，还有很多需要学习的内容，但是它超出了本教程的范围，其他出版物中也有大量关于这个主题的信息。本章的其余部分将用于说明在Ada中使用字符串的更好方法。它包含在这里，因为这些示例程序很好地说明了我们希望考虑的特定构造。
回到字符串问题
尽管看起来我们有一个字符串问题，但我们确实没有，因为字符串类型的工作方式与设计的工作方式完全相同。一门设计良好的语言的标志不在于它有能力做任何事情，而在于它有能力以一种有效的方式进行扩展，去做任何需要做的事情。Ada被设计成易于和健壮地扩展，字符串区域就是一个很好的例子。
所有ADA95编译器都有几个字符串包。它们在ARM中都有很好的定义，应该在编译器文档中有很好的定义。我们将看看其中一个包，以说明如何使用它来简化Ada程序中字符串的使用。名为Ada.Strings.Bounded包含一个名为Generic_Bounded_Length 的泛型包，它实现了一个比字符串类型灵活得多的字符串包。此字符串类型存储当前有效字符数的内部计数，与我们在e_c23_p5.ada和e_c23_p6.ada文件中所做的非常相似。它还提供了大量的子程序来加载、提取、连接以及处理字符串时通常需要的许多其他操作。
Example program ------> e_c23_p10.ada
-- Chapter 23 - Program 10
with Ada.Strings.Bounded;
package Person is
type EMPLOYEE is abstract tagged private;
procedure Display(Person_In : EMPLOYEE) is abstract;
package My_Strings is new
Ada.Strings.Bounded.Generic_Bounded_Length(25);
use My_Strings;
private
type EMPLOYEE is abstract tagged
record
Name : BOUNDED_STRING;
Salary : INTEGER;
end record;
end Person;
-- Result of execution
--
-- (This package cannot be executed alone.)
名为e_c23_p10.ada的文件通过在第10行实例化一个Generic_Bounded_Length 包的副本来使用该包，该副本为这种类型的字符串提供了25个字符的上限。这个包提供了一个名为BOUNDED_STRING 的类型，它定义了我们希望使用的字符串。每个字符串的长度可以是0到25个字符，string对象将记住当前存储在其中的字符数。名为Name的变量在第18行中被定义为type BOUNDED_STRING。类型的全名是My_Strings.BOUNDED_STRING.。您将注意到通用包位于 Ada.Strings.Bounded library，因此library在第2行的context子句中提到。在第10行和第11行中使用完全限定名，而不是use子句。这与大多数教程中的方法有点不同，但这两种方法都是完全可以接受的。
更多动态字符串
Example program ------> e_c23_p11.ada
-- Chapter 23 - Program 11
with Ada.Text_IO, Ada.Integer_Text_IO;
use Ada.Text_IO, Ada.Integer_Text_IO;
package Person.Positions is
-- The SUPERVISOR type has a title.
type SUPERVISOR is new EMPLOYEE with private;
procedure Init_Data(In_Person : in out SUPERVISOR;
In_Name : BOUNDED_STRING;
In_Salary : INTEGER;
In_Title : BOUNDED_STRING);
procedure Display(In_Person : SUPERVISOR);
-- The PROGRAMMER type has a language preference.
type PROGRAMMER is new EMPLOYEE with private;
procedure Init_Data(In_Person : in out PROGRAMMER;
In_Name : BOUNDED_STRING;
In_Salary : INTEGER;
In_Title : BOUNDED_STRING;
In_Language : BOUNDED_STRING);
procedure Display(In_Person : PROGRAMMER);
-- The SECRETARY type has a typing speed.
type SECRETARY is new EMPLOYEE with private;
procedure Init_Data(In_Person : in out SECRETARY;
In_Name : BOUNDED_STRING;
In_Salary : INTEGER;
In_ShortHand : BOOLEAN;
In_Speed : INTEGER);
procedure Display(In_Person : SECRETARY);
private
type SUPERVISOR is new EMPLOYEE with
record
Title : BOUNDED_STRING;
end record;
type PROGRAMMER is new EMPLOYEE with
record
Title : BOUNDED_STRING;
Language : BOUNDED_STRING;
end record;
type SECRETARY is new EMPLOYEE with
record
Shorthand : BOOLEAN;
Typing_Speed : INTEGER;
end record;
end Person.Positions;
package body Person.Positions is
-- Subprograms for the SUPERVISOR type.
procedure Init_Data(In_Person : in out SUPERVISOR;
In_Name : BOUNDED_STRING;
In_Salary : INTEGER;
In_Title : BOUNDED_STRING) is
begin
In_Person.Name := In_Name;
In_Person.Salary := In_Salary;
In_Person.Title := In_Title;
end Init_Data;
procedure Display(In_Person : SUPERVISOR) is
begin
for Index in 1..Length(In_Person.Name) loop
Put(Element(In_Person.Name, Index));
end loop;
Put(" is a supervisor, and is the ");
for Index in 1..Length(In_Person.Title) loop
Put(Element(In_Person.Title, Index));
end loop;
Put(" of the company");
New_Line;
end Display;
-- Subprograms for the PROGRAMMER type.
procedure Init_Data(In_Person : in out PROGRAMMER;
In_Name : BOUNDED_STRING;
In_Salary : INTEGER;
In_Title : BOUNDED_STRING;
In_Language : BOUNDED_STRING) is
begin
In_Person.Name := In_Name;
In_Person.Salary := In_Salary;
In_Person.Title := In_Title;
In_Person.Language := In_Language;
end Init_Data;
procedure Display(In_Person : PROGRAMMER) is
begin
for Index in 1..Length(In_Person.Name) loop
Put(Element(In_Person.Name, Index));
end loop;
Put(" is a programmer specializing in ");
for Index in 1..Length(In_Person.Language) loop
Put(Element(In_Person.Language, Index));
end loop;
Put(". He makes ");
Put(In_Person.Salary, 6);
Put(" dollars per year.");
New_Line;
end Display;
-- Subprograms for the SECRETARY type.
procedure Init_Data(In_Person : in out SECRETARY;
In_Name : BOUNDED_STRING;
In_Salary : INTEGER;
In_ShortHand : BOOLEAN;
In_Speed : INTEGER) is
begin
In_Person.name := In_Name;
In_Person.Salary := In_Salary;
In_Person.Shorthand := In_Shorthand;
In_Person.Typing_Speed := In_Speed;
end Init_Data;
procedure Display(In_Person : SECRETARY) is
begin
for Index in 1..Length(In_Person.Name) loop
Put(Element(In_Person.Name, Index));
end loop;
Put(" is a secretary that does ");
if not In_Person.Shorthand then
Put("not ");
end if;
Put("take shorthand.");
New_Line;
Put(" ");
for Index in 1..Length(In_Person.Name) loop
Put(Element(In_Person.Name, Index));
end loop;
Put(" is paid ");
Put(In_Person.Salary, 6);
Put(" dollars per year.");
New_Line;
end Display;
end Person.Positions;
-- Result of execution
--
-- (This package cannot be executed alone.)
检查名为e_uc23_up11.ada的文件，了解其他三种类型的定义，您将注意到包规范中没有字符串类型。它们被新类型BOUNDED_STRING所取代。包主体的第71行到第73行说明了这种新类型可能使用的干净语法，因为它具有一个赋值操作符，它不仅可以将文本分配给新变量，而且还可以指定当前长度。
由于我们无法将类型BOUNDED_STRING 变量输出到监视器，因此我们*使用循环一次输出单个字符，但是循环使用单个变量的属性，而不是使用两个单独的变量来控制输出。这将导致显示过程看起来比上一个示例程序中的Display 过程更干净。这个包的其余部分与你可以在闲暇时学习的内容完全相同。
主要节目很难看
Example program ------> e_c23_p12.ada
-- Chapter 23 - Program 12
with Ada.Text_IO, Person, Person.Positions;
use Ada.Text_IO, Person, Person.Positions;
procedure Busines3 is
Big_John : SUPERVISOR;
Jessica : SUPERVISOR;
Steve : PROGRAMMER;
Patrick : PROGRAMMER;
Gwen : SECRETARY;
begin
Init_Data(Big_John, My_Strings.To_Bounded_String("John"),
54000, My_Strings.To_Bounded_String("President"));
Init_Data(Jessica, My_Strings.To_Bounded_String("Jessica"),
47500, My_Strings.To_Bounded_String("CEO"));
Init_Data(Steve, My_Strings.To_Bounded_String("Steve"),
52000, My_Strings.To_Bounded_String("Chief Programmer"),
My_Strings.To_Bounded_String("Ada"));
Init_Data(Patrick, My_Strings.To_Bounded_String("Patrick"),
33000, My_Strings.To_Bounded_String("Assistant Debugger"),
My_Strings.To_Bounded_String("C++"));
Init_Data(Gwen, My_Strings.To_Bounded_String("Gwendolyn"),
27000, TRUE, 85);
Display(Big_John);
Display(Jessica);
Display(Steve);
Display(Patrick);
Display(Gwen);
end Busines3;
-- Result of execution
--
-- John is a supervisor, and is the President of the company
-- Jessica is a supervisor, and is the CEO of the company
-- Steve is a programmer specializing in Ada. He makes 52000 dollars per year.
-- Patrick is a programmer specializing in C++. He makes 33000 dollars per year.
-- Gwendolyn is a secretary that does take shorthand.
-- Gwendolyn is paid 27000 dollars per year.
由于需要维护正确的类型，因此有必要将第16行到第31行中的字符串常量转换为BOUNDED_STRING 类型。这是通过调用每个字符串参数的To_Bounded_String 函数，然后再将它们传递到 Init_Data过程中来完成的。这看起来很难看，而且似乎已经无法使用有界字符串包的目的。当编写一个字符串密集型程序时，通常会有一个小的输入例程，以及一个小的输出例程，但是程序中可能会进行大量的字符串处理。一个好的例子是拼写检查，通常只有一个单词输入，但整个字典必须搜索。
除了有界字符串包外，您还定义了一个字符串类型，其中包含可以存储在其中的字符数的一些上限，还有一个未绑定的字符串包。未绑定字符串可以存储任意数量的字符。它通过在长度中添加更多字符时自动增长更长来实现这一点。添加字符时，它会在每次耗尽空间时重新分配一个较大的块，以便字符串适合。如果您想使用此软件包，您将自行研究。
编程练习
1.删除e_c23_p1.ada第147行的注释，看看编译器会出现什么样的错误(Solution)
2.当您使用e_c23_p5.ADA文件作为EMPLOYEE类型的定义时，请在BUSINESS2.ADA文件中定义EMPLOYEE类型的变量。调用Display过程以查看它是否可以与子类型一起使用。(Solution)
3.使用e_c23_p9.ADA文件作为类型定义时，请在BUSINESS2.ADA文件中定义雇员类型的变量。报告的错误对你有意义吗？(Solution)
---------------------------------------------------------------------------------------------------------------------------
原英文版出处：https://perso.telecom-paristech.fr/pautet/Ada95/a95list.htm
翻译（百度）：博客园 一个默默的 *** 的人