Tim Bunce wrote:
On Wed, Jun 20, 2007 at 08:47:53AM +0100, Steve Hay wrote:
Tim Bunce wrote:
file: $CPAN/authors/id/T/TI/TIMB/DBI-1.57.tar.gz
size: 490304 bytes
md5: fca667f59dff24058a8e0e8f09e2aad9
=head2 Changes in DBI 1.57 (svn rev 9639), 13th June 2007
Fixed t/86gofer_fail tests to be less likely to fail falsely.
t/86gofer_fail.t now fails with my build of bleadperl (patchlevel 31376)
with VC++ 6.0 on Win32 (perl -V below). This script was passing OK in
DBI-1.56 with the same perl.
C:\Temp\DBI-1.57>perl -Mblib t\86gofer_fail.t
ok 21 - negative percentage should fail non-randomly
Testing random delay
ok 22
Unexpected failure: DBD::Gofer::db do failed: Assertion !((sv)->sv_flags & 0x00010000) failed: file "..\pad.c", line 1505 at
C:\Temp\DBI-1.57\blib\lib/DBI/Gofer/Execute.pm line 624. at t\86gofer_fail.t line 129.
Execute.pm line 624 is returning a closure, but it doesn't seem
particularly magical.
Not sure when I'll be able to dig deeper. CC'd to perl5-porters in the
hope they can help narrow it down.
With the attached patch I now have all tests successful.
I remember lots of discussion a while ago about constructions like "my
$x = 1 if $y;". I don't remember what the conclusion of it all was,
except that it's probably best avoided. Is that right?
--
diff -ruN DBI-1.57.orig/lib/DBI/Gofer/Execute.pm
DBI-1.57/lib/DBI/Gofer/Execute.pm
--- DBI-1.57.orig/lib/DBI/Gofer/Execute.pm 2007-06-07 17:46:12.000000000
+0100
+++ DBI-1.57/lib/DBI/Gofer/Execute.pm 2007-06-21 17:36:24.722390400 +0100
@@ -596,8 +596,9 @@
sub _mk_rand_callback {
my ($self, $method, $fail_percent, $delay_percent, $delay_duration) = @_;
- $fail_percent ||= 0; my $fail_modrate = int(1/(-$fail_percent )*100) if
$fail_percent;
- $delay_percent ||= 0; my $delay_modrate = int(1/(-$delay_percent)*100) if
$delay_percent;
+ my ($fail_modrate, $delay_modrate);
+ $fail_percent ||= 0; $fail_modrate = int(1/(-$fail_percent )*100) if
$fail_percent;
+ $delay_percent ||= 0; $delay_modrate = int(1/(-$delay_percent)*100) if
$delay_percent;
# note that $method may be "*"
return sub {
my ($h) = @_;
