-
Notifications
You must be signed in to change notification settings - Fork 135
/
sub-ref.t
120 lines (98 loc) · 3.63 KB
/
sub-ref.t
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
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
use v6;
use Test;
# L<S02/"Built-In Data Types"/Perl 6>
plan 34;
=begin description
These tests test subroutine references and their invocation.
See L<S02/"Built-in Data Types"> for more information about Code, Routine, Sub, Block, etc.
=end description
# Quoting A06:
# Code
# ____________|________________
# | |
# Routine Block
# ________________|_______________
# | | | | | |
# Sub Method Submethod Multi Rule Macro
{
my $foo = sub () { 42 };
isa_ok($foo, Code);
isa_ok($foo, Routine);
isa_ok($foo, Sub);
is $foo.(), 42, "basic invocation of an anonymous sub";
dies_ok { $foo.(23) }, "invocation of a parameterless anonymous sub with a parameter dies";
}
{
my $foo = -> { 42 };
isa_ok($foo, Code);
isa_ok($foo, Block);
is $foo.(), 42, "basic invocation of a pointy block";
dies_ok { $foo.(23) }, "invocation of a parameterless pointy block with a parameter dies";
}
{
my $foo = { 100 + $^x };
isa_ok($foo, Code);
isa_ok($foo, Block);
is $foo.(42), 142, "basic invocation of a pointy block with a param";
dies_ok { $foo.() }, "invocation of a parameterized block expecting a param without a param dies";
}
# RT #63974
#?pugs skip 'No compatible multi variant found: "$c"'
{
my $topic = 'topic unchanged';
my @topic_array = <topic array unchanged>;
my $c = { $topic = $_; @topic_array = @_ };
$c( 2, 3, 4, 5 );
#?rakudo 2 todo 'RT 63974'
#?niecza 2 todo
is $topic, 2, '$_ got right value for code ref';
is @topic_array, ( 3, 4, 5 ), '@_ got right value in code ref';
}
{
my $foo = sub { 100 + (@_[0] // -1) };
isa_ok($foo, Code);
isa_ok($foo, Routine);
isa_ok($foo, Sub);
is $foo.(42), 142, "basic invocation of a perl5-like anonymous sub (1)";
is $foo.(), 99, "basic invocation of a perl5-like anonymous sub (2)";
}
{
my $foo = sub ($x) { 100 + $x };
isa_ok($foo, Code);
isa_ok($foo, Routine);
isa_ok($foo, Sub);
is $foo.(42), 142, "calling an anonymous sub with a positional param";
dies_ok { $foo.() },
"calling an anonymous sub expecting a param without a param dies";
dies_ok { $foo.(42, 5) },
"calling an anonymous sub expecting one param with two params dies";
}
# Confirmed by p6l, see thread "Anonymous macros?" by Ingo Blechschmidt
# L<"http://www.nntp.perl.org/group/perl.perl6.language/21825">
#?rakudo skip 'macros, compile time binding'
#?niecza skip 'macros NYI'
{
# We do all this in a eval() not because the code doesn't parse,
# but because it's safer to only call macro references at compile-time.
# So we'd need to wrap the code in a BEGIN {...} block. But then, our test
# code would be called before all the other tests, causing confusion. :)
# So, we wrap the code in a eval() with an inner BEGIN.
# (The macros are subject to MMD thing still needs to be fleshed out, I
# think.)
our &foo_macro ::= macro ($x) { "1000 + $x" };
isa_ok(&foo_macro, Code);
isa_ok(&foo_macro, Routine);
#?pugs todo 'macros'
isa_ok(&foo_macro, Macro);
is foo_macro(3), 1003, "anonymous macro worked";
}
{
my $mkinc = sub { my $x = 0; return sub { $x++ }; };
my $inc1 = $mkinc();
my $inc2 = $mkinc();
is($inc1(), 0, "closures: inc1 == 0");
is($inc1(), 1, "closures: inc1 == 1");
is($inc2(), 0, "closures: inc2 == 0");
is($inc2(), 1, "closures: inc2 == 1");
}
# vim: ft=perl6