t/oo/inheritance.t

   1 #! parrot
   2 # Copyright (C) 2008, Parrot Foundation.
   3 # $Id$
   4
   5 =head1 NAME
   6
   7 t/oo/removeparent.t - Test OO inheritance
   8
   9 =head1 SYNOPSIS
  10
  11     % prove t/oo/removeparent.t
  12
  13 =head1 DESCRIPTION
  14
  15 Tests OO features related to the removeparent opcode.
  16
  17 =cut
  18
  19 .sub main :main
  20     .include 'test_more.pir'
  21
  22     plan(4)
  23
  24     remove_1()
  25     remove_2()
  26     remove_Y()
  27     remove_diamond()
  28 .end
  29
  30 .sub remove_1
  31     $P1 = newclass "Foo"
  32     $P2 = newclass "Bar"
  33     $I1 = isa $P2, $P1
  34     if $I1, fail
  35     addparent $P2, $P1
  36     $I1 = isa $P2, $P1
  37     unless $I1, fail
  38     removeparent $P2, $P1
  39     $I1 = isa $P2, $P1
  40     if $I1, fail
  41     $I1 = 1
  42     ok( $I1, 'simple')
  43 fail:
  44 .end
  45
  46 .sub remove_2
  47     $P1 = newclass "Foo2_1"
  48     $P2 = newclass "Foo2_2"
  49     $P3 = newclass "Bar2"
  50     $I1 = isa $P3, $P1
  51     if $I1, fail
  52     $I1 = isa $P3, $P2
  53     if $I1, fail
  54     addparent $P3, $P1
  55     $I1 = isa $P3, $P1
  56     unless $I1, fail
  57     $I1 = isa $P3, $P2
  58     if $I1, fail
  59     addparent $P3, $P2
  60     $I1 = isa $P3, $P2
  61     unless $I1, fail
  62     removeparent $P3, $P1
  63     $I1 = isa $P3, $P1
  64     if $I1, fail
  65     $I1 = isa $P3, $P2
  66     unless $I1, fail
  67     removeparent $P3, $P2
  68     $I1 = isa $P3, $P1
  69     if $I1, fail
  70     $I1 = isa $P3, $P2
  71     if $I1, fail
  72     $I1 = 1
  73     ok( $I1, 'multiple')
  74 fail:
  75 .end
  76
  77 .sub remove_Y
  78     $P1 = newclass "FooY_1"
  79     $P2 = newclass "FooY_2"
  80     $P3 = newclass "BarY_1"
  81     $P4 = newclass "BarY_2"
  82     addparent $P3, $P1
  83     addparent $P3, $P2
  84     $I1 = isa $P4, $P1
  85     if $I1, fail
  86     $I1 = isa $P4, $P2
  87     if $I1, fail
  88     addparent $P4, $P3
  89     $I1 = isa $P4, $P1
  90     unless $I1, fail
  91     $I1 = isa $P4, $P2
  92     unless $I1, fail
  93     removeparent $P4, $P3
  94     $I1 = isa $P4, $P1
  95     if $I1, fail
  96     $I1 = isa $P4, $P2
  97     if $I1, fail
  98     $I1 = 1
  99     ok( $I1, 'Y')
 100 fail:
 101 .end
 102
 103 .sub remove_diamond
 104     $P1 = newclass "FooD1"
 105     $P2 = newclass "FooD2"
 106     $P3 = newclass "FooD3"
 107     $P4 = newclass "BarD1"
 108     addparent $P2, $P1
 109     addparent $P3, $P1
 110     addparent $P4, $P2
 111     addparent $P4, $P3
 112     $I1 = isa $P4, $P1
 113     unless $I1, fail
 114     removeparent $P4, $P2
 115     $I1 = isa $P4, $P1
 116     unless $I1, fail
 117     removeparent $P4, $P3
 118     $I1 = isa $P4, $P1
 119     if $I1, fail
 120     $I1 = 1
 121     ok( $I1, 'diamond')
 122 fail:
 123 .end