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