comp.lang.ada
 help / color / mirror / Atom feed
* Re: Membership test problem
@ 1996-10-04  0:00 Chris Sparks
  1996-10-05  0:00 ` Robert A Duff
  0 siblings, 1 reply; 8+ messages in thread
From: Chris Sparks @ 1996-10-04  0:00 UTC (permalink / raw)



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.




^ permalink raw reply	[flat|nested] 8+ messages in thread
* Membership test problem
@ 1996-10-03  0:00 Joel VanLaven
  1996-10-04  0:00 ` Robert A Duff
  1996-10-04  0:00 ` Brian R. Hanson
  0 siblings, 2 replies; 8+ messages in thread
From: Joel VanLaven @ 1996-10-03  0:00 UTC (permalink / raw)



  I ran into an interesting behavior, only to find that it seems to be
part of the LRM.  This is code that illustrates the problem :

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;
   end is_tag1;
end test1;

with test1; use test1;
package test2 is
   type tag2 is new tag1 with null record;
end test2;

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;


  The function is_tag1 is a primitive function of tag1, and so gets
inherited when tag2 is declared.  When called with an object of type
tag2, is_tag1 does a membership test that returns a true (!).  This
is because of 4.5.2:30 which says: (bracketed is mine)

  The tested type is not scalar, [it is] and the value of the
simple_expression satisfies an constraints of the named subtype,
[there are none], and, if the type of the simple_expression is class-wide,
[it is not] the value has a tag that identifies a type covered by the
tested type.

  The problem is that because the function is inherited, object can be
of any type derived from tag1, ie any element of tag1'class.  So, I
think that the meaning of the test should be preserved in this case as
being a tag check.  This would only have to be for inherited subprograms
of course.  Perhaps primitive functions should in part be considered to
operate on tag_t'class (internally) rather than on tag_t as that is really
what they are doing.
-- 
-- Joel VanLaven




^ permalink raw reply	[flat|nested] 8+ messages in thread

end of thread, other threads:[~1996-10-09  0:00 UTC | newest]

Thread overview: 8+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
1996-10-04  0:00 Membership test problem Chris Sparks
1996-10-05  0:00 ` Robert A Duff
1996-10-06  0:00   ` Joel VanLaven
1996-10-07  0:00     ` Tucker Taft
1996-10-09  0:00       ` Joel VanLaven
  -- strict thread matches above, loose matches on Subject: below --
1996-10-03  0:00 Joel VanLaven
1996-10-04  0:00 ` Robert A Duff
1996-10-04  0:00 ` Brian R. Hanson

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox