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