Commit | Line | Data |
dc253b77 |
1 | #!/usr/bin/perl |
2 | use strict; |
3 | use warnings; |
4 | use Test::More; |
5 | use lib qw(t/lib); |
dc253b77 |
6 | |
7 | # This is a rather unusual test. |
8 | # It does not test any aspect of DBIx::Class, but instead tests the |
9 | # perl installation this is being run under to see if it is:- |
10 | # 1. Potentially affected by a RH perl build bug |
11 | # 2. If so we do a performance test for the effect of |
12 | # that bug. |
13 | # |
14 | # You can skip these tests by setting the DBIC_NO_WARN_BAD_PERL env |
15 | # variable |
16 | # |
17 | # If these tests fail then please read the section titled |
c13fabce |
18 | # Perl Performance Issues on Red Hat Systems in |
dc253b77 |
19 | # L<DBIx::Class::Manual::Troubleshooting> |
20 | |
21 | plan skip_all => |
22 | 'Skipping RH perl performance bug tests as DBIC_NO_WARN_BAD_PERL set' |
23 | if ( $ENV{DBIC_NO_WARN_BAD_PERL} ); |
24 | |
25 | eval "use Benchmark"; |
26 | plan skip_all => 'needs Benchmark for testing' if $@; |
27 | |
28 | plan tests => 2; |
29 | |
30 | { |
31 | package # don't want this in PAUSE |
32 | TestRHBug; |
33 | use overload bool => sub { 0 } |
34 | } |
35 | |
36 | sub _has_bug_34925 { |
37 | my %thing; |
38 | my $r1 = \%thing; |
39 | my $r2 = \%thing; |
40 | bless $r1 => 'TestRHBug'; |
41 | return !!$r2; |
42 | } |
43 | |
44 | sub _possibly_has_bad_overload_performance { |
45 | return $] < 5.008009 && !_has_bug_34925(); |
46 | } |
47 | |
ec63d168 |
48 | # If the test here fails, you are running a 5.88 or older perl which |
49 | # has been patched to correct for an issue with bless/overload, but |
50 | # which *might* be susceptable to a severe performance issue caused |
51 | # by a partial fix. The performance issue is tested for in the second |
52 | # test. |
53 | # If *this* test fails, but the other test is OK, then you have a fixed |
54 | # perl and no need to worry. |
dc253b77 |
55 | ok( !_possibly_has_bad_overload_performance(), |
56 | 'Checking not susceptable to bless/overload performance problem' ); |
57 | |
58 | my $results = timethese( |
c13fabce |
59 | -1, # run for 1 CPU second each |
dc253b77 |
60 | { |
61 | overload => sub { |
62 | use overload q(<) => sub { }; |
63 | my %h; |
64 | for ( my $i = 0 ; $i < 5000 ; $i++ ) { |
65 | $h{$i} = bless [] => 'main'; |
66 | } |
67 | }, |
68 | nooverload => sub { |
69 | my %h; |
70 | for ( my $i = 0 ; $i < 5000 ; $i++ ) { |
71 | $h{$i} = bless [] => 'main'; |
72 | } |
73 | } |
74 | } |
75 | ); |
76 | |
c13fabce |
77 | # we are OK if there is less than a factor of 2 difference here |
dc253b77 |
78 | ok( ( ( $results->{nooverload}->iters / $results->{overload}->iters ) < 2 ), |
eaf7c8d0 |
79 | 'Overload/bless performance acceptable' ); |
c13fabce |
80 | # if the test above failed, look at the section titled |
81 | # Perl Performance Issues on Red Hat Systems in |
ec63d168 |
82 | # L<DBIx::Class::Manual::Troubleshooting> |
83 | # Basically you may suffer severe performance issues when running |
84 | # DBIx::Class (and many other) modules. Look at getting a fixed |
85 | # version of the perl interpreter for your system. |