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