Commit | Line | Data |
---|---|---|
c45bec60 | 1 | #!./perl -w |
fa421ef9 CS |
2 | # Test for malfunctions of utf8 cache |
3 | ||
4 | BEGIN { | |
5 | chdir 't' if -d 't'; | |
6 | @INC = '../lib'; | |
c45bec60 NC |
7 | require './test.pl'; |
8 | skip_all_without_dynamic_extension('Devel::Peek'); | |
fa421ef9 CS |
9 | } |
10 | ||
c45bec60 NC |
11 | use strict; |
12 | ||
88621eaf | 13 | plan(tests => 2); |
fa421ef9 CS |
14 | |
15 | my $pid = open CHILD, '-|'; | |
16 | die "kablam: $!\n" unless defined $pid; | |
17 | unless ($pid) { | |
18 | open STDERR, ">&STDOUT"; | |
19 | $a = "hello \x{1234}"; | |
20 | for (1..2) { | |
21 | bar(substr($a, $_, 1)); | |
22 | } | |
23 | sub bar { | |
24 | $_[0] = "\x{4321}"; | |
25 | Devel::Peek::Dump($_[0]); | |
26 | } | |
27 | exit; | |
28 | } | |
29 | ||
30 | { local $/; $_ = <CHILD> } | |
31 | ||
32 | my $utf8magic = qr{ ^ \s+ MAGIC \s = .* \n | |
33 | \s+ MG_VIRTUAL \s = .* \n | |
34 | \s+ MG_TYPE \s = \s PERL_MAGIC_utf8 .* \n | |
35 | \s+ MG_LEN \s = .* \n }xm; | |
36 | ||
c45bec60 | 37 | unlike($_, qr{ $utf8magic $utf8magic }x); |
88621eaf DM |
38 | |
39 | # With bad caching, this code used to go quadratic and take 10s of minutes. | |
40 | # The 'test' in this case is simply that it doesn't hang. | |
41 | ||
42 | { | |
43 | local ${^UTF8CACHE} = 1; # enable cache, disable debugging | |
44 | my $x = "\x{100}" x 1000000; | |
45 | while ($x =~ /./g) { | |
46 | my $p = pos($x); | |
47 | } | |
48 | pass("quadratic pos"); | |
49 | } |