Re: DBI-1.58 test failure on Windows

On Tue, Jun 26, 2007 at 02:25:05PM +0100, Steve Hay wrote:
Gabor Szabo wrote:
Hi,

both
t\41prof_dump.t
t\zvg_41prof_dump.t
fail on plain ActivePerl 5.8.4 on Windows

[...]
# Failed test (t\41prof_dump.t at line 79)
not ok 14 - Program matches
# got: 't\\41prof_dump.t'
# expected: 't\41prof_dump.t'

Works fine for me (using bleadperl) when I just run "nmake test", but if
I explicitly run "perl -Mblib t\41prof_dump.t" then it fails as above.

Running "perl -Mblib t/41prof_dump.t" is fine, though, which explains
why "nmake test" works, given also that the Makefile has
"TEST_FILES=t/*.t" rather than "TEST_FILES=t\*.t".

Attached patch fixes it, but it's arguably just hiding the real problem
of having \\ where only \ was expected.

The bug is that DBI::ProfileDumper is 'escaping' the header strings but
DBI::ProfileData isn't unescaping them.

Please try the attached and let me know if it works for you.
Thanks!

Tim.

--

diff -ruN DBI-1.58.orig/t/41prof_dump.t DBI-1.58/t/41prof_dump.t
--- DBI-1.58.orig/t/41prof_dump.t 2007-06-15 22:49:16.000000000 +0100
+++ DBI-1.58/t/41prof_dump.t 2007-06-26 14:16:35.482433600 +0100
@@ -11,6 +11,7 @@

use DBI;

+use File::Spec::Functions qw(canonpath);
use Test::More;

BEGIN {
@@ -76,7 +77,7 @@
like( $prof[1], qr{^Path\s+=\s+\[\s+\]}, 'Found the Path');
ok( $prof[2] =~ m{^Program\s+=\s+(\S+)}, 'Found the Program');

-is( $1, $0, 'Program matches' );
+is( canonpath($1), canonpath($0), 'Program matches' );

# check that expected key is there
like(join('', @prof), qr/\+\s+1\s+\Q$sql\E/m);

Index: lib/DBI/ProfileData.pm
===================================================================
--- lib/DBI/ProfileData.pm (revision 9676)
+++ lib/DBI/ProfileData.pm (working copy)
@@ -240,6 +240,16 @@
}
}

+
+sub unescape_key { # inverse of escape_key() in DBI::ProfileDumper
+ local $_ = shift;
+ s/(?<!\\)\\n/\n/g; # expand \n, unless it's a \\n
+ s/(?<!\\)\\r/\r/g; # expand \r, unless it's a \\r
+ s/\\\\/\\/g; # \\ to \
+ return $_;
+}
+
+
# reads the body of the profile data
sub _read_body {
my ($self, $fh, $filename) = @_;
@@ -249,20 +259,15 @@

# build up node array
my @path = ("");
- my (@data, $index, $key, $path_key);
+ my (@data, $path_key);
while (<$fh>) {
chomp;
if (/^\+\s+(\d+)\s?(.*)/) {
# it's a key
- ($key, $index) = ($2, $1 - 1);
+ my ($key, $index) = ($2, $1 - 1);

- # unmangle key
- $key =~ s/(?<!\\)\\n/\n/g; # expand \n, unless it's a \\n
- $key =~ s/(?<!\\)\\r/\r/g; # expand \r, unless it's a \\r
- $key =~ s/\\\\/\\/g; # \\ to \
-
$#path = $index; # truncate path to new length
- $path[$index] = $key; # place new key at end
+ $path[$index] = unescape_key($key); # place new key at end

}
elsif (s/^=\s+//) {