From: Peter Rabbitson Date: Wed, 22 Jan 2014 18:15:52 +0000 (+0100) Subject: Report correct mismatching inode in the deletion guard on fixed perls X-Git-Tag: v0.08260~24 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2525160db929bdeba9f29511eda83ac7ab060fd9;p=dbsrgits%2FDBIx-Class.git Report correct mismatching inode in the deletion guard on fixed perls For reference: http://www.nntp.perl.org/group/perl.perl5.porters/2011/02/msg169414.html --- diff --git a/t/lib/DBICTest.pm b/t/lib/DBICTest.pm index eca0bc6..86acbfd 100644 --- a/t/lib/DBICTest.pm +++ b/t/lib/DBICTest.pm @@ -45,6 +45,7 @@ use Carp; use Path::Class::File (); use File::Spec; use Fcntl qw/:DEFAULT :flock/; +use Config; =head1 NAME @@ -301,10 +302,16 @@ sub __mk_disconnect_guard { my $cur_inode = (stat($db_file))[1]; if ($orig_inode != $cur_inode) { - # pack/unpack to match the unsigned longs returned by `stat` - $fail_reason = sprintf 'was recreated (initially inode %s, now %s)', ( - map { unpack ('L', pack ('l', $_) ) } ($orig_inode, $cur_inode ) - ); + my @inodes = ($orig_inode, $cur_inode); + # unless this is a fixed perl (P5RT#84590) pack/unpack before display + # to match the unsigned longs returned by `stat` + @inodes = map { unpack ('L', pack ('l', $_) ) } @inodes + unless $Config{st_ino_size}; + + $fail_reason = sprintf + 'was recreated (initially inode %s, now %s)', + @inodes + ; } }