PROSAGA码农传奇-Ada-覆盖在Ada中接收类范围类型作为参数的过程

<div class =“post-text”itemprop =“text”>
  <P>
    问题是你试图过早使用类类型。您希望Do_Something过程接受Type1和Type2的输入，而不是Type1'Class或Type2'Class。然后你可以从另一个带有类类型参数的程序中调用这些程序（这将为你提供多态性）。
  </p>
  <P>
    Jacob Sparre Andersen在他的回答中向您展示了这一点，但我希望将更接近原始代码的内容作为额外的参考。
  </p>
  <P>
    下面是一个基于您的原始测试程序（在jdoodle在线编译器中编译），它显示了以多态方式调用函数的各种方法。
  </p>
  <H2>
    码：
  </H2>
   <pre>
    <code>
      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;

</code>
  </pre>
  <H2>
    输出：
  </H2>
   <pre>
    <code>
      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

</code>
  </pre>
</DIV>