From mboxrd@z Thu Jan  1 00:00:00 1970
X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on polar.synack.me
X-Spam-Level: 
X-Spam-Status: No, score=-1.3 required=5.0 tests=BAYES_00,INVALID_MSGID
	autolearn=no autolearn_force=no version=3.4.4
X-Google-Language: ENGLISH,ASCII-7-bit
X-Google-Thread: 103376,ca0cb7cf9847d846
X-Google-Attributes: gid103376,public
From: Chris Sparks <sparks@AISF.COM>
Subject: Re: Membership test problem
Date: 1996/10/04
Message-ID: <32551CAB.4910@aisf.com>#1/1
X-Deja-AN: 187591379
sender: Ada programming language <INFO-ADA@LISTSERV.NODAK.EDU>
comments: Gated by NETNEWS@AUVM.AMERICAN.EDU
content-type: text/plain; charset=us-ascii
organization: McDonnell Douglas
mime-version: 1.0
newsgroups: comp.lang.ada
x-mailer: Mozilla 3.0 (X11; I; HP-UX B.10.10 9000/712)
Date: 1996-10-04T00:00:00+00:00
List-Id: <comp.lang.ada>


Bob Duff wrote:

> If you want tag1'class, then say so.  What's the problem?

When you replace Joel VanLaven's code

  return object in tag1;

with

  return object in tag1'class;

as he suggests, the result noticed by Joel still happens.

If an object is of type tag2, and tag2 is part of the class for tag1,
then isn't this object in tag1's class?

The solution I found that yields the result that Joel is expecting is
to do the following (All of the code here):

  package test1 is
     type tag1 is tagged null record;
     function is_tag1 (object : in tag1) return boolean;
  end test1;

  package body test1 is
     function is_tag1 (object : in tag1) return boolean is
     begin
        return object in tag1'class;
     end is_tag1;
  end test1;

  with test1; use test1;
  package test2 is
     type tag2 is new tag1 with null record;
     function is_tag1 (object : in tag2) return boolean; <<< ADDED THIS
  end test2;

  with Ada.Tags;
  use type Ada.Tags.Tag;

  package body test2 is                                    <<< ADDED
THIS
     function is_tag1 (object : in tag2) return boolean is <<< ADDED
THIS
     begin                                                 <<< ADDED
THIS
       return object'tag = tag1'tag;                       <<< ADDED
THIS >>>
     end is_tag1;                                          <<< ADDED
THIS
  end test2;                                               <<< ADDED
THIS

  with text_io; use text_io;
  with test2; use test2;
  procedure testit is
     obj : tag2;
  begin
     if is_tag1(obj) then
        put_line("obj is tag1? I think not");          -- this happens
     else
        put_line("obj is NOT tag1, as it should be."); -- this doesn't
     end if;
  end testit;

This seems to work.  If Joel wants to have a subprogram that rejects
objects that aren't of tag1 type explicitly, then he should do the
above.