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+//) {
