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
85
86
87
88
89
90
91
92
93
94
95
|
#!/usr/bin/perl
use strict;
use warnings;
use Test::More;
# Skip the test before Method::Signatures can try to compile it and blow up.
BEGIN {
plan skip_all => "Perl 5.10 or higher required to test where constraints" if $] < 5.010;
}
{
package Stuff;
use Test::More;
use Method::Signatures;
method add($this //= 23, $that //= 42) {
return $this + $that;
}
method minus($this is ro //= 23, $that is ro //= 42) {
return $this - $that;
}
is( Stuff->add(), 23 + 42 );
is( Stuff->add(undef), 23 + 42 );
is( Stuff->add(99), 99 + 42 );
is( Stuff->add(2,3), 5 );
is( Stuff->minus(), 23 - 42 );
is( Stuff->minus(undef), 23 - 42 );
is( Stuff->minus(99), 99 - 42 );
is( Stuff->minus(2, 3), 2 - 3 );
# Test again that undef doesn't override defaults
method echo($message //= "what?") {
return $message
}
is( Stuff->echo(), "what?" );
is( Stuff->echo(undef), "what?" );
is( Stuff->echo("who?"), 'who?' );
# Test that you can reference earlier args in a default
method copy_cat($this, $that //= $this) {
return $that;
}
is( Stuff->copy_cat("wibble"), "wibble" );
is( Stuff->copy_cat("wibble", undef), "wibble" );
is( Stuff->copy_cat(23, 42), 42 );
}
{
package Bar;
use Test::More;
use Method::Signatures;
method hello($msg //= "Hello, world!") {
return $msg;
}
is( Bar->hello, "Hello, world!" );
is( Bar->hello(undef), "Hello, world!" );
is( Bar->hello("Greetings!"), "Greetings!" );
method hi($msg //= q,Hi,) {
return $msg;
}
is( Bar->hi, "Hi" );
is( Bar->hi(undef), "Hi" );
is( Bar->hi("Yo"), "Yo" );
method list(@args = (1,2,3) when ()) {
return @args;
}
is_deeply [Bar->list()], [1,2,3];
method code($num, $code //= sub { $num + 2 }) {
return $code->();
}
is( Bar->code(42), 44 );
}
done_testing;
|
