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
index df04f54..f8698c8 100644 (file)
@@ -1,17 +1,18 @@
-#!./perl
+#!./perl -w
 # Test for malfunctions of utf8 cache
 
 BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
+    require './test.pl';
 }
 
-unless (eval { require Devel::Peek }) {
-    print "# Without Devel::Peek, never mind\n";
-    print "1..0\n";
-    exit;
-}
-print "1..1\n";
+use strict;
+
+plan(tests => 2);
+
+SKIP: {
+skip_without_dynamic_extension("Devel::Peek");
 
 my $pid = open CHILD, '-|';
 die "kablam: $!\n" unless defined $pid;
@@ -35,7 +36,18 @@ my $utf8magic = qr{ ^ \s+ MAGIC \s = .* \n
                       \s+ MG_TYPE \s = \s PERL_MAGIC_utf8 .* \n
                       \s+ MG_LEN \s = .* \n }xm;
 
-if (m{ $utf8magic $utf8magic }x) {
-    print "not ";
+unlike($_, qr{ $utf8magic $utf8magic }x);
+
+} # SKIP
+
+# With bad caching, this code used to go quadratic and take 10s of minutes.
+# The 'test' in this case is simply that it doesn't hang.
+
+{
+    local ${^UTF8CACHE} = 1; # enable cache, disable debugging
+    my $x = "\x{100}" x 1000000;
+    while ($x =~ /./g) {
+       my $p = pos($x);
+    }
+    pass("quadratic pos");
 }
-print "ok 1\n";