Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

How can I overload the '=' operator in Ada without creating a recursive function?

FUNCTION "=" (lString1, lString2 : IN lString) RETURN boolean IS


     IF lString1 = NULL AND lString2 = NULL THEN 
        RETURN true;
      ELSIF lString1 = NULL OR lString2 = NULL THEN
        RETURN false;
      END IF;

I'm trying to overload the equality operator in Ada. Each time I use the operator '=' within the function it causes a recursion which leads to a stack overflow, rather than use the ada defined operator which I need. Is there a way to differentiate it from my overloaded operator?

like image 676
Gramstrong Avatar asked May 22 '11 06:05

Gramstrong


2 Answers

By introducing a non-overloaded utility function to do the access type comparisons, the OP's function definition, with the needed syntax fixes and modified to use the utility function, can be made to work.

I'm still puzzled, though, as to why invoking "=" as Standard."=" is rejected by the compiler (GNAT) for specifying "incompatible arguments".

with Text_IO; use Text_IO;

procedure non_recursive_equals is

   type Lstring is access String;

   -- Be aware, the ordering of the functions here is important!
   function Is_Equal(Lstring1, Lstring2 : in Lstring) return Boolean is
   begin
      return Lstring1 = Lstring2;
   end Is_Equal;

   function "=" (lString1, lString2 : in Lstring) return Boolean is
   begin
      if Is_Equal(LString1, null) and Is_Equal(LString2, null) then
         return True;
      elsif Is_Equal(LString1, null) or Is_Equal(LString2, null) then
         return False;
      end if;
      return False;
   end "=";

   L1, L2 : Lstring := null;

begin
   Put_Line("L1 and L2 null: " & Boolean'Image(L1 = L2));
   L2 := new String(1..10);
   Put_Line("L2 not null   : " & Boolean'Image(L1 = L2));
end non_recursive_equals;

Edit:

Here's another way, using a renames clause:

with Text_IO; use Text_IO;

procedure non_recursive_equals is

   type Lstring is access String;

   function Is_Equal (lString1, lString2 : in Lstring) return Boolean is
   begin
      if lString1 = null and lString2 = null then
         return True;
      elsif lString1 = null or lString2 = null then
         return False;
      end if;
      return False;
   end Is_Equal;

   function "=" (Lstring1, Lstring2 : in Lstring) return Boolean renames
     Is_Equal;

   L1, L2 : Lstring := null;

begin
   Put_Line ("L1 and L2 null: " & Boolean'Image (L1 = L2));
   L2 := new String (1 .. 10);
   Put_Line ("L2 not null   : " & Boolean'Image (L1 = L2));
end non_recursive_equals;
like image 183
Marc C Avatar answered Sep 27 '22 17:09

Marc C


Here's yet another way, using only Ada83... and a horrid example/abuse of exceptions:

  Type LString is Access String;

  Function "=" (Left, Right: IN LString) Return Boolean is
     Subtype Constrained_LString is Not Null LString;

     Function Is_Equal( Left : LString; Right : String ) 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 "=";

What happens is if it is called and Right = Null the attempt to de-reference it causes an exception; in this case we try to de-reference Left and if that too fails then both must be Null. In the case where only one fails the equality must be false and in the case where both parameters can be de-referenced the result is the test for equality on those strings.

like image 29
Shark8 Avatar answered Sep 27 '22 18:09

Shark8