在“=”函数中检查空对象(Check for null object in “=” function)

在“=”函数中检查空对象(Check for null object in “=” function)

我想写一个“=”函数，它可以将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 "=";

I want to write a "=" function, which can compare an A_Access also against the null object. How do I need to write the "=" function, so that it works? For my try, see below.

The code produces a raised CONSTRAINT_ERROR : main.adb:14 access check failed.

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;

I also tried to check for null, but then, I get raised STORAGE_ERROR : stack overflow. I think, here happens an infinite recursion?

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 "=";

最满意答案

定义类型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 else因为它是我的偏好，因为如果代码不必评估两个操作数，它有时会节省一点时间。这没关系。）

另外，如果双方都为null ，你真的希望你的"="返回False吗？ 试试这个：

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 "=";

如果两者都为null ，则返回true ;如果其中一个为null ，则返回true否则返回false ，否则将检查标记和组件。 另一种方法，如果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 "=";

When you define the type A_Access, the compiler automatically defines an equality operator for you:

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

When you define your own, though:

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

Right after the is keyword, your new function becomes visible, and any time you use it on two operands of type A_Access, it will call your new function--including inside the body of your function. That means that the line

if null = Left or null = Right then

will call your "=" recursively, leading to a stack overflow.

To get around this, you can rename the built-in function before you define your own "=":

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 "=";

Since your new "=" isn't visible at that point, renames "=" will rename the built-in function. Now you can use your new name:

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 "=";

(I changed or to or else because it's my preference, and because it will sometimes save a little bit of time if the code doesn't have to evaluate both operands. It doesn't matter much.)

Also, do you really want your "=" to return False if both sides are null? Try this instead:

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 "=";

which returns true if both are null, false if either one is null but not both, and otherwise it will check your tag and a component. Another way to do it, which is a little more efficient if Left and Right happen to be the exact same pointer:

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 "=";