File: ctor.t

package info (click to toggle)
libclass-contract-perl 1.14-9
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, forky, sid, trixie
  • size: 220 kB
  • sloc: perl: 1,434; makefile: 10
file content (84 lines) | stat: -rw-r--r-- 2,039 bytes parent folder | download | duplicates (6)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
# This script should be runnable with 'make test'.

######################### We start with some black magic to print on failure.

BEGIN { $| = 1 }
END { print "not ok 1\n"  unless $loaded }

use lib qw( ./t );
use Magic;

use Class::Contract;
$loaded = 1;
print "ok 1\n";

######################### End of black magic.
# alpha, bravo, charlie, delta, echo, foxtrot, 
# golf, hotel, india, juliett, kilo, lima, mike,
# november, oscar, papa, quebec, romeo, sierra,
# tango, uniform, victor, whiskey, xray, yankee, zulu
::ok('desc'   => "ctor initialization left-most depth-first order",
     'expect' => 1,
     'code'   => <<'CODE');
package Alpha;
use Class::Contract;
contract { ctor 'new'; impl { push @::test, 'A'; $::test{'A'} = [@_] } };

package Bravo;
use Class::Contract;
contract {
  inherits 'Alpha';
  ctor 'new';
    impl { push @::test, 'B'; $::test{'B'} = [@_] }
};

package Charlie; use Class::Contract;
contract {
  inherits 'Alpha';
  ctor 'new';
    impl { push @::test, 'C'; $::test{'C'} = [@_] };
};

package Delta;
use Class::Contract;
contract { ctor 'new'; impl { push @::test, 'D'; $::test{'D'} = [@_] } };

package Echo;
use Class::Contract;
contract {
  inherits 'Delta';
  ctor 'new';
    impl { push @::test, 'E'; $::test{'E'} = [@_] };
};

package Foxtrot;
use Class::Contract;
contract {
  inherits qw( Bravo Charlie Echo );
  ctor 'new';
    impl { push @::test, 'F'; $::test{'F'} = [@_] };
};

package main;
(@::test, %::test) = ();
{ my $foo = Foxtrot->new; }
join('', @::test) eq 'ABCDEF' ? 1 : 0;
CODE

::ok('desc'   => "Can't use ctor from class with abstract methods",
     'expect' => qr/^Class \w+ has abstract methods. Can\'t create \w+ object/,
     'code'   => <<'CODE');
package Abstract; use Class::Contract; contract { abstract method 'foo' };
Abstract->new();
CODE

::ok('desc'   => "ctor initialization pre post impl done right",
     'expect' => 1,
     'code'   => <<'CODE');
#fixme
1;
CODE

1;
__END__