t/zzzzzzz_perl_perf_bug.t

   1 BEGIN { do "./t/lib/ANFANG.pm" or die ( $@ || $! ) }
   2
   3 use strict;
   4 use warnings;
   5 use Test::More;
   6
   7
   8 BEGIN {
   9   delete $ENV{DBIC_ASSERT_NO_ERRONEOUS_METAINSTANCE_USE};
  10
  11   plan skip_all =>
  12     'Skipping RH perl performance bug tests as DBIC_NO_WARN_BAD_PERL set'
  13     if ( $ENV{DBIC_NO_WARN_BAD_PERL} );
  14
  15   require DBICTest::RunMode;
  16   plan skip_all => 'Skipping as system appears to be a smoker'
  17     if DBICTest::RunMode->is_smoker;
  18 }
  19
  20 # globalllock so that the test runs alone
  21 use DBICTest ':GlobalLock';
  22
  23 use Benchmark;
  24
  25 # This is a rather unusual test.
  26 # It does not test any aspect of DBIx::Class, but instead tests the
  27 # perl installation this is being run under to see if it is:-
  28 #  1. Potentially affected by a RH perl build bug
  29 #  2. If so we do a performance test for the effect of
  30 #     that bug.
  31 #
  32 # You can skip these tests by setting the DBIC_NO_WARN_BAD_PERL env
  33 # variable
  34 #
  35 # If these tests fail then please read the section titled
  36 # Perl Performance Issues on Red Hat Systems in
  37 # L<DBIx::Class::Manual::Troubleshooting>
  38
  39 # we do a benchmark test filling an array with blessed/overloaded references,
  40 # against an array filled with array refs.
  41 # On a sane system the ratio between these operation sets is 1 - 1.5,
  42 # whereas a bugged system gives a ratio of around 8
  43 # we therefore consider there to be a problem if the ratio is >= $fail_ratio
  44 my $fail_ratio = 3;
  45
  46 ok( $fail_ratio, "Testing for a blessed overload slowdown >= ${fail_ratio}x" );
  47
  48
  49 my $results = timethese(
  50     -1,    # run for 1 WALL second each
  51     {
  52         no_bless => sub {
  53             my %h;
  54             for ( my $i = 0 ; $i < 10000 ; $i++ ) {
  55                 $h{$i} = [];
  56             }
  57         },
  58         bless_overload => sub {
  59             use overload q(<) => sub { };
  60             my %h;
  61             for ( my $i = 0 ; $i < 10000 ; $i++ ) {
  62                 $h{$i} = bless [] => 'main';
  63             }
  64         },
  65     },
  66 );
  67
  68 my $ratio = $results->{no_bless}->iters / $results->{bless_overload}->iters;
  69
  70 cmp_ok( $ratio, '<', $fail_ratio, 'Overload/bless performance acceptable' )
  71   || diag(
  72     "\n",
  73     "This perl has a substantial slow down when handling large numbers\n",
  74     "of blessed/overloaded objects.  This can severely adversely affect\n",
  75     "the performance of DBIx::Class programs.  Please read the section\n",
  76     "in the Troubleshooting POD documentation entitled\n",
  77     "'Perl Performance Issues on Red Hat Systems'\n",
  78     "As this is an extremely serious condition, the only way to skip\n",
  79     "over this test is to --force the installation, or to look in the test\n",
  80     "file " . __FILE__ . "\n",
  81   );
  82
  83 # We will only check for the difference in bless handling (whether the
  84 # bless applies to the reference or the referent) if we have seen a
  85 # performance issue...
  86
  87 SKIP: {
  88     skip "Not checking for bless handling as performance is OK", 1
  89       if Test::Builder->new->is_passing;
  90
  91     {
  92         package    # don't want this in PAUSE
  93           TestRHBug;
  94         use overload bool => sub { 0 }
  95     }
  96
  97     sub _has_bug_34925 {
  98         my %thing;
  99         my $r1 = \%thing;
 100         my $r2 = \%thing;
 101         bless $r1 => 'TestRHBug';
 102         return !!$r2;
 103     }
 104
 105     sub _possibly_has_bad_overload_performance {
 106         return( "$]" < 5.008009 and !_has_bug_34925() );
 107     }
 108
 109     # If this next one fails then you almost certainly have a RH derived
 110     # perl with the performance bug
 111     # if this test fails, look at the section titled
 112     # "Perl Performance Issues on Red Hat Systems" in
 113     # L<DBIx::Class::Manual::Troubleshooting>
 114     # Basically you may suffer severe performance issues when running
 115     # DBIx::Class (and many other) modules.  Look at getting a fixed
 116     # version of the perl interpreter for your system.
 117     #
 118     ok( !_possibly_has_bad_overload_performance(),
 119         'Checking whether bless applies to reference not object' )
 120       || diag(
 121         "\n",
 122         "This perl is probably derived from a buggy Red Hat perl build\n",
 123         "Please read the section in the Troubleshooting POD documentation\n",
 124         "entitled 'Perl Performance Issues on Red Hat Systems'\n",
 125         "As this is an extremely serious condition, the only way to skip\n",
 126         "over this test is to --force the installation, or to look in the test\n",
 127         "file " . __FILE__ . "\n",
 128       );
 129 }
 130
 131 done_testing;