r73395 - in /trunk/libyaml-perl: ./ debian/ inc/Module/Install/ inc/Test/ inc/Test/Base/ inc/Test/Builder/ lib/ lib/YAML/ t/
gregoa at users.alioth.debian.org
gregoa at users.alioth.debian.org
Sun Apr 24 16:03:05 UTC 2011
Author: gregoa
Date: Sun Apr 24 16:02:38 2011
New Revision: 73395
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=73395
Log:
New upstream release.
Added:
trunk/libyaml-perl/inc/Module/Install/AckXXX.pm
- copied unchanged from r73394, branches/upstream/libyaml-perl/current/inc/Module/Install/AckXXX.pm
trunk/libyaml-perl/inc/Module/Install/ManifestSkip.pm
- copied unchanged from r73394, branches/upstream/libyaml-perl/current/inc/Module/Install/ManifestSkip.pm
trunk/libyaml-perl/inc/Module/Install/ReadmeFromPod.pm
- copied unchanged from r73394, branches/upstream/libyaml-perl/current/inc/Module/Install/ReadmeFromPod.pm
trunk/libyaml-perl/inc/Module/Install/VersionCheck.pm
- copied unchanged from r73394, branches/upstream/libyaml-perl/current/inc/Module/Install/VersionCheck.pm
trunk/libyaml-perl/t/dump-perl-types-512.t
- copied unchanged from r73394, branches/upstream/libyaml-perl/current/t/dump-perl-types-512.t
trunk/libyaml-perl/t/dump-perl-types-514.t
- copied unchanged from r73394, branches/upstream/libyaml-perl/current/t/dump-perl-types-514.t
trunk/libyaml-perl/t/dump-tests-512.t
- copied unchanged from r73394, branches/upstream/libyaml-perl/current/t/dump-tests-512.t
trunk/libyaml-perl/t/dump-tests-514.t
- copied unchanged from r73394, branches/upstream/libyaml-perl/current/t/dump-tests-514.t
Modified:
trunk/libyaml-perl/Changes
trunk/libyaml-perl/MANIFEST
trunk/libyaml-perl/META.yml
trunk/libyaml-perl/Makefile.PL
trunk/libyaml-perl/README
trunk/libyaml-perl/debian/changelog
trunk/libyaml-perl/inc/Module/Install/TestBase.pm
trunk/libyaml-perl/inc/Test/Base.pm
trunk/libyaml-perl/inc/Test/Base/Filter.pm
trunk/libyaml-perl/inc/Test/Builder.pm
trunk/libyaml-perl/inc/Test/Builder/Module.pm
trunk/libyaml-perl/inc/Test/More.pm
trunk/libyaml-perl/lib/YAML.pm
trunk/libyaml-perl/lib/YAML/Types.pm
trunk/libyaml-perl/t/dump-perl-types.t
trunk/libyaml-perl/t/dump-tests.t
trunk/libyaml-perl/t/regexp.t
Modified: trunk/libyaml-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libyaml-perl/Changes?rev=73395&op=diff
==============================================================================
--- trunk/libyaml-perl/Changes (original)
+++ trunk/libyaml-perl/Changes Sun Apr 24 16:02:38 2011
@@ -1,3 +1,9 @@
+---
+version: 0.73
+date: Tue Apr 19 20:14:59 EST 2011
+changes:
+- Apply ANDK's patch for 5.14.0
+
---
version: 0.72
date: Wed Sep 1 11:54:00 AEST 2010
Modified: trunk/libyaml-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libyaml-perl/MANIFEST?rev=73395&op=diff
==============================================================================
--- trunk/libyaml-perl/MANIFEST (original)
+++ trunk/libyaml-perl/MANIFEST Sun Apr 24 16:02:38 2011
@@ -1,12 +1,16 @@
Changes
inc/Module/Install.pm
+inc/Module/Install/AckXXX.pm
inc/Module/Install/Base.pm
inc/Module/Install/Can.pm
inc/Module/Install/Fetch.pm
inc/Module/Install/Include.pm
inc/Module/Install/Makefile.pm
+inc/Module/Install/ManifestSkip.pm
inc/Module/Install/Metadata.pm
+inc/Module/Install/ReadmeFromPod.pm
inc/Module/Install/TestBase.pm
+inc/Module/Install/VersionCheck.pm
inc/Module/Install/Win32.pm
inc/Module/Install/WriteAll.pm
inc/Spiffy.pm
@@ -46,8 +50,12 @@
t/dump-file.t
t/dump-nested.t
t/dump-opts.t
+t/dump-perl-types-512.t
+t/dump-perl-types-514.t
t/dump-perl-types.t
t/dump-stringify.t
+t/dump-tests-512.t
+t/dump-tests-514.t
t/dump-tests.t
t/dump-works.t
t/errors.t
Modified: trunk/libyaml-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libyaml-perl/META.yml?rev=73395&op=diff
==============================================================================
--- trunk/libyaml-perl/META.yml (original)
+++ trunk/libyaml-perl/META.yml Sun Apr 24 16:02:38 2011
@@ -22,7 +22,5 @@
Filter::Util::Call: 0
perl: 5.8.1
resources:
- ChangeLog: http://fisheye2.atlassian.com/changelog/cpan/trunk/YAML
license: http://dev.perl.org/licenses/
- repository: http://svn.ali.as/cpan/trunk/YAML
-version: 0.72
+version: 0.73
Modified: trunk/libyaml-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libyaml-perl/Makefile.PL?rev=73395&op=diff
==============================================================================
--- trunk/libyaml-perl/Makefile.PL (original)
+++ trunk/libyaml-perl/Makefile.PL Sun Apr 24 16:02:38 2011
@@ -3,6 +3,10 @@
name 'YAML';
author 'Ingy dot Net <ingy at cpan.org>';
all_from 'lib/YAML.pm';
+readme_from;
+manifest_skip;
+version_check;
+ack_xxx;
use_test_base;
Modified: trunk/libyaml-perl/README
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libyaml-perl/README?rev=73395&op=diff
==============================================================================
--- trunk/libyaml-perl/README (original)
+++ trunk/libyaml-perl/README Sun Apr 24 16:02:38 2011
@@ -22,8 +22,8 @@
SYNOPSIS
use YAML;
-
- # Load a YAML stream of 3 YAML documents into Perl data structures.
+
+ # Load a YAML stream of 3 YAML documents into Perl data structures.
my ($hashref, $arrayref, $string) = Load(<<'...');
---
name: ingy
@@ -37,20 +37,20 @@
---
- Clark Evans
- Oren Ben-Kiki
- - Ingy döt Net
+ - Ingy döt Net
--- >
You probably think YAML stands for "Yet Another Markup Language". It
ain't! YAML is really a data serialization language. But if you want
to think of it as a markup, that's OK with me. A lot of people try
to use XML as a serialization format.
-
- "YAML" is catchy and fun to say. Try it. "YAML, YAML, YAML!!!"
+
+ "YAML" is catchy and fun to say. Try it. "YAML, YAML, YAML!!!"
...
-
- # Dump the Perl data structures back into YAML.
+
+ # Dump the Perl data structures back into YAML.
print Dump($string, $arrayref, $hashref);
-
- # YAML::Dump is used the same way you'd use Data::Dumper::Dumper
+
+ # YAML::Dump is used the same way you'd use Data::Dumper::Dumper
use Data::Dumper;
print Dumper($string, $arrayref, $hashref);
@@ -611,16 +611,16 @@
See YAML::Syck. Fast!
AUTHOR
- Ingy döt Net <ingy at cpan.org>
+ Ingy döt Net <ingy at cpan.org>
is resonsible for YAML.pm.
The YAML serialization language is the result of years of collaboration
- between Oren Ben-Kiki, Clark Evans and Ingy döt Net. Several others have
+ between Oren Ben-Kiki, Clark Evans and Ingy döt Net. Several others have
added help along the way.
COPYRIGHT
- Copyright (c) 2005, 2006, 2008. Ingy döt Net.
+ Copyright (c) 2005, 2006, 2008. Ingy döt Net.
Copyright (c) 2001, 2002, 2005. Brian Ingerson.
Modified: trunk/libyaml-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libyaml-perl/debian/changelog?rev=73395&op=diff
==============================================================================
--- trunk/libyaml-perl/debian/changelog (original)
+++ trunk/libyaml-perl/debian/changelog Sun Apr 24 16:02:38 2011
@@ -1,3 +1,9 @@
+libyaml-perl (0.73-1) UNRELEASED; urgency=low
+
+ * New upstream release.
+
+ -- gregor herrmann <gregoa at debian.org> Sun, 24 Apr 2011 18:00:58 +0200
+
libyaml-perl (0.72-1) unstable; urgency=low
[ Angel Abad ]
Modified: trunk/libyaml-perl/inc/Module/Install/TestBase.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libyaml-perl/inc/Module/Install/TestBase.pm?rev=73395&op=diff
==============================================================================
--- trunk/libyaml-perl/inc/Module/Install/TestBase.pm (original)
+++ trunk/libyaml-perl/inc/Module/Install/TestBase.pm Sun Apr 24 16:02:38 2011
@@ -7,7 +7,7 @@
use vars qw($VERSION @ISA);
BEGIN {
- $VERSION = '0.11';
+ $VERSION = '0.60';
@ISA = 'Module::Install::Base';
}
Modified: trunk/libyaml-perl/inc/Test/Base.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libyaml-perl/inc/Test/Base.pm?rev=73395&op=diff
==============================================================================
--- trunk/libyaml-perl/inc/Test/Base.pm (original)
+++ trunk/libyaml-perl/inc/Test/Base.pm Sun Apr 24 16:02:38 2011
@@ -1,11 +1,9 @@
#line 1
-# TODO:
-#
package Test::Base;
use 5.006001;
use Spiffy 0.30 -Base;
use Spiffy ':XXX';
-our $VERSION = '0.58';
+our $VERSION = '0.60';
my @test_more_exports;
BEGIN {
@@ -536,7 +534,7 @@
sub tie_output() {
my $handle = shift;
die "No buffer to tie" unless @_;
- tie $handle, 'Test::Base::Handle', $_[0];
+ tie *$handle, 'Test::Base::Handle', $_[0];
}
sub no_diff {
@@ -681,4 +679,4 @@
=encoding utf8
-#line 1376
+#line 1374
Modified: trunk/libyaml-perl/inc/Test/Base/Filter.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libyaml-perl/inc/Test/Base/Filter.pm?rev=73395&op=diff
==============================================================================
--- trunk/libyaml-perl/inc/Test/Base/Filter.pm (original)
+++ trunk/libyaml-perl/inc/Test/Base/Filter.pm Sun Apr 24 16:02:38 2011
@@ -1,7 +1,4 @@
#line 1
-#. TODO:
-#.
-
#===============================================================================
# This is the default class for handling Test::Base data filtering.
#===============================================================================
@@ -341,4 +338,4 @@
__DATA__
-#line 639
+#line 636
Modified: trunk/libyaml-perl/inc/Test/Builder.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libyaml-perl/inc/Test/Builder.pm?rev=73395&op=diff
==============================================================================
--- trunk/libyaml-perl/inc/Test/Builder.pm (original)
+++ trunk/libyaml-perl/inc/Test/Builder.pm Sun Apr 24 16:02:38 2011
@@ -5,7 +5,7 @@
use strict;
use warnings;
-our $VERSION = '0.94';
+our $VERSION = '0.98';
$VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval)
BEGIN {
@@ -24,7 +24,7 @@
require threads::shared;
# Hack around YET ANOTHER threads::shared bug. It would
- # occassionally forget the contents of the variable when sharing it.
+ # occasionally forget the contents of the variable when sharing it.
# So we first copy the data, then share, then put our copy back.
*share = sub (\[$@%]) {
my $type = ref $_[0];
@@ -99,25 +99,35 @@
$self->croak("You already have a child named ($self->{Child_Name}) running");
}
+ my $parent_in_todo = $self->in_todo;
+
+ # Clear $TODO for the child.
+ my $orig_TODO = $self->find_TODO(undef, 1, undef);
+
my $child = bless {}, ref $self;
$child->reset;
# Add to our indentation
$child->_indent( $self->_indent . ' ' );
+
$child->{$_} = $self->{$_} foreach qw{Out_FH Todo_FH Fail_FH};
+ if ($parent_in_todo) {
+ $child->{Fail_FH} = $self->{Todo_FH};
+ }
# This will be reset in finalize. We do this here lest one child failure
# cause all children to fail.
$child->{Child_Error} = $?;
$? = 0;
$child->{Parent} = $self;
+ $child->{Parent_TODO} = $orig_TODO;
$child->{Name} = $name || "Child of " . $self->name;
$self->{Child_Name} = $child->name;
return $child;
}
-#line 201
+#line 211
sub subtest {
my $self = shift;
@@ -129,27 +139,50 @@
# Turn the child into the parent so anyone who has stored a copy of
# the Test::Builder singleton will get the child.
- my $child = $self->child($name);
- my %parent = %$self;
- %$self = %$child;
-
- my $error;
- if( !eval { $subtests->(); 1 } ) {
- $error = $@;
+ my($error, $child, %parent);
+ {
+ # child() calls reset() which sets $Level to 1, so we localize
+ # $Level first to limit the scope of the reset to the subtest.
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
+
+ $child = $self->child($name);
+ %parent = %$self;
+ %$self = %$child;
+
+ my $run_the_subtests = sub {
+ $subtests->();
+ $self->done_testing unless $self->_plan_handled;
+ 1;
+ };
+
+ if( !eval { $run_the_subtests->() } ) {
+ $error = $@;
+ }
}
# Restore the parent and the copied child.
%$child = %$self;
%$self = %parent;
+ # Restore the parent's $TODO
+ $self->find_TODO(undef, 1, $child->{Parent_TODO});
+
# Die *after* we restore the parent.
die $error if $error and !eval { $error->isa('Test::Builder::Exception') };
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
return $child->finalize;
}
-
-#line 250
+#line 281
+
+sub _plan_handled {
+ my $self = shift;
+ return $self->{Have_Plan} || $self->{No_Plan} || $self->{Skip_All};
+}
+
+
+#line 306
sub finalize {
my $self = shift;
@@ -158,11 +191,14 @@
if( $self->{Child_Name} ) {
$self->croak("Can't call finalize() with child ($self->{Child_Name}) active");
}
+
+ local $? = 0; # don't fail if $subtests happened to set $? nonzero
$self->_ending;
# XXX This will only be necessary for TAP envelopes (we think)
#$self->_print( $self->is_passing ? "PASS\n" : "FAIL\n" );
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
my $ok = 1;
$self->parent->{Child_Name} = undef;
if ( $self->{Skip_All} ) {
@@ -190,17 +226,17 @@
return $self->{Indent};
}
-#line 300
+#line 359
sub parent { shift->{Parent} }
-#line 312
+#line 371
sub name { shift->{Name} }
sub DESTROY {
my $self = shift;
- if ( $self->parent ) {
+ if ( $self->parent and $$ == $self->{Original_Pid} ) {
my $name = $self->name;
$self->diag(<<"FAIL");
Child ($name) exited without calling finalize()
@@ -210,7 +246,7 @@
}
}
-#line 336
+#line 395
our $Level;
@@ -227,6 +263,7 @@
$self->{Have_Plan} = 0;
$self->{No_Plan} = 0;
$self->{Have_Output_Plan} = 0;
+ $self->{Done_Testing} = 0;
$self->{Original_Pid} = $$;
$self->{Child_Name} = undef;
@@ -256,7 +293,7 @@
return;
}
-#line 414
+#line 474
my %plan_cmds = (
no_plan => \&no_plan,
@@ -303,8 +340,7 @@
return;
}
-
-#line 470
+#line 529
sub expected_tests {
my $self = shift;
@@ -322,7 +358,7 @@
return $self->{Expected_Tests};
}
-#line 494
+#line 553
sub no_plan {
my($self, $arg) = @_;
@@ -335,8 +371,7 @@
return 1;
}
-
-#line 528
+#line 586
sub _output_plan {
my($self, $max, $directive, $reason) = @_;
@@ -354,7 +389,8 @@
return;
}
-#line 579
+
+#line 638
sub done_testing {
my($self, $num_tests) = @_;
@@ -397,7 +433,7 @@
}
-#line 630
+#line 689
sub has_plan {
my $self = shift;
@@ -407,7 +443,7 @@
return(undef);
}
-#line 647
+#line 706
sub skip_all {
my( $self, $reason ) = @_;
@@ -421,7 +457,7 @@
exit(0);
}
-#line 672
+#line 731
sub exported_to {
my( $self, $pack ) = @_;
@@ -432,7 +468,7 @@
return $self->{Exported_To};
}
-#line 702
+#line 761
sub ok {
my( $self, $test, $name ) = @_;
@@ -592,14 +628,12 @@
return $numval != 0 and $numval ne $val ? 1 : 0;
}
-#line 876
+#line 939
sub is_eq {
my( $self, $got, $expect, $name ) = @_;
local $Level = $Level + 1;
- $self->_unoverload_str( \$got, \$expect );
-
if( !defined $got || !defined $expect ) {
# undef only matches undef and nothing else
my $test = !defined $got && !defined $expect;
@@ -615,8 +649,6 @@
sub is_num {
my( $self, $got, $expect, $name ) = @_;
local $Level = $Level + 1;
-
- $self->_unoverload_num( \$got, \$expect );
if( !defined $got || !defined $expect ) {
# undef only matches undef and nothing else
@@ -675,7 +707,7 @@
DIAGNOSTIC
}
-#line 973
+#line 1032
sub isnt_eq {
my( $self, $got, $dont_expect, $name ) = @_;
@@ -709,7 +741,7 @@
return $self->cmp_ok( $got, '!=', $dont_expect, $name );
}
-#line 1022
+#line 1081
sub like {
my( $self, $this, $regex, $name ) = @_;
@@ -725,7 +757,7 @@
return $self->_regex_ok( $this, $regex, '!~', $name );
}
-#line 1046
+#line 1105
my %numeric_cmps = map { ( $_, 1 ) } ( "<", "<=", ">", ">=", "==", "!=", "<=>" );
@@ -741,8 +773,9 @@
my($pack, $file, $line) = $self->caller();
+ # This is so that warnings come out at the caller's level
$test = eval qq[
-#line 1 "cmp_ok [from $file line $line]"
+#line $line "(eval in cmp_ok) $file"
\$got $type \$expect;
];
$error = $@;
@@ -805,7 +838,7 @@
return $code;
}
-#line 1145
+#line 1205
sub BAIL_OUT {
my( $self, $reason ) = @_;
@@ -815,14 +848,14 @@
exit 255;
}
-#line 1158
+#line 1218
{
no warnings 'once';
*BAILOUT = \&BAIL_OUT;
}
-#line 1172
+#line 1232
sub skip {
my( $self, $why ) = @_;
@@ -853,7 +886,7 @@
return 1;
}
-#line 1213
+#line 1273
sub todo_skip {
my( $self, $why ) = @_;
@@ -881,7 +914,7 @@
return 1;
}
-#line 1293
+#line 1353
sub maybe_regex {
my( $self, $regex ) = @_;
@@ -961,7 +994,7 @@
# I'm not ready to publish this. It doesn't deal with array return
# values from the code or context.
-#line 1389
+#line 1449
sub _try {
my( $self, $code, %opts ) = @_;
@@ -981,7 +1014,7 @@
return wantarray ? ( $return, $error ) : $return;
}
-#line 1418
+#line 1478
sub is_fh {
my $self = shift;
@@ -995,7 +1028,7 @@
eval { tied($maybe_fh)->can('TIEHANDLE') };
}
-#line 1461
+#line 1521
sub level {
my( $self, $level ) = @_;
@@ -1006,7 +1039,7 @@
return $Level;
}
-#line 1493
+#line 1553
sub use_numbers {
my( $self, $use_nums ) = @_;
@@ -1017,7 +1050,7 @@
return $self->{Use_Nums};
}
-#line 1526
+#line 1586
foreach my $attribute (qw(No_Header No_Ending No_Diag)) {
my $method = lc $attribute;
@@ -1035,7 +1068,7 @@
*{ __PACKAGE__ . '::' . $method } = $code;
}
-#line 1579
+#line 1639
sub diag {
my $self = shift;
@@ -1043,7 +1076,7 @@
$self->_print_comment( $self->_diag_fh, @_ );
}
-#line 1594
+#line 1654
sub note {
my $self = shift;
@@ -1080,7 +1113,7 @@
return 0;
}
-#line 1644
+#line 1704
sub explain {
my $self = shift;
@@ -1099,7 +1132,7 @@
} @_;
}
-#line 1673
+#line 1733
sub _print {
my $self = shift;
@@ -1114,20 +1147,21 @@
return if $^C;
my $msg = join '', @msgs;
+ my $indent = $self->_indent;
local( $\, $", $, ) = ( undef, ' ', '' );
# Escape each line after the first with a # so we don't
# confuse Test::Harness.
- $msg =~ s{\n(?!\z)}{\n# }sg;
+ $msg =~ s{\n(?!\z)}{\n$indent# }sg;
# Stick a newline on the end if it needs it.
$msg .= "\n" unless $msg =~ /\n\z/;
- return print $fh $self->_indent, $msg;
-}
-
-#line 1732
+ return print $fh $indent, $msg;
+}
+
+#line 1793
sub output {
my( $self, $fh ) = @_;
@@ -1223,8 +1257,8 @@
open( $Testout, ">&STDOUT" ) or die "Can't dup STDOUT: $!";
open( $Testerr, ">&STDERR" ) or die "Can't dup STDERR: $!";
- # $self->_copy_io_layers( \*STDOUT, $Testout );
- # $self->_copy_io_layers( \*STDERR, $Testerr );
+ $self->_copy_io_layers( \*STDOUT, $Testout );
+ $self->_copy_io_layers( \*STDERR, $Testerr );
$self->{Opened_Testhandles} = 1;
@@ -1239,14 +1273,22 @@
require PerlIO;
my @src_layers = PerlIO::get_layers($src);
- binmode $dst, join " ", map ":$_", @src_layers if @src_layers;
+ _apply_layers($dst, @src_layers) if @src_layers;
}
);
return;
}
-#line 1857
+sub _apply_layers {
+ my ($fh, @layers) = @_;
+ my %seen;
+ my @unique = grep { $_ ne 'unix' and !$seen{$_}++ } @layers;
+ binmode($fh, join(":", "", "raw", @unique));
+}
+
+
+#line 1926
sub reset_outputs {
my $self = shift;
@@ -1258,7 +1300,7 @@
return;
}
-#line 1883
+#line 1952
sub _message_at_caller {
my $self = shift;
@@ -1279,7 +1321,7 @@
}
-#line 1923
+#line 1992
sub current_test {
my( $self, $num ) = @_;
@@ -1312,7 +1354,7 @@
return $self->{Curr_Test};
}
-#line 1971
+#line 2040
sub is_passing {
my $self = shift;
@@ -1325,7 +1367,7 @@
}
-#line 1993
+#line 2062
sub summary {
my($self) = shift;
@@ -1333,14 +1375,14 @@
return map { $_->{'ok'} } @{ $self->{Test_Results} };
}
-#line 2048
+#line 2117
sub details {
my $self = shift;
return @{ $self->{Test_Results} };
}
-#line 2077
+#line 2146
sub todo {
my( $self, $pack ) = @_;
@@ -1354,19 +1396,21 @@
return '';
}
-#line 2099
+#line 2173
sub find_TODO {
- my( $self, $pack ) = @_;
+ my( $self, $pack, $set, $new_value ) = @_;
$pack = $pack || $self->caller(1) || $self->exported_to;
return unless $pack;
no strict 'refs'; ## no critic
- return ${ $pack . '::TODO' };
-}
-
-#line 2117
+ my $old_value = ${ $pack . '::TODO' };
+ $set and ${ $pack . '::TODO' } = $new_value;
+ return $old_value;
+}
+
+#line 2193
sub in_todo {
my $self = shift;
@@ -1375,7 +1419,7 @@
return( defined $self->{Todo} || $self->find_TODO ) ? 1 : 0;
}
-#line 2167
+#line 2243
sub todo_start {
my $self = shift;
@@ -1390,7 +1434,7 @@
return;
}
-#line 2189
+#line 2265
sub todo_end {
my $self = shift;
@@ -1411,7 +1455,7 @@
return;
}
-#line 2222
+#line 2298
sub caller { ## no critic (Subroutines::ProhibitBuiltinHomonyms)
my( $self, $height ) = @_;
@@ -1426,9 +1470,9 @@
return wantarray ? @caller : $caller[0];
}
-#line 2239
-
-#line 2253
+#line 2315
+
+#line 2329
#'#
sub _sanity_check {
@@ -1441,7 +1485,7 @@
return;
}
-#line 2274
+#line 2350
sub _whoa {
my( $self, $check, $desc ) = @_;
@@ -1456,7 +1500,7 @@
return;
}
-#line 2298
+#line 2374
sub _my_exit {
$? = $_[0]; ## no critic (Variables::RequireLocalizedPunctuationVars)
@@ -1464,7 +1508,7 @@
return 1;
}
-#line 2310
+#line 2386
sub _ending {
my $self = shift;
@@ -1583,7 +1627,7 @@
$Test->_ending if defined $Test;
}
-#line 2498
+#line 2574
1;
Modified: trunk/libyaml-perl/inc/Test/Builder/Module.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libyaml-perl/inc/Test/Builder/Module.pm?rev=73395&op=diff
==============================================================================
--- trunk/libyaml-perl/inc/Test/Builder/Module.pm (original)
+++ trunk/libyaml-perl/inc/Test/Builder/Module.pm Sun Apr 24 16:02:38 2011
@@ -8,7 +8,7 @@
require Exporter;
our @ISA = qw(Exporter);
-our $VERSION = '0.94';
+our $VERSION = '0.98';
$VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval)
Modified: trunk/libyaml-perl/inc/Test/More.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libyaml-perl/inc/Test/More.pm?rev=73395&op=diff
==============================================================================
--- trunk/libyaml-perl/inc/Test/More.pm (original)
+++ trunk/libyaml-perl/inc/Test/More.pm Sun Apr 24 16:02:38 2011
@@ -18,7 +18,7 @@
return warn @_, " at $file line $line\n";
}
-our $VERSION = '0.94';
+our $VERSION = '0.98';
$VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval)
use Test::Builder::Module;
@@ -88,7 +88,7 @@
return $tb->ok( $test, $name );
}
-#line 367
+#line 372
sub is ($$;$) {
my $tb = Test::More->builder;
@@ -104,7 +104,7 @@
*isn't = \&isnt;
-#line 411
+#line 416
sub like ($$;$) {
my $tb = Test::More->builder;
@@ -112,7 +112,7 @@
return $tb->like(@_);
}
-#line 426
+#line 431
sub unlike ($$;$) {
my $tb = Test::More->builder;
@@ -120,7 +120,7 @@
return $tb->unlike(@_);
}
-#line 471
+#line 476
sub cmp_ok($$$;$) {
my $tb = Test::More->builder;
@@ -128,7 +128,7 @@
return $tb->cmp_ok(@_);
}
-#line 506
+#line 511
sub can_ok ($@) {
my( $proto, @methods ) = @_;
@@ -162,7 +162,7 @@
return $ok;
}
-#line 572
+#line 577
sub isa_ok ($$;$) {
my( $object, $class, $obj_name ) = @_;
@@ -222,7 +222,7 @@
return $ok;
}
-#line 651
+#line 656
sub new_ok {
my $tb = Test::More->builder;
@@ -247,16 +247,16 @@
return $obj;
}
-#line 719
-
-sub subtest($&) {
+#line 741
+
+sub subtest {
my ($name, $subtests) = @_;
my $tb = Test::More->builder;
return $tb->subtest(@_);
}
-#line 743
+#line 765
sub pass (;$) {
my $tb = Test::More->builder;
@@ -270,7 +270,7 @@
return $tb->ok( 0, @_ );
}
-#line 806
+#line 833
sub use_ok ($;@) {
my( $module, @imports ) = @_;
@@ -332,7 +332,7 @@
return( $eval_result, $eval_error );
}
-#line 875
+#line 902
sub require_ok ($) {
my($module) = shift;
@@ -340,7 +340,7 @@
my $pack = caller;
- # Try to deterine if we've been given a module name or file.
+ # Try to determine if we've been given a module name or file.
# Module names must be barewords, files not.
$module = qq['$module'] unless _is_module_name($module);
@@ -376,7 +376,7 @@
return $module =~ /^[a-zA-Z]\w*$/ ? 1 : 0;
}
-#line 952
+#line 979
our( @Data_Stack, %Refs_Seen );
my $DNE = bless [], 'Does::Not::Exist';
@@ -476,14 +476,14 @@
return '' if !ref $thing;
- for my $type (qw(ARRAY HASH REF SCALAR GLOB CODE Regexp)) {
+ for my $type (qw(Regexp ARRAY HASH REF SCALAR GLOB CODE)) {
return $type if UNIVERSAL::isa( $thing, $type );
}
return '';
}
-#line 1112
+#line 1139
sub diag {
return Test::More->builder->diag(@_);
@@ -493,13 +493,13 @@
return Test::More->builder->note(@_);
}
-#line 1138
+#line 1165
sub explain {
return Test::More->builder->explain(@_);
}
-#line 1204
+#line 1231
## no critic (Subroutines::RequireFinalReturn)
sub skip {
@@ -527,7 +527,7 @@
last SKIP;
}
-#line 1288
+#line 1315
sub todo_skip {
my( $why, $how_many ) = @_;
@@ -548,7 +548,7 @@
last TODO;
}
-#line 1343
+#line 1370
sub BAIL_OUT {
my $reason = shift;
@@ -557,7 +557,7 @@
$tb->BAIL_OUT($reason);
}
-#line 1382
+#line 1409
#'#
sub eq_array {
@@ -581,6 +581,8 @@
my $e1 = $_ > $#$a1 ? $DNE : $a1->[$_];
my $e2 = $_ > $#$a2 ? $DNE : $a2->[$_];
+ next if _equal_nonrefs($e1, $e2);
+
push @Data_Stack, { type => 'ARRAY', idx => $_, vals => [ $e1, $e2 ] };
$ok = _deep_check( $e1, $e2 );
pop @Data_Stack if $ok;
@@ -589,6 +591,21 @@
}
return $ok;
+}
+
+sub _equal_nonrefs {
+ my( $e1, $e2 ) = @_;
+
+ return if ref $e1 or ref $e2;
+
+ if ( defined $e1 ) {
+ return 1 if defined $e2 and $e1 eq $e2;
+ }
+ else {
+ return 1 if !defined $e2;
+ }
+
+ return;
}
sub _deep_check {
@@ -603,9 +620,6 @@
local %Refs_Seen = %Refs_Seen;
{
- # Quiet uninitialized value warnings when comparing undefs.
- no warnings 'uninitialized';
-
$tb->_unoverload_str( \$e1, \$e2 );
# Either they're both references or both not.
@@ -616,7 +630,7 @@
$ok = 0;
}
elsif( !defined $e1 and !defined $e2 ) {
- # Shortcut if they're both defined.
+ # Shortcut if they're both undefined.
$ok = 1;
}
elsif( _dne($e1) xor _dne($e2) ) {
@@ -683,7 +697,7 @@
}
}
-#line 1515
+#line 1556
sub eq_hash {
local @Data_Stack = ();
@@ -706,6 +720,8 @@
my $e1 = exists $a1->{$k} ? $a1->{$k} : $DNE;
my $e2 = exists $a2->{$k} ? $a2->{$k} : $DNE;
+ next if _equal_nonrefs($e1, $e2);
+
push @Data_Stack, { type => 'HASH', idx => $k, vals => [ $e1, $e2 ] };
$ok = _deep_check( $e1, $e2 );
pop @Data_Stack if $ok;
@@ -716,7 +732,7 @@
return $ok;
}
-#line 1572
+#line 1615
sub eq_set {
my( $a1, $a2 ) = @_;
@@ -741,6 +757,6 @@
);
}
-#line 1774
+#line 1817
1;
Modified: trunk/libyaml-perl/lib/YAML.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libyaml-perl/lib/YAML.pm?rev=73395&op=diff
==============================================================================
--- trunk/libyaml-perl/lib/YAML.pm (original)
+++ trunk/libyaml-perl/lib/YAML.pm Sun Apr 24 16:02:38 2011
@@ -6,7 +6,7 @@
use YAML::Base;
use YAML::Node; # XXX This is a temp fix for Module::Build
-our $VERSION = '0.72';
+our $VERSION = '0.73';
our @ISA = 'YAML::Base';
our @EXPORT = qw{ Dump Load };
our @EXPORT_OK = qw{ freeze thaw DumpFile LoadFile Bless Blessed };
Modified: trunk/libyaml-perl/lib/YAML/Types.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libyaml-perl/lib/YAML/Types.pm?rev=73395&op=diff
==============================================================================
--- trunk/libyaml-perl/lib/YAML/Types.pm (original)
+++ trunk/libyaml-perl/lib/YAML/Types.pm Sun Apr 24 16:02:38 2011
@@ -219,9 +219,10 @@
sub yaml_load {
my $self = shift;
my ($node, $class) = @_;
- return qr{$node} unless $node =~ /^\(\?([\-xism]*):(.*)\)\z/s;
+ return qr{$node} unless $node =~ /^\(\?([\^\-xism]*):(.*)\)\z/s;
my ($flags, $re) = ($1, $2);
$flags =~ s/-.*//;
+ $flags =~ s/^\^//;
my $sub = _QR_TYPES->{$flags} || sub { qr{$_[0]} };
my $qr = &$sub($re);
bless $qr, $class if length $class;
Modified: trunk/libyaml-perl/t/dump-perl-types.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libyaml-perl/t/dump-perl-types.t?rev=73395&op=diff
==============================================================================
--- trunk/libyaml-perl/t/dump-perl-types.t (original)
+++ trunk/libyaml-perl/t/dump-perl-types.t Sun Apr 24 16:02:38 2011
@@ -1,4 +1,4 @@
-use t::TestYAML tests => 16;
+use t::TestYAML tests => 14;
filters { perl => ['eval', 'yaml_dump'] };
@@ -45,18 +45,6 @@
+++ yaml
--- !!perl/ref
=: Goodbye
-
-=== Regular Expression
-+++ perl: qr{perfect match};
-+++ yaml
---- !!perl/regexp (?-xism:perfect match)
-
-=== Regular Expression with newline
-+++ perl
-qr{perfect
-match}x;
-+++ yaml
---- !!perl/regexp "(?x-ism:perfect\nmatch)"
=== Scalar Glob
+++ perl
Modified: trunk/libyaml-perl/t/dump-tests.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libyaml-perl/t/dump-tests.t?rev=73395&op=diff
==============================================================================
--- trunk/libyaml-perl/t/dump-tests.t (original)
+++ trunk/libyaml-perl/t/dump-tests.t Sun Apr 24 16:02:38 2011
@@ -1,4 +1,4 @@
-use t::TestYAML tests => 58;
+use t::TestYAML tests => 57;
no_diff();
run_roundtrip_nyn('dumper');
@@ -304,16 +304,6 @@
foo: 42
===
-+++ no_round_trip
-Since we don't use eval for regexp reconstitution any more (for safety
-sake) this test doesn't roundtrip even though the values are equivalent.
-+++ perl
-[qr{bozo$}i]
-+++ yaml
----
-- !!perl/regexp (?i-xsm:bozo$)
-
-===
+++ perl
[undef, undef]
+++ yaml
Modified: trunk/libyaml-perl/t/regexp.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libyaml-perl/t/regexp.t?rev=73395&op=diff
==============================================================================
--- trunk/libyaml-perl/t/regexp.t (original)
+++ trunk/libyaml-perl/t/regexp.t Sun Apr 24 16:02:38 2011
@@ -2,16 +2,22 @@
use YAML();
no warnings 'once';
+my $m_xis = "m-xis";
+my $_xism = "-xism";
+if (qr/x/ =~ /\(\?\^/){
+ $m_xis = "^m";
+ $_xism = "^";
+}
my @blocks = blocks;
my $block = $blocks[0];
$YAML::UseCode = 1;
my $hash = YAML::Load($block->yaml);
-is $hash->{key}, '(?m-xis:foo$)', 'Regexps load';
-is YAML::Dump(eval $block->perl), <<'...', 'Regexps dump';
+is $hash->{key}, "(?$m_xis:foo\$)", 'Regexps load';
+is YAML::Dump(eval $block->perl), <<"...", 'Regexps dump';
---
-key: !!perl/regexp (?m-xis:foo$)
+key: !!perl/regexp (?$m_xis:foo\$)
...
my $re = $hash->{key};
@@ -25,13 +31,13 @@
$block = $blocks[1];
$hash = YAML::Load($block->yaml);
-is $hash->{key}, '(?m-xis:foo$)', 'Regexps load';
+is $hash->{key}, "(?$m_xis:foo\$)", 'Regexps load';
# XXX Dumper can't detect a blessed regexp
-# is YAML::Dump(eval $block->perl), <<'...', 'Regexps dump';
+# is YAML::Dump(eval $block->perl), <<"...", 'Regexps dump';
# ---
-# key: !!perl/regexp (?m-xis:foo$)
+# key: !!perl/regexp (?$m_xis:foo\$)
# ...
$re = $hash->{key};
@@ -48,11 +54,11 @@
$block = $blocks[2];
$hash = YAML::Load($block->yaml);
-is $hash->{key}, '(?-xism:foo$)', 'Regexps load';
+is $hash->{key}, "(?$_xism:foo\$)", 'Regexps load';
-is YAML::Dump(eval $block->perl), <<'...', 'Regexps dump';
+is YAML::Dump(eval $block->perl), <<"...", 'Regexps dump';
---
-key: !!perl/regexp (?-xism:foo$)
+key: !!perl/regexp (?$_xism:foo\$)
...
$re = $hash->{key};
More information about the Pkg-perl-cvs-commits
mailing list