r55561 - in /branches/upstream/libdata-dump-streamer-perl/current: Changes META.yml lib/Data/Dump/Streamer.pm t/madness.t t/test_helper.pl
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Tue Apr 6 21:08:24 UTC 2010
Author: jawnsy-guest
Date: Tue Apr 6 21:08:02 2010
New Revision: 55561
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=55561
Log:
[svn-upgrade] Integrating new upstream version, libdata-dump-streamer-perl (2.13)
Modified:
branches/upstream/libdata-dump-streamer-perl/current/Changes
branches/upstream/libdata-dump-streamer-perl/current/META.yml
branches/upstream/libdata-dump-streamer-perl/current/lib/Data/Dump/Streamer.pm
branches/upstream/libdata-dump-streamer-perl/current/t/madness.t
branches/upstream/libdata-dump-streamer-perl/current/t/test_helper.pl
Modified: branches/upstream/libdata-dump-streamer-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdata-dump-streamer-perl/current/Changes?rev=55561&op=diff
==============================================================================
--- branches/upstream/libdata-dump-streamer-perl/current/Changes (original)
+++ branches/upstream/libdata-dump-streamer-perl/current/Changes Tue Apr 6 21:08:02 2010
@@ -1,3 +1,21 @@
+2.13 (2010-04-05)
+
+No really, *actually* removed re.pm debugging code
+
+2.12 (2010-04-05)
+
+Removed re.pm debugging code (which also broke compat w/ perl-5.8
+
+2.11 (2010-04-04)
+
+perl-5.12.0 blesses file handles into IO::File, not IO::Handle
+
+2.10 (2010-04-04)
+
+Perl-5.12.0 has:
+ - qr// as a native
+ - $! isn't auto-filled with 'Bad file descriptor' as often
+
2.09 (2009-03-24)
Hashkeys ending in newline were incorrectly quoted. Sorry Ambrus.
Modified: branches/upstream/libdata-dump-streamer-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdata-dump-streamer-perl/current/META.yml?rev=55561&op=diff
==============================================================================
--- branches/upstream/libdata-dump-streamer-perl/current/META.yml (original)
+++ branches/upstream/libdata-dump-streamer-perl/current/META.yml Tue Apr 6 21:08:02 2010
@@ -1,9 +1,11 @@
--- #YAML:1.0
name: Data-Dump-Streamer
-version: 2.09
+version: 2.13
abstract: Accurately serialize a data structure as Perl code.
license: ~
-generated_by: ExtUtils::MakeMaker version 6.36
+author:
+ - Yves Orton (demerphq)
+generated_by: ExtUtils::MakeMaker version 6.42
distribution_type: module
requires:
B::Deparse: 0
@@ -12,7 +14,5 @@
Text::Abbrev: 0
Text::Balanced: 0
meta-spec:
- url: http://module-build.sourceforge.net/META-spec-v1.2.html
- version: 1.2
-author:
- - Yves Orton (demerphq)
+ url: http://module-build.sourceforge.net/META-spec-v1.3.html
+ version: 1.3
Modified: branches/upstream/libdata-dump-streamer-perl/current/lib/Data/Dump/Streamer.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdata-dump-streamer-perl/current/lib/Data/Dump/Streamer.pm?rev=55561&op=diff
==============================================================================
--- branches/upstream/libdata-dump-streamer-perl/current/lib/Data/Dump/Streamer.pm (original)
+++ branches/upstream/libdata-dump-streamer-perl/current/lib/Data/Dump/Streamer.pm Tue Apr 6 21:08:02 2010
@@ -35,7 +35,7 @@
BEGIN {
#$Id: Streamer.pm 40 2007-12-22 00:37:55Z demerphq $#
- $VERSION ='2.09';
+ $VERSION ='2.13';
$XS_VERSION='2.07';
$VERSION = eval $VERSION; # used for beta stuff.
@ISA = qw(Exporter DynaLoader);
@@ -2921,6 +2921,9 @@
$self->_dump_format($item,$name,$indent);
} elsif ($type eq 'IO') {
$self->{fh}->print("*{Symbol::gensym()}{IO}");
+ } elsif ($type eq 'ORANGE' || $type eq 'Regexp' || $type eq 'REGEXP') {
+ my ($pat,$mod)=regex($item);
+ $self->_dump_qr($pat,$mod);
} else {
Carp::confess "_dump_rv() can't handle '$type' objects yet\n :-(\n";
}
Modified: branches/upstream/libdata-dump-streamer-perl/current/t/madness.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdata-dump-streamer-perl/current/t/madness.t?rev=55561&op=diff
==============================================================================
--- branches/upstream/libdata-dump-streamer-perl/current/t/madness.t (original)
+++ branches/upstream/libdata-dump-streamer-perl/current/t/madness.t Tue Apr 6 21:08:02 2010
@@ -210,6 +210,7 @@
EXPECT
}
{
+ undef $!;
format STDOUT =
@<<<<<< @ââââââ @>>>>>>
"left", "middle", "right"
@@ -221,7 +222,7 @@
NV => 3.14159265358979,
PV => "string",
PV8 => "ab\ncd\x{20ac}\t",
- PVM => $!,
+ PVM => "$!",
RV => \$.,
AR => [ 1..2 ],
HR => { key => "value" },
@@ -232,7 +233,46 @@
OBJ => bless qr/("[^"]+")/,"Zorp",
);
- same( $dump= $o->Data(\%hash)->Out, <<'EXPECT', "", $o);
+ # Dumping differences per perl version:
+ # 5.12.0+:
+ #
+ # IO handles are now blessed into IO::File, I guess?
+ #
+ if ( $] >= 5.012_000 ) {
+ same( $dump= $o->Data(\%hash)->Out, <<'EXPECT', "", $o);
+$HASH1 = {
+ AR => [
+ 1,
+ 2
+ ],
+ CR => sub {
+ use warnings;
+ use strict 'refs';
+ 'code';
+ },
+ FMT => \do{ local *F; my $F=<<'_EOF_FORMAT_'; $F=~s/^\s+# //mg; eval $F; die $F.$@ if $@; *F{FORMAT};
+ # format F =
+ # @<<<<<< @ââââââ @>>>>>>
+ # 'left', 'middle', 'right'
+ # .
+_EOF_FORMAT_
+ },
+ GLB => *::STDERR,
+ HR => { key => 'value' },
+ IO => bless( *{Symbol::gensym()}{IO}, 'IO::File' ),
+ IV => 1,
+ NV => 3.14159265358979,
+ OBJ => bless( qr/("[^"]+")/, 'Zorp' ),
+ PV => 'string',
+ PV8 => "ab\ncd\x{20ac}\t",
+ PVM => '',
+ RV => \do { my $v = undef },
+ UND => undef
+ };
+EXPECT
+ }
+ else {
+ same( $dump= $o->Data(\%hash)->Out, <<'EXPECT', "", $o);
$HASH1 = {
AR => [
1,
@@ -258,12 +298,12 @@
OBJ => bless( qr/("[^"]+")/, 'Zorp' ),
PV => 'string',
PV8 => "ab\ncd\x{20ac}\t",
- PVM => 'Bad file descriptor',
+ PVM => '',
RV => \do { my $v = undef },
UND => undef
};
EXPECT
-
+ }
}
__END__
Modified: branches/upstream/libdata-dump-streamer-perl/current/t/test_helper.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdata-dump-streamer-perl/current/t/test_helper.pl?rev=55561&op=diff
==============================================================================
--- branches/upstream/libdata-dump-streamer-perl/current/t/test_helper.pl (original)
+++ branches/upstream/libdata-dump-streamer-perl/current/t/test_helper.pl Tue Apr 6 21:08:02 2010
@@ -78,6 +78,30 @@
sub capture { \@_ }
+sub _similar {
+ my ( $str1, $str2, $name, $obj ) = @_;
+
+ s/\s+$//gm for $str1, $str2;
+ s/\r\n/\n/g for $str1, $str2;
+ s/\(0x[0-9a-xA-X]+\)/(0xdeadbeef)/g for $str1, $str2;
+ my @vars = $str2 =~ m/^(?:my\s*)?(\$\w+)\s*=/gm;
+
+ #warn "@vars";
+ my $text = "\n" . $str1;
+ my $pat = "\n" . $str2;
+
+ unless ( like( $text, $pat ) ) {
+ if ( $] >= 5.012 ) {
+ eval qq{
+ use re qw( Debug EXECUTE );
+ \$text =~ \$pat;
+ 1;
+ }
+ or die $@;
+ }
+ $obj->diag;
+ }
+}
sub _same {
my ( $str1, $str2, $name, $obj ) = @_;
@@ -166,6 +190,69 @@
$_[$_-1]=$x[$_-1] for 1.. at _;
}
wantarray ? @x : $x[0]
+}
+
+sub similar {
+ goto &_similar unless ref( $_[1] );
+ my $name = shift;
+ my $obj = shift;
+ my ($expect,$result) = normalize(shift, scalar $obj->Data(@_)->Out());
+
+ my $main_pass = like( "\n$result", "\n$expect" );
+ if ( ! $main_pass ) {
+ $obj->diag;
+ }
+
+ my @declare=grep { /^[\$\@\%]/ } @{$obj->{declare}};
+
+ my @dump =map { /^[\@\%\&]/ ? "\\$_" : $_ } @{$obj->{out_names}};
+ my $dumpvars=join ( ",", @dump );
+
+ print $result,"\n" if $name=~/Test/;
+
+ my ($dumper,$error) = _dumper(\@_);
+ if ($error) {
+ diag( "$name\n$error" ) if $ENV{TEST_VERBOSE};
+ }
+ if ($dumper) {
+
+ my $result2_eval = $result . "\n" . 'scalar( $obj->Data(' . $dumpvars . ")->Out())\n";
+ my $dd_result_eval =
+ $result . "\nscalar(Data::Dumper->new("
+ . 'sub{\@_}->(' . $dumpvars . ")"
+ . ")->Purity(1)->Sortkeys(1)->Quotekeys(1)->"
+ . "Useperl(1)->Dump())\n";
+ unless ( $obj->Declare ) {
+ $dd_result_eval = "my(" . join ( ",", @declare ) . ");\n" . $dd_result_eval;
+ $result2_eval = "my(" . join ( ",", @declare ) . ");\n" . $result2_eval;
+ }
+ foreach my $test ( [ "Data::Dumper", $dd_result_eval, $dumper ],
+ [ "Data::Dump::Streamer", $result2_eval, $result ] ) {
+ my ( $test_name, $eval, $orig ) = @$test;
+
+ my ($warned,$res);
+ {
+ local $SIG{__WARN__}=sub { my $err=join ('', at _); $warned.=$err unless $err=~/^Subroutine|Encountered/};
+ $res = eval $eval;
+ if ($warned) { print "Eval $test_name produced warnings:$warned\n$eval" };
+ }
+ normalize($res);
+ my $fail = 0;
+ if ($@) {
+ print join "\n", "Failed $test_name eval()", $eval, $@, "";
+ $fail = 1;
+ } elsif ( $res ne $orig ) {
+ print "Failed $test_name second time\n";
+ eval { print string_diff( $orig, $res, "Orig", "Result" ) };
+ print "Orig:\n$orig\nResult:\n$res\nEval:\n$eval\n";
+ $fail = 1;
+ }
+ $obj->diag if $fail;
+ return fail($name) if $fail;
+ }
+ #print join "\n",$result,$result2,$dumper,$dd_result,"";
+ }
+ ok( $main_pass, $name )
}
sub same {
@@ -474,4 +561,4 @@
-1;
+1;
More information about the Pkg-perl-cvs-commits
mailing list