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