Re: Odd/Broken behavior DOTNET-GNAT vs GNAT regarding tagged types.

[Shark8 <onewingedshark@gmail.com>]

On Oct 22, 5:20 pm, Adam Beneschan <a...@irvine.com> wrote:
>
> Is_Descendant_At_Same_Level does appear to be wrong in the DOTNET-GNAT
> version.  However, as an implementor, I would be very surprised if
> Is_Descendant_At_Same_Level tries to use external tags to compute the
> result.  I guess that's why I was confused by your original statement,
> that the difference in external tag behavior "shows why the behavior"
> of Is_Descendant_At_Same_level is broken.  It should be unrelated.
>
>                              -- Adam

Sadly, "should" and "are" are often significantly different. :(
Anyway, I did some poking around and, on opening the Ada.Tags.ADB
file, here's what I found:

package body Ada.Tags is

   type String_Access is access all String;

   -------------------
   -- CW_Membership --
   -------------------

   function CW_Membership (Obj_Tag : Tag; Typ_Tag : Tag) return
Boolean is
   begin
      --  ??? This needs to be implemented
      raise Program_Error;
      return False;
   end CW_Membership;

   -------------------
   -- Expanded_Name --
   -------------------

   function Expanded_Name (T : Tag) return String is
      function Ada_Name (T : Tag) return String_Access;
      pragma Import (CIL, Ada_Name,
"mgnat.adalib.GNAT_libc.ada_name");
   begin
      return Ada_Name (T).all;
   end Expanded_Name;

   ------------------
   -- External_Tag --
   ------------------

   function External_Tag (T : Tag) return String is
      function Ext_Tag (T : Tag) return String_Access;
      pragma Import (CIL, Ext_Tag,
"mgnat.adalib.GNAT_libc.external_tag");
   begin
      return Ext_Tag (T).all;
   end External_Tag;

   ------------------
   -- Internal_Tag --
   ------------------

   function Internal_Tag (External : String) return Tag is
      function Int_Tag (External : String) return Tag;
      pragma Import (CIL, Int_Tag,
"mgnat.adalib.GNAT_libc.internal_tag");
   begin
      return Int_Tag (External);
   exception
      when others => raise Tag_Error;
   end Internal_Tag;

   --------------------
   -- Descendant_Tag --
   --------------------

   function Descendant_Tag (External : String; Ancestor : Tag) return
Tag is
      pragma Unreferenced (Ancestor);
   begin
      --  ??? This needs to be implemented
      return Internal_Tag (External);
   end Descendant_Tag;

   ---------------------------------
   -- Is_Descendant_At_Same_Level --
   ---------------------------------

   function Is_Descendant_At_Same_Level
     (Descendant : Tag;
      Ancestor   : Tag) return Boolean
   is
      pragma Unreferenced (Descendant, Ancestor);
   begin
      --  ??? This needs to be implemented
      return False;
   end Is_Descendant_At_Same_Level;

   ----------------
   -- Parent_Tag --
   ----------------

   function Parent_Tag (T : Tag) return Tag is
   begin
      --  ??? This needs to be implemented
      return T;
   end Parent_Tag;

end Ada.Tags;


I think it is safe to say the culprit is this:  "--  ??? This needs to
be implemented"
Yeah, "not-implemented" is the same as "doesn't work" in many cases.