1# This script should be runnable with 'make test'. 2 3######################### We start with some black magic to print on failure. 4 5BEGIN { $| = 1 } 6END { print "not ok 1\n" unless $loaded } 7 8use lib qw( ./t ); 9use Magic; 10 11use Class::Contract; 12$loaded = 1; 13print "ok 1\n"; 14 15######################### End of black magic. 16::ok('desc' => "dtor initialization right-most derived-first order", 17 'expect' => 1, 18 'code' => <<'CODE'); 19package Alpha; 20use Class::Contract; 21contract { 22 dtor; 23 impl { 24 $::order{ref(&self)||&self} .= 'A'; 25 $::args{ref(&self)||&self}->{'A'} = [@_] 26 }; 27}; 28 29package Bravo; 30use Class::Contract; 31contract { 32 inherits 'Alpha'; 33 dtor; 34 impl { 35 $::order{ref(&self)||&self} .= 'B'; 36 $::args{ref(&self)||&self}->{'B'}=[@_] 37 }; 38}; 39 40package Charlie; use Class::Contract; 41contract { 42 inherits 'Alpha'; 43 dtor; 44 impl { 45 $::order{ref(&self)||&self} .= 'C'; 46 $::args{ref(&self)||&self}->{'C'}=[@_] 47 }; 48}; 49 50package Delta; 51use Class::Contract; 52contract { 53 dtor; 54 impl { 55 $::order{ref(&self)||&self} .= 'D'; 56 $::args{ref(&self)||&self}->{'D'} = [@_]; 57 }; 58}; 59 60package Echo; 61use Class::Contract; 62contract { 63 attr 'foobar'; 64 inherits 'Delta'; 65 dtor; 66 impl { 67 $::order{ref(&self)||&self} .= 'E'; 68 $::args{ref(&self)||&self}->{'E'} = [@_] 69 }; 70}; 71 72package Foxtrot; 73use Class::Contract; 74contract { 75 inherits qw( Bravo Charlie Echo ); 76 dtor; 77 impl { 78 $::order{ref(&self)||&self} .= 'F'; 79 $::args{ref(&self)||&self}->{'F'} = [@_] 80 }; 81}; 82 83package main; 84(%::order, %::args) = (); 85{ my $foo = Foxtrot->new; } 86$::order{'Foxtrot'} eq 'FEDCBA' ? 1 : 0; 87CODE 88 891; 90__END__ 91 92