我试图了解面向对象在Ada中是如何运作的。我发现了一个我无法解决的情况。
我知道如何使用类范围类型来启用多态，我知道如何覆盖父类＆＃39;来自派生的方法。
我不知道如何做的事情是覆盖接收类范围类型作为参数的过程，因为我总是获得编译错误。我在下面深入解释：
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;
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
如何实现我想要的行为？
答案 0 :(得分：2)
采用类范围参数的子程序不是类的父类的基本操作，因此不能被继承。
如果子程序采用了一个类范围的参数，那么关键是它的实现是根据为类的父类定义的操作来编写的。如果要更改派生类型的行为，可以通过覆盖派生类型的相关基本操作来完成。
规格：
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;
答案 1 :(得分：2)
正如Jacob在this answer中所说，你不能覆盖Do_Something，因为它不是原始的，因为它的控制参数是全班的。
如果完全删除Pack2.Do_Something，您的程序将编译。但是，输出是
$ ./main
Calling from Type1, 220
Calling from Type1, 320
越来越接近你想要的东西了。
更好的解决方案是消除’Class中的Pack2.Do_Something，这使其成为原始（可分派）操作。
我仍然没有得到你想要的结果：
$ ./main
Calling from Type1, 220
Calling from Type2, 340
也许您打算将Pack2.Type2.ii初始化为30？
（顺便说一句，您发布的代码无法编译。请通过提交可编辑的示例让我们更方便地帮助您！）
答案 2 :(得分：1)
问题是你试图过早使用类类型。您希望Do_Something过程接受Type1和Type2的输入，而不是Type1'Class或Type2'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