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
|
#!./perl
BEGIN {
chdir 't' if -d 't';
require './test.pl';
set_up_inc('../lib');
}
use strict;
use warnings;
package FetchStoreCounter {
sub new { my $class = shift; return bless [@_], $class }
sub TIESCALAR { return shift->new(@_) }
sub FETCH { ${shift->[0]}++ }
sub STORE { ${shift->[1]}++ }
}
# booleans
{
use builtin qw( true false isbool );
ok(true, 'true is true');
ok(!false, 'false is false');
ok(isbool(true), 'true is bool');
ok(isbool(false), 'false is bool');
ok(!isbool(undef), 'undef is not bool');
ok(!isbool(1), '1 is not bool');
ok(!isbool(""), 'empty is not bool');
my $truevar = (5 == 5);
my $falsevar = (5 == 6);
ok(isbool($truevar), '$truevar is bool');
ok(isbool($falsevar), '$falsevar is bool');
ok(isbool(isbool(true)), 'isbool true is bool');
ok(isbool(isbool(123)), 'isbool false is bool');
# Invokes magic
tie my $tied, FetchStoreCounter => (\my $fetchcount, \my $storecount);
my $_dummy = isbool($tied);
is($fetchcount, 1, 'isbool() invokes FETCH magic');
$tied = isbool(false);
is($storecount, 1, 'isbool() TARG invokes STORE magic');
}
# weakrefs
{
use builtin qw( isweak weaken unweaken );
my $arr = [];
my $ref = $arr;
ok(!isweak($ref), 'ref is not weak initially');
weaken($ref);
ok(isweak($ref), 'ref is weak after weaken()');
unweaken($ref);
ok(!isweak($ref), 'ref is not weak after unweaken()');
weaken($ref);
undef $arr;
ok(!defined $ref, 'ref is now undef after arr is cleared');
}
# imports are lexical; should not be visible here
{
my $ok = eval 'true()'; my $e = $@;
ok(!$ok, 'true() not visible outside of lexical scope');
like($e, qr/^Undefined subroutine &main::true called at /, 'failure from true() not visible');
}
# lexical imports work fine in a variety of situations
{
sub regularfunc {
use builtin 'true';
return true;
}
ok(regularfunc(), 'true in regular sub');
my sub lexicalfunc {
use builtin 'true';
return true;
}
ok(lexicalfunc(), 'true in lexical sub');
my $coderef = sub {
use builtin 'true';
return true;
};
ok($coderef->(), 'true in anon sub');
sub recursefunc {
use builtin 'true';
return recursefunc() if @_;
return true;
}
ok(recursefunc("rec"), 'true in self-recursive sub');
my $recursecoderef = sub {
use feature 'current_sub';
use builtin 'true';
return __SUB__->() if @_;
return true;
};
ok($recursecoderef->("rec"), 'true in self-recursive anon sub');
}
done_testing();
|
