t/re/speed.t

   1 #!./perl
   2 #
   3 # This is a home for regular expression tests that don't fit into
   4 # the format supported by re/regexp.t, that specifically should run fast.
   5 #
   6 # All the tests in this file are ones that run exceptionally slowly
   7 # (each test taking seconds or even minutes) in the absence of particular
   8 # optimisations. Thus it is a sort of canary for optimisations being
   9 # broken.
  10 #
  11 # Although it includes a watchdog timeout, this is set to a generous limit
  12 # to allow for running on slow systems; therefore a broken optimisation
  13 # might be indicated merely by this test file taking unusually long to
  14 # run, rather than actually timing out.
  15 #
  16
  17 use strict;
  18 use warnings;
  19 use 5.010;
  20
  21 sub run_tests;
  22
  23 $| = 1;
  24
  25
  26 BEGIN {
  27     chdir 't' if -d 't';
  28     @INC = ('../lib','.','../ext/re');
  29     require Config; import Config;
  30     require './test.pl';
  31     skip_all('no re module') unless defined &DynaLoader::boot_DynaLoader;
  32     skip_all_without_unicode_tables();
  33 }
  34
  35 plan tests => 9;  # Update this when adding/deleting tests.
  36
  37 run_tests() unless caller;
  38
  39 #
  40 # Tests start here.
  41 #
  42 sub run_tests {
  43
  44
  45     watchdog(($::running_as_thread && $::running_as_thread) ? 50 : 75);
  46
  47     {
  48         # [perl #120446]
  49         # this code should be virtually instantaneous. If it takes 10s of
  50         # seconds, there a bug in intuit_start.
  51         # (this test doesn't actually test for slowness - that involves
  52         # too much danger of false positives on loaded machines - but by
  53         # putting it here, hopefully someone might notice if it suddenly
  54         # runs slowly)
  55         my $s = ('a' x 1_000_000) . 'b';
  56         my $i = 0;
  57         for (1..10_000) {
  58             pos($s) = $_;
  59             $i++ if $s =~/\Gb/g;
  60         }
  61         is($i, 0, "RT 120446: mustn't run slowly");
  62     }
  63
  64     {
  65         # [perl #120692]
  66         # these tests should be virtually instantaneous. If they take 10s of
  67         # seconds, there's a bug in intuit_start.
  68
  69         my $s = 'ab' x 1_000_000;
  70         utf8::upgrade($s);
  71         1 while $s =~ m/\Ga+ba+b/g;
  72         pass("RT#120692 \\G mustn't run slowly");
  73
  74         $s=~ /^a{1,2}x/ for  1..10_000;
  75         pass("RT#120692 a{1,2} mustn't run slowly");
  76
  77         $s=~ /ab.{1,2}x/;
  78         pass("RT#120692 ab.{1,2} mustn't run slowly");
  79
  80         $s = "-a-bc" x 250_000;
  81         $s .= "1a1bc";
  82         utf8::upgrade($s);
  83         ok($s =~ /\da\d{0,30000}bc/, "\\d{30000}");
  84
  85         $s = "-ab\n" x 250_000;
  86         $s .= "abx";
  87         ok($s =~ /^ab.*x/m, "distant float with /m");
  88
  89         my $r = qr/^abcd/;
  90         $s = "abcd-xyz\n" x 500_000;
  91         $s =~ /$r\d{1,2}xyz/m for 1..200;
  92         pass("BOL within //m  mustn't run slowly");
  93
  94         $s = "abcdefg" x 1_000_000;
  95         $s =~ /(?-m:^)abcX?fg/m for 1..100;
  96         pass("BOL within //m  mustn't skip absolute anchored check");
  97
  98         $s = "abcdefg" x 1_000_000;
  99         $s =~ /^XX\d{1,10}cde/ for 1..100;
 100         pass("abs anchored float string should fail quickly");
 101
 102     }
 103
 104 } # End of sub run_tests
 105
 106 1;