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
|
#!perl
use strict;
use warnings;
use Test::More tests => 8;
use Scalar::Util qw[refaddr];
BEGIN {
use_ok('Unicode::UTF8', qw[ decode_utf8
encode_utf8 ]);
}
{
my %foo;
# First two tests is for a bug in Perl <= 5.14.2
# https://rt.perl.org/rt3/Public/Bug/Display.html?id=91844
# http://perl5.git.perl.org/perl.git/commitdiff/3ed94dc04bd73c95
$foo{bar} = 'baz';
for my $x ($foo{bar}) {
my $r1 = \decode_utf8 sub { delete $foo{bar} }->();
my $r2 = \$x;
isnt $r1, $r2, 'result of delete(helem) is copied when returned';
}
$foo{bar} = 'baz';
for my $x ($foo{bar}) {
my $r1 = \decode_utf8 sub { return delete $foo{bar} }->();
my $r2 = \$x;
isnt $r1, $r2, 'result of delete(helem) is copied when explicitly returned'
}
SKIP: {
# http://search.cpan.org/dist/perl-5.17.10/pod/perldelta.pod#Internal_Changes
# https://metacpan.org/module/DAGOLDEN/perl-5.19.1/pod/perldelta.pod#Internal-Changes
skip 'New copy-on-write mechanism', 5 if (($] >= 5.017007 && $] <= 5.017009) || $] >= 5.019000);
$foo{bar} = 'baz';
{
my $r1 = refaddr \$foo{bar};
my $r2 = refaddr \decode_utf8 delete $foo{bar};
is($r1, $r2, "decode_utf8 delete(helem) (native) is resued");
}
$foo{bar} = "Foo \xE2\x98\xBA";
{
my $r1 = refaddr \$foo{bar};
my $r2 = refaddr \decode_utf8 delete $foo{bar};
is($r1, $r2, "decode_utf8 delete(helem) (UTF-8) is resued");
}
utf8::upgrade($foo{bar} = "Foo \xE2\x98\xBA");
{
my $r1 = refaddr \$foo{bar};
my $r2 = refaddr \decode_utf8 delete $foo{bar};
is($r1, $r2, "decode_utf8 delete(helem) (upgraded UTF-8) is resued");
}
$foo{bar} = 'baz';
{
my $r1 = refaddr \$foo{bar};
my $r2 = refaddr \encode_utf8 delete $foo{bar};
is($r1, $r2, "encode_utf8 delete(helem) (native) is resued");
}
$foo{bar} = decode_utf8 "Foo \xE2\x98\xBA";
{
my $r1 = refaddr \$foo{bar};
my $r2 = refaddr \encode_utf8 delete $foo{bar};
is($r1, $r2, "encode_utf8 delete(helem) (UTF-8) is resued");
}
}
}
|
