Commit | Line | Data |
dc253b77 |
1 | use strict; |
2 | use warnings; |
3 | use Test::More; |
4 | use lib qw(t/lib); |
d8190011 |
5 | use DBICTest; # do not remove even though it is not used |
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 | |
fc0a7ba1 |
25 | plan skip_all => 'Skipping as AUTOMATED_TESTING is set' |
26 | if ( $ENV{AUTOMATED_TESTING} ); |
27 | |
e7f959d8 |
28 | eval "use Benchmark ':all'"; |
dc253b77 |
29 | plan skip_all => 'needs Benchmark for testing' if $@; |
30 | |
e7f959d8 |
31 | plan tests => 3; |
dc253b77 |
32 | |
fc0a7ba1 |
33 | ok( 1, 'Dummy - prevents next test timing out' ); |
dc253b77 |
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 |
39 | # we therefore consider there to be a problem if the ratio is >= 2 |
dc253b77 |
40 | |
41 | my $results = timethese( |
c13fabce |
42 | -1, # run for 1 CPU second each |
dc253b77 |
43 | { |
e7f959d8 |
44 | no_bless => sub { |
dc253b77 |
45 | my %h; |
e7f959d8 |
46 | for ( my $i = 0 ; $i < 10000 ; $i++ ) { |
47 | $h{$i} = []; |
dc253b77 |
48 | } |
49 | }, |
e7f959d8 |
50 | bless_overload => sub { |
51 | use overload q(<) => sub { }; |
dc253b77 |
52 | my %h; |
e7f959d8 |
53 | for ( my $i = 0 ; $i < 10000 ; $i++ ) { |
dc253b77 |
54 | $h{$i} = bless [] => 'main'; |
55 | } |
e7f959d8 |
56 | }, |
57 | }, |
dc253b77 |
58 | ); |
59 | |
e7f959d8 |
60 | my $ratio = $results->{no_bless}->iters / $results->{bless_overload}->iters; |
61 | |
fc0a7ba1 |
62 | ok( ( $ratio < 2 ), 'Overload/bless performance acceptable' ) |
63 | || diag( |
8622bf34 |
64 | "\n", |
fc0a7ba1 |
65 | "This perl has a substantial slow down when handling large numbers\n", |
66 | "of blessed/overloaded objects. This can severely adversely affect\n", |
67 | "the performance of DBIx::Class programs. Please read the section\n", |
68 | "in the Troubleshooting POD documentation entitled\n", |
69 | "'Perl Performance Issues on Red Hat Systems'\n", |
8622bf34 |
70 | "As this is an extremely serious condition, the only way to skip\n", |
b6883aee |
71 | "over this test is to --force the installation, or to look in the test\n", |
8622bf34 |
72 | "file " . __FILE__ . "\n", |
fc0a7ba1 |
73 | ); |
e7f959d8 |
74 | |
75 | # We will only check for the difference in bless handling (whether the |
76 | # bless applies to the reference or the referent) if we have seen a |
77 | # performance issue... |
78 | |
79 | SKIP: { |
80 | skip "Not checking for bless handling as performance is OK", 1 |
81 | if ( $ratio < 2 ); |
82 | |
83 | { |
84 | package # don't want this in PAUSE |
85 | TestRHBug; |
86 | use overload bool => sub { 0 } |
87 | } |
88 | |
89 | sub _has_bug_34925 { |
90 | my %thing; |
91 | my $r1 = \%thing; |
92 | my $r2 = \%thing; |
93 | bless $r1 => 'TestRHBug'; |
94 | return !!$r2; |
95 | } |
96 | |
97 | sub _possibly_has_bad_overload_performance { |
98 | return $] < 5.008009 && !_has_bug_34925(); |
99 | } |
100 | |
101 | # If this next one fails then you almost certainly have a RH derived |
102 | # perl with the performance bug |
103 | # if this test fails, look at the section titled |
104 | # "Perl Performance Issues on Red Hat Systems" in |
105 | # L<DBIx::Class::Manual::Troubleshooting> |
106 | # Basically you may suffer severe performance issues when running |
107 | # DBIx::Class (and many other) modules. Look at getting a fixed |
108 | # version of the perl interpreter for your system. |
109 | # |
110 | ok( !_possibly_has_bad_overload_performance(), |
fc0a7ba1 |
111 | 'Checking whether bless applies to reference not object' ) |
112 | || diag( |
8622bf34 |
113 | "\n", |
fc0a7ba1 |
114 | "This perl is probably derived from a buggy Red Hat perl build\n", |
115 | "Please read the section in the Troubleshooting POD documentation\n", |
116 | "entitled 'Perl Performance Issues on Red Hat Systems'\n", |
8622bf34 |
117 | "As this is an extremely serious condition, the only way to skip\n", |
b6883aee |
118 | "over this test is to --force the installation, or to look in the test\n", |
8622bf34 |
119 | "file " . __FILE__ . "\n", |
fc0a7ba1 |
120 | ); |
e7f959d8 |
121 | } |