在"="函数中检查空对象

Question

我想写一个"="函数,它可以将A_Access与null对象进行比较.我如何编写"="函数,以便它可以工作？我试试看,见下文.

代码生成一个凸起的CONSTRAINT_ERROR:main.adb:14访问检查失败.

with Ada.Tags;
with Ada.Text_IO;

procedure Main is
   type A is tagged
      record
         a : Integer;
      end record;
   type A_Access is access all A'Class;

   function "=" (Left, Right : A_Access) return Boolean is
      use Ada.Tags;
   begin
      return (Left.all'Tag = Right.all'Tag and then Left.a = Right.a);
   end "=";
begin
   declare
      A_1 : A_Access := new A'(a => 1);
      A_2 : A_Access := null;
   begin
      if A_1 /= A_2 then
         Ada.Text_IO.Put_Line (":-)");
      end if;
   end;
end Main;

我也尝试检查null,但随后,我得到了STORAGE_ERROR:堆栈溢出.我想,这里发生了无限递归？

function "=" (Left, Right : A_Access) return Boolean is
   use Ada.Tags;
begin
   if null = Left or null = Right then
      return False;
   else
      return (Left.all'Tag = Right.all'Tag and then Left.a = Right.a);
   end if;
end "=";

Answer 1

定义类型时A_Access,编译器会自动为您定义相等运算符:

function "=" (Left, Right : A_Access) return Boolean; --built-in function

但是,当您定义自己的时,:

function "=" (Left, Right : A_Access) return Boolean is

在is关键字之后,您的新函数变得可见,并且无论A_Access何时在两个类型的操作数上使用它,它都会调用您的新函数 - 包括函数体内部.这意味着这条线

if null = Left or null = Right then

将"="递归调用,导致堆栈溢出.

要解决此问题,您可以在定义自己的函数之前重命名内置函数"=":

type A_Access is access all A'Class;
-- the following declaration is implicitly added by the compiler
--function "=" (Left, Right : A_Access) return Boolean; --built-in function
function Builtin_Equal (Left, Right : A_Access) return Boolean renames "=";

由于此时您的新"="内容不可见,因此renames "="将重命名内置函数.现在您可以使用新名称:

function "=" (Left, Right : A_Access) return Boolean is
   use Ada.Tags;
begin
   if Builtin_Equal (null, Left) or else Builtin_Equal (null, Right) then
      return False;  -- THIS IS WRONG!
   else
      return (Left.all'Tag = Right.all'Tag and then Left.a = Right.a);
   end if;
end "=";

(我改为or,or else因为这是我的偏好,因为如果代码不必评估两个操作数,它有时会节省一点时间.这没关系.)

另外,如果双方都是,你真的希望你"="回来吗？试试这个:Falsenull

function "=" (Left, Right : A_Access) return Boolean is
   use Ada.Tags;
begin
   if Builtin_Equal (null, Left) or else Builtin_Equal (null, Right) then
      return Builtin_Equal (Left, Right);
   else
      return (Left.all'Tag = Right.all'Tag and then Left.a = Right.a);
   end if;
end "=";

true如果两者都是null,但如果两者都不是,false则返回null,否则它将检查您的标签和a组件.另一种方式来做到这一点,这就是如果有点更高效Left,并Right恰巧是完全一样的指针:

function "=" (Left, Right : A_Access) return Boolean is
   use Ada.Tags;
begin
   if Builtin_Equal (Left, Right) then
      return true;
   elsif Builtin_Equal (null, Left) or else Builtin_Equal (null, Right) then
      return false;
   else
      return (Left.all'Tag = Right.all'Tag and then Left.a = Right.a);
   end if;
end "=";