1#!./perl -T 2# 3# All the tests in this file are ones that run exceptionally slowly 4# (each test taking seconds or even minutes) in the absence of particular 5# optimisations. Thus it is a sort of canary for optimisations being 6# broken. 7# 8# Although it includes a watchdog timeout, this is set to a generous limit 9# to allow for running on slow systems; therefore a broken optimisation 10# might be indicated merely by this test file taking unusually long to 11# run, rather than actually timing out. 12# 13# This is similar to t/perf/speed.t but tests performance regressions specific 14# to taint. 15# 16 17BEGIN { 18 chdir 't' if -d 't'; 19 @INC = ('../lib'); 20 require Config; import Config; 21 require './test.pl'; 22 skip_all_if_miniperl("No Scalar::Util under miniperl"); 23} 24 25use strict; 26use warnings; 27use Scalar::Util qw(tainted); 28 29$| = 1; 30 31plan tests => 4; 32 33watchdog(60); 34 35my $taint = substr($ENV{PATH}, 0, 0); # and empty tainted string 36 37{ 38 my $in = $taint . ( "ab" x 200_000 ); 39 utf8::upgrade($in); 40 ok(tainted($in), "performance issue only when tainted"); 41 while ($in =~ /\Ga+b/g) { } 42 pass("\\G on tainted string"); 43} 44 45# RT #130584 46# tainted string caused the utf8 pos cache to be cleared each time 47 48{ 49 my $repeat = 30_000; 50 my $in = $taint . ("abcdefghijklmnopqrstuvwxyz" x $repeat); 51 utf8::upgrade($in); 52 ok(tainted($in), "performance issue only when tainted"); 53 local ${^UTF8CACHE} = 1; # defeat debugging 54 for my $i (1..$repeat) { 55 $in =~ /abcdefghijklmnopqrstuvwxyz/g or die; 56 my $p = pos($in); # this was slow 57 } 58 pass("RT #130584 pos on tainted utf8 string"); 59} 60 611; 62