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 if (exists($Config{taint_support}) && !$Config{taint_support}) { 24 skip_all("built without taint support"); 25 } 26} 27 28use strict; 29use warnings; 30use Scalar::Util qw(tainted); 31 32$| = 1; 33 34plan tests => 4; 35 36watchdog(60); 37 38my $taint = substr($ENV{PATH}, 0, 0); # and empty tainted string 39 40{ 41 my $in = $taint . ( "ab" x 200_000 ); 42 utf8::upgrade($in); 43 ok(tainted($in), "performance issue only when tainted"); 44 while ($in =~ /\Ga+b/g) { } 45 pass("\\G on tainted string"); 46} 47 48# RT #130584 49# tainted string caused the utf8 pos cache to be cleared each time 50 51{ 52 my $repeat = 30_000; 53 my $in = $taint . ("abcdefghijklmnopqrstuvwxyz" x $repeat); 54 utf8::upgrade($in); 55 ok(tainted($in), "performance issue only when tainted"); 56 local ${^UTF8CACHE} = 1; # defeat debugging 57 for my $i (1..$repeat) { 58 $in =~ /abcdefghijklmnopqrstuvwxyz/g or die; 59 my $p = pos($in); # this was slow 60 } 61 pass("RT #130584 pos on tainted utf8 string"); 62} 63 641; 65