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