我想写一个“=”函数,它可以将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 functionWhen you define your own, though:
function "=" (Left, Right : A_Access) return Boolean isRight 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 thenwill 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 "=";更多推荐
发布评论