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，因为这是我的偏好，因为如果代码不必评估两个操作数，它有时会节省一点时间它并不重要。）

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

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

Answer 2

我不是很擅长Ada，但这就是我所知道的：当你将access参数与null进行比较时，你的重载当然会被使用。我不记得是否有这样的事情＆＃34;访问基类版本＆＃34; （在这里使用C ++术语）但你实际上要做的是比较两个指针而不是两个记录。这就是你超载＆＃34; =＆＃34;是的，这就是为什么你得到一个递归。

也许你应该写一个像这样的函数 Is_Equal（）

使用访问类型并保持预定义的相等运算符不受影响。

Answer 3

前段时间我回答了类似的问题 “ How can I overload the '=' operator in Ada without creating a recursive function? ”，虽然它没有处理全班级参数。

您可以使用相同的技术：

  Type Class_Access is Access WHATEVER'CLASS;

  Function "=" (Left, Right: IN Class_Access) Return Boolean is

     Function Is_Equal( Left : Class_Access; Right : WHATEVER'CLASS ) Return Boolean is
     begin
        Return Right = Left.All;
     exception
        When CONSTRAINT_ERROR => Return False;
     end Is_Equal;

  Begin
     Return Is_Equal(Left, Right.All);
  Exception
     When CONSTRAINT_ERROR =>
        begin
           Return Is_Equal(Right,Left.All);
        Exception
           When CONSTRAINT_ERROR => Return True;
        end;
  End "=";

虽然使用ajb的答案和Ada.Tags.Is_Descendant_At_Same_Level的组合可能是更好的解决方案。

在“=”函数中检查空对象

3 个答案: