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