在 Ada 中覆盖接收 class 宽类型作为参数的过程
Override a procedure that recieves a class wide type as an argument in Ada
我正在尝试了解面向对象在 Ada 中的工作原理。我发现了一个我无法解决的情况。
我知道如何使用 class 宽类型来启用多态性，并且我知道如何从派生方法覆盖父 class' 方法。
我不知道如何做的事情是重写接收 class 宽类型作为参数的过程，因为我总是遇到编译错误。我在下面对此进行深入解释：
我试过的
类型 1
package Pack1
type Type1 is tagged
record
i : Integer := 20;
end record;
function get_number(self : Type1) return Integer;
procedure do_something(self : Type1'class);
end Pack1;
----------------------------------------------------
package body Pack1 is
function get_number(self : Type1) return Integer is
begin
return 200;
end get_number;
procedure do_something(self : Type1'class) is
begin
Put_Line("Calling from Type1, " & (Integer'Image(self.i + self.get_number)));
end do_something;
end Pack1;
类型 2
package Pack2
type Type2 is new Type1 with
record
ii : Integer := 20;
end record;
overriding function get_number(self : Type2) return Integer;
overriding procedure do_something(self : Type2'class);
end Pack2;
----------------------------------------------------
package body Pack2 is
function get_number(self : Type2) return Integer is
begin
return 300;
end get_number;
procedure do_something(self : Type2'class) is
begin
Put_Line("Calling from Type2, " & (Integer'Image(self.i + self.ii + self.get_number)));
end do_something;
end Pack2;
主要
procedure Main is
t1 : Type1;
t2 : Type2;
begin
t1.do_something;
t2.do_something;
end Main;
获取错误
编译时出现错误：
possible interpretation at Type1.ads
possible interpretation at Type2.ads
预期输出
当我可以编译代码时，我希望获得以下内容：
Calling from Type1, 220
Calling from Type2, 350
如何实现我想要的行为？
采用 class 范围参数的子程序不是 class 父程序的原始操作，因此不能被继承。
如果子程序采用 class 范围的参数，关键是它的实现是根据为 class 的父级定义的操作编写的。如果要更改派生类型的行为，可以通过覆盖派生类型的相关原始操作来实现。
规格：
package A is
type Values is range 0 .. 999;
type Instance is tagged private;
subtype Class is Instance'Class; --'
function Name (Item : in Instance) return String;
function Get_Number (Item : in Instance) return Values;
function Get_Sum (Item : in Instance) return Values;
private
type Instance is tagged
record
First : Values := 20;
end record;
end A;
with A;
package B is
subtype Parent is A.Instance;
type Instance is new Parent with private;
subtype Class is Instance'Class; --'
overriding
function Name (Item : in Instance) return String;
overriding
function Get_Number (Item : in Instance) return A.Values;
overriding
function Get_Sum (Item : in Instance) return A.Values;
private
type Instance is new Parent with
record
Second : A.Values := 20;
end record;
end B;
with Ada.Text_IO;
with A;
procedure Do_Something (Item : in A.Class);
实现：
package body A is
function Name (Item : in Instance) return String is ("Class A");
function Get_Number (Item : in Instance) return Values is (200);
function Get_Sum (Item : in Instance) return Values is (Item.First);
end A;
package body B is
use all type A.Values;
overriding
function Name (Item : in Instance) return String is ("Class B");
overriding
function Get_Number (Item : in Instance) return A.Values is (300);
overriding
function Get_Sum (Item : in Instance) return A.Values is (Parent (Item).Get_Sum + Item.Second);
end B;
procedure Do_Something (Item : in A.Class) is
use all type A.Values;
begin
Ada.Text_IO.Put_Line
("Calling from " & Item.Name & ", " & A.Values'Image (Item.Get_Number + Item.Get_Sum));
end Do_Something;
最后是演示者：
with A;
with B;
with Do_Something;
procedure Inheritance_Demo_2018_06_13 is
O : A.Instance;
P : B.Instance;
begin
Do_Something (O);
Do_Something (P);
end Inheritance_Demo_2018_06_13;
正如 Jacob 在 中所说，你不能覆盖 Do_Something 因为它不是原始的，因为它的控制参数是类范围的。
如果您完全删除 Pack2.Do_Something，您的程序将会编译。然而，输出是
$ ./main
Calling from Type1, 220
Calling from Type1, 320
越来越接近你想要的了。
更好的解决方案是在 Pack2.Do_Something 中消除 ’Class，这使其成为原始（可分派）操作。
还是没有得到你想要的结果：
$ ./main
Calling from Type1, 220
Calling from Type2, 340
也许您打算将 Pack2.Type2.ii 初始化为 30？
（顺便说一句，您发布的代码无法编译。请提交可编译的示例，以便我们更轻松地帮助您！）
问题是您尝试使用 class 类型有点为时过早。您希望 Do_Something 过程接受 Type1 和 Type2 的输入，而不是 Type1'Class 或 Type2'Class。然后，您可以从另一个采用 class 类型参数（这将为您提供多态性）的过程中调用这些过程。
Jacob Sparre Andersen 在他的回答中向您展示了这一点，但我想生成更接近您的原始代码的内容作为额外参考。
下面是一个基于您的原始（在 jdoodle 在线编译器中编译）的测试程序，显示了多态调用函数的各种方法。
代码：
with Ada.Text_IO; use Ada.Text_IO;
procedure jdoodle is
package Pack1 is
type Type1 is tagged
record
i : Integer := 20;
end record;
type Type1_Class_Access is access all Type1'Class;
function get_number(self : Type1) return Integer;
procedure do_something(self : Type1); -- note the change here
end Pack1;
----------------------------------------------------
package body Pack1 is
function get_number(self : Type1) return Integer is
begin
return 200;
end get_number;
procedure do_something(self : Type1) is -- note the change here
begin
Put_Line("Calling from Type1, " & (Integer'Image(self.i + self.get_number)));
end do_something;
end Pack1;
package Pack2 is
use Pack1;
type Type2 is new Type1 with
record
ii : Integer := 20;
end record;
overriding function get_number(self : Type2) return Integer;
overriding procedure do_something(self : Type2); -- note the change here
end Pack2;
----------------------------------------------------
package body Pack2 is
function get_number(self : Type2) return Integer is
begin
return 300;
end get_number;
procedure do_something(self : Type2) is
begin
Put_Line("Calling from Type2, " & (Integer'Image(self.i + self.ii + self.get_number)));
end do_something;
end Pack2;
t1 : aliased Pack1.Type1;
t2 : aliased Pack2.Type2;
p1 : Pack1.Type1'Class := Pack1.Type1'(others => <>);
p2 : Pack1.Type1'Class := Pack2.Type2'(others => <>);
procedure Do_Something(Object : Pack1.Type1'Class) is
begin
Object.Do_Something; -- polymorphically calls Do_Something
end Do_Something;
type Class_Array is array(Integer range <>) of Pack1.Type1_Class_Access;
a : Class_Array(1..2) := (1 => t1'Access, 2 => t2'Access);
begin
-- Non Polymorphic calls
t1.do_something;
t2.do_something;
-- Polymorphic variable calls
-- both variables are of type Pack1.Type1'Class
p1.do_something;
p2.do_something;
-- Polymorphic procedure calls
-- the input type of the procedure is Pack1.Type1'Class
Do_Something(t1);
Do_Something(t2);
-- Polymorphic array of class access variable calls
for e of a loop
e.Do_Something;
end loop;
for e of a loop
Do_Something(e.all);
end loop;
end jdoodle;
输出：
Calling from Type1, 220
Calling from Type2, 340
Calling from Type1, 220
Calling from Type2, 340
Calling from Type1, 220
Calling from Type2, 340
Calling from Type1, 220
Calling from Type2, 340
Calling from Type1, 220
Calling from Type2, 340
我正在尝试了解面向对象在 Ada 中的工作原理。我发现了一个我无法解决的情况。
我知道如何使用 class 宽类型来启用多态性，并且我知道如何从派生方法覆盖父 class' 方法。
我不知道如何做的事情是重写接收 class 宽类型作为参数的过程，因为我总是遇到编译错误。我在下面对此进行深入解释：
我试过的
类型 1
package Pack1
type Type1 is tagged
record
i : Integer := 20;
end record;
function get_number(self : Type1) return Integer;
procedure do_something(self : Type1'class);
end Pack1;
----------------------------------------------------
package body Pack1 is
function get_number(self : Type1) return Integer is
begin
return 200;
end get_number;
procedure do_something(self : Type1'class) is
begin
Put_Line("Calling from Type1, " & (Integer'Image(self.i + self.get_number)));
end do_something;
end Pack1;
类型 2
package Pack2
type Type2 is new Type1 with
record
ii : Integer := 20;
end record;
overriding function get_number(self : Type2) return Integer;
overriding procedure do_something(self : Type2'class);
end Pack2;
----------------------------------------------------
package body Pack2 is
function get_number(self : Type2) return Integer is
begin
return 300;
end get_number;
procedure do_something(self : Type2'class) is
begin
Put_Line("Calling from Type2, " & (Integer'Image(self.i + self.ii + self.get_number)));
end do_something;
end Pack2;
主要
procedure Main is
t1 : Type1;
t2 : Type2;
begin
t1.do_something;
t2.do_something;
end Main;
获取错误
编译时出现错误：
possible interpretation at Type1.ads
possible interpretation at Type2.ads
预期输出
当我可以编译代码时，我希望获得以下内容：
Calling from Type1, 220
Calling from Type2, 350
如何实现我想要的行为？
采用 class 范围参数的子程序不是 class 父程序的原始操作，因此不能被继承。
如果子程序采用 class 范围的参数，关键是它的实现是根据为 class 的父级定义的操作编写的。如果要更改派生类型的行为，可以通过覆盖派生类型的相关原始操作来实现。
规格：
package A is
type Values is range 0 .. 999;
type Instance is tagged private;
subtype Class is Instance'Class; --'
function Name (Item : in Instance) return String;
function Get_Number (Item : in Instance) return Values;
function Get_Sum (Item : in Instance) return Values;
private
type Instance is tagged
record
First : Values := 20;
end record;
end A;
with A;
package B is
subtype Parent is A.Instance;
type Instance is new Parent with private;
subtype Class is Instance'Class; --'
overriding
function Name (Item : in Instance) return String;
overriding
function Get_Number (Item : in Instance) return A.Values;
overriding
function Get_Sum (Item : in Instance) return A.Values;
private
type Instance is new Parent with
record
Second : A.Values := 20;
end record;
end B;
with Ada.Text_IO;
with A;
procedure Do_Something (Item : in A.Class);
实现：
package body A is
function Name (Item : in Instance) return String is ("Class A");
function Get_Number (Item : in Instance) return Values is (200);
function Get_Sum (Item : in Instance) return Values is (Item.First);
end A;
package body B is
use all type A.Values;
overriding
function Name (Item : in Instance) return String is ("Class B");
overriding
function Get_Number (Item : in Instance) return A.Values is (300);
overriding
function Get_Sum (Item : in Instance) return A.Values is (Parent (Item).Get_Sum + Item.Second);
end B;
procedure Do_Something (Item : in A.Class) is
use all type A.Values;
begin
Ada.Text_IO.Put_Line
("Calling from " & Item.Name & ", " & A.Values'Image (Item.Get_Number + Item.Get_Sum));
end Do_Something;
最后是演示者：
with A;
with B;
with Do_Something;
procedure Inheritance_Demo_2018_06_13 is
O : A.Instance;
P : B.Instance;
begin
Do_Something (O);
Do_Something (P);
end Inheritance_Demo_2018_06_13;
正如 Jacob 在 Do_Something 因为它不是原始的，因为它的控制参数是类范围的。
如果您完全删除 Pack2.Do_Something，您的程序将会编译。然而，输出是
$ ./main
Calling from Type1, 220
Calling from Type1, 320
越来越接近你想要的了。
更好的解决方案是在 Pack2.Do_Something 中消除 ’Class，这使其成为原始（可分派）操作。
还是没有得到你想要的结果：
$ ./main
Calling from Type1, 220
Calling from Type2, 340
也许您打算将 Pack2.Type2.ii 初始化为 30？
（顺便说一句，您发布的代码无法编译。请提交可编译的示例，以便我们更轻松地帮助您！）
问题是您尝试使用 class 类型有点为时过早。您希望 Do_Something 过程接受 Type1 和 Type2 的输入，而不是 Type1'Class 或 Type2'Class。然后，您可以从另一个采用 class 类型参数（这将为您提供多态性）的过程中调用这些过程。
Jacob Sparre Andersen 在他的回答中向您展示了这一点，但我想生成更接近您的原始代码的内容作为额外参考。
下面是一个基于您的原始（在 jdoodle 在线编译器中编译）的测试程序，显示了多态调用函数的各种方法。
代码：
with Ada.Text_IO; use Ada.Text_IO;
procedure jdoodle is
package Pack1 is
type Type1 is tagged
record
i : Integer := 20;
end record;
type Type1_Class_Access is access all Type1'Class;
function get_number(self : Type1) return Integer;
procedure do_something(self : Type1); -- note the change here
end Pack1;
----------------------------------------------------
package body Pack1 is
function get_number(self : Type1) return Integer is
begin
return 200;
end get_number;
procedure do_something(self : Type1) is -- note the change here
begin
Put_Line("Calling from Type1, " & (Integer'Image(self.i + self.get_number)));
end do_something;
end Pack1;
package Pack2 is
use Pack1;
type Type2 is new Type1 with
record
ii : Integer := 20;
end record;
overriding function get_number(self : Type2) return Integer;
overriding procedure do_something(self : Type2); -- note the change here
end Pack2;
----------------------------------------------------
package body Pack2 is
function get_number(self : Type2) return Integer is
begin
return 300;
end get_number;
procedure do_something(self : Type2) is
begin
Put_Line("Calling from Type2, " & (Integer'Image(self.i + self.ii + self.get_number)));
end do_something;
end Pack2;
t1 : aliased Pack1.Type1;
t2 : aliased Pack2.Type2;
p1 : Pack1.Type1'Class := Pack1.Type1'(others => <>);
p2 : Pack1.Type1'Class := Pack2.Type2'(others => <>);
procedure Do_Something(Object : Pack1.Type1'Class) is
begin
Object.Do_Something; -- polymorphically calls Do_Something
end Do_Something;
type Class_Array is array(Integer range <>) of Pack1.Type1_Class_Access;
a : Class_Array(1..2) := (1 => t1'Access, 2 => t2'Access);
begin
-- Non Polymorphic calls
t1.do_something;
t2.do_something;
-- Polymorphic variable calls
-- both variables are of type Pack1.Type1'Class
p1.do_something;
p2.do_something;
-- Polymorphic procedure calls
-- the input type of the procedure is Pack1.Type1'Class
Do_Something(t1);
Do_Something(t2);
-- Polymorphic array of class access variable calls
for e of a loop
e.Do_Something;
end loop;
for e of a loop
Do_Something(e.all);
end loop;
end jdoodle;
输出：
Calling from Type1, 220
Calling from Type2, 340
Calling from Type1, 220
Calling from Type2, 340
Calling from Type1, 220
Calling from Type2, 340
Calling from Type1, 220
Calling from Type2, 340
Calling from Type1, 220
Calling from Type2, 340