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