In perl.git, the branch maint-5.10 has been updated <http://perl5.git.perl.org/perl.git/commitdiff/d3833d976cb99fa6773254fdbee77c050bf3f149?hp=06757ac83eeb84dd9e0343508a2f857c3922f6b4>
- Log ----------------------------------------------------------------- commit d3833d976cb99fa6773254fdbee77c050bf3f149 Author: David Mitchell <[email protected]> Date: Tue Jun 30 13:17:07 2009 +0100 sync base with CPAN and update Maintainers.pl (cherry picked from commit 3eff6cdadf4544f5f7f61c84f677624e8d648ff4) M Porting/Maintainers.pl M lib/base/Changes commit 9877d150b36fb4f281c3d30a394947200ce6efc5 Author: Rafael Garcia-Suarez <[email protected]> Date: Sun Jun 28 17:56:00 2009 +0200 Bump version of fields.pm to 2.14 to match the version of base.pm (cherry picked from commit 956e881e4f46ae056e6f685defb1e9627e01814b) M lib/fields.pm commit b3e601cf1723798453fc25e3072035f8f49a12f8 Author: Rafael Garcia-Suarez <[email protected]> Date: Sun Jun 28 17:55:18 2009 +0200 Add base.pm tests from the CPAN distribution (cherry picked from commit d19d8ad381fb36912d19688e1f316e244567bb44) M MANIFEST A lib/base/t/compile-time.t A lib/base/t/fields-5.6.0.t A lib/base/t/fields-5.8.0.t M lib/base/t/fields-base.t commit 35b062576fdc9c18ab7b60b0c5b4eeee90cd35e6 Author: Rafael Garcia-Suarez <[email protected]> Date: Sun Jun 28 16:57:52 2009 +0200 Move module part of the base.pm test suite in base.pm's test directory (cherry picked from commit 439e01810c70f0dbcae1202b301da4e148e16485) M MANIFEST A lib/base/t/lib/HasSigDie.pm M lib/base/t/sigdie.t D t/lib/HasSigDie.pm commit b12478f026be9f9391bedce7d4990ff1974402a0 Author: Rafael Garcia-Suarez <[email protected]> Date: Sun Jun 28 16:18:27 2009 +0200 Silence warnings in test with 5.10.0 (cherry picked from commit 40b9d4d925a92009ab916e8557c333c6e9e5d0ca) M ext/Safe/t/safeuniversal.t commit 76acb80978b1d980695efa7f77e78bb779ecd816 Author: Rafael Garcia-Suarez <[email protected]> Date: Sun Jun 28 16:08:19 2009 +0200 Bump Safe version to 2.17 for CPAN release (cherry picked from commit 03dbc343c8be5c169c9c735909ab35d3bbf05a0b) M ext/Safe/Safe.pm commit 65af8cd18f58b605bc68fb5ce6e1e4e2d9297579 Author: Rafael Garcia-Suarez <[email protected]> Date: Sun Aug 24 14:13:52 2008 +0000 Patch by Tod Hagan to document the 2nd argument of reval() in Safe.pm p4raw-id: //depot/p...@34222 (cherry picked from commit fd8ebd06d0bf43876c887191f4ff165ae9772eb3) M ext/Safe/Safe.pm commit d5e5e3737ef6ac853f7892995ef1e10f89ecda56 Author: Bram <[email protected]> Date: Sun Jun 28 12:38:03 2009 +0200 Extra examples for 'sort' (cherry picked from commit a9320c62d9034275ce0ce1fa301011823fbbe2a4) M pod/perlfunc.pod commit c77d4a9df0e4de0d5bd9699d9f4fe5eee0bae62c Author: Bram <[email protected]> Date: Sun Jun 28 11:39:07 2009 +0200 Document what $* used to do on older versions (cherry picked from commit 4fd19576a68c8e855a000d6fbe59c4761919e185) M pod/perldiag.pod ----------------------------------------------------------------------- Summary of changes: MANIFEST | 5 +- Porting/Maintainers.pl | 8 +- ext/Safe/Safe.pm | 8 +- ext/Safe/t/safeuniversal.t | 3 + lib/base/Changes | 6 + lib/base/t/compile-time.t | 42 ++++++ lib/base/t/fields-5.6.0.t | 228 ++++++++++++++++++++++++++++++++ lib/base/t/fields-5.8.0.t | 254 ++++++++++++++++++++++++++++++++++++ lib/base/t/fields-base.t | 12 ++ {t => lib/base/t}/lib/HasSigDie.pm | 0 lib/base/t/sigdie.t | 2 +- lib/fields.pm | 2 +- pod/perldiag.pod | 8 +- pod/perlfunc.pod | 18 +++ 14 files changed, 584 insertions(+), 12 deletions(-) create mode 100644 lib/base/t/compile-time.t create mode 100644 lib/base/t/fields-5.6.0.t create mode 100644 lib/base/t/fields-5.8.0.t rename {t => lib/base/t}/lib/HasSigDie.pm (100%) diff --git a/MANIFEST b/MANIFEST index bd285c9..1295dc2 100755 --- a/MANIFEST +++ b/MANIFEST @@ -1819,10 +1819,14 @@ lib/autouse.t See if autouse works lib/base/Changes base.pm changelog lib/base.pm Establish IS-A relationship at compile time lib/base/t/base.t See if base works +lib/base/t/compile-time.t See if base works lib/base/t/fields-base.t See if fields work +lib/base/t/fields-5.6.0.t See if fields work +lib/base/t/fields-5.8.0.t See if fields work lib/base/t/fields.t See if fields work lib/base/t/isa.t See if base's behaviour doesn't change lib/base/t/lib/Dummy.pm Test module for base.pm +lib/base/t/lib/HasSigDie.pm Module for testing base.pm lib/base/t/sigdie.t See if base works with SIGDIE lib/base/t/version.t See if base works with versions lib/base/t/warnings.t See if base works with warnings @@ -3980,7 +3984,6 @@ t/lib/Filter/Simple/ImportTest.pm Helper file for Filter::Simple tests t/lib/filter-util.pl See if Filter::Util::Call works t/lib/h2ph.h Test header file for h2ph t/lib/h2ph.pht Generated output from h2ph.h by h2ph, for comparison -t/lib/HasSigDie.pm Module for testing base.pm t/lib/locale/latin1 Part of locale.t in Latin 1 t/lib/locale/utf8 Part of locale.t in UTF8 t/lib/MakeMaker/Test/Setup/BFD.pm MakeMaker test utilities diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 5aaf939..e609313 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -275,11 +275,9 @@ package Maintainers; 'base' => { 'MAINTAINER' => 'rgarcia', - 'DISTRIBUTION' => 'RGARCIA/base-2.12.tar.gz', + 'DISTRIBUTION' => 'RGARCIA/base-2.14.tar.gz', 'FILES' => q[lib/base.pm lib/fields.pm lib/base], - 'EXCLUDED' => [ qw( t/Dummy.pm t/compile-time.t t/fields-5.6.0.t - t/fields-5.8.0.t t/lib/HasSigDie.pm ) - ], + 'EXCLUDED' => [ qw( t/Dummy.pm ) ], 'CPAN' => 1, 'UPSTREAM' => "blead", }, @@ -1552,7 +1550,7 @@ package Maintainers; 'Safe' => { 'MAINTAINER' => 'rgarcia', - 'DISTRIBUTION' => 'RGARCIA/Safe-2.16.tar.gz', + 'DISTRIBUTION' => 'RGARCIA/Safe-2.17.tar.gz', 'FILES' => q[ext/Safe], 'CPAN' => 1, 'UPSTREAM' => "blead", diff --git a/ext/Safe/Safe.pm b/ext/Safe/Safe.pm index f611e0f..9d3d589 100644 --- a/ext/Safe/Safe.pm +++ b/ext/Safe/Safe.pm @@ -3,7 +3,7 @@ package Safe; use 5.003_11; use strict; -$Safe::VERSION = "2.16"; +$Safe::VERSION = "2.17"; # *** Don't declare any lexicals above this point *** # @@ -486,7 +486,7 @@ variable without any leading type marker. For example, ${$cpt->varglob('foo')} = "Hello world"; -=item reval (STRING) +=item reval (STRING, STRICT) This evaluates STRING as perl code inside the compartment. @@ -513,6 +513,10 @@ This behaviour differs from the beta distribution of the Safe extension where earlier versions of perl made it hard to mimic the return behaviour of the eval() command and the context was always scalar. +The formerly undocumented STRICT argument sets strictness: if true +'use strict;' is used, otherwise it uses 'no strict;'. B<Note>: if +STRICT is omitted 'no strict;' is the default. + Some points to note: If the entereval op is permitted then the code can use eval "..." to diff --git a/ext/Safe/t/safeuniversal.t b/ext/Safe/t/safeuniversal.t index d37d7ca..5ef3842 100644 --- a/ext/Safe/t/safeuniversal.t +++ b/ext/Safe/t/safeuniversal.t @@ -14,6 +14,7 @@ BEGIN { } use strict; +use warnings; use Test::More; use Safe; plan(tests => 6); @@ -22,6 +23,7 @@ my $c = new Safe; $c->permit(qw(require caller)); my $r = $c->reval(q! + no warnings 'redefine'; sub UNIVERSAL::isa { "pwned" } (bless[],"Foo")->isa("Foo"); !); @@ -32,6 +34,7 @@ is( (bless[],"Foo")->isa("Foo"), 1, "... but not outside" ); sub Foo::foo {} $r = $c->reval(q! + no warnings 'redefine'; sub UNIVERSAL::can { "pwned" } (bless[],"Foo")->can("foo"); !); diff --git a/lib/base/Changes b/lib/base/Changes index 7b1f611..12d615c 100644 --- a/lib/base/Changes +++ b/lib/base/Changes @@ -1,3 +1,9 @@ +2.14 + - fix problem with SIGDIE on perls < 5.10 + - Make @INC available in base.pm's error message when + a module can't be found. See CPAN bug #28582. + - Fix obscure bug introduced in 2.13 (Michael G Schwern) + 2.13 - push all classes at once in @ISA diff --git a/lib/base/t/compile-time.t b/lib/base/t/compile-time.t new file mode 100644 index 0000000..2be51f9 --- /dev/null +++ b/lib/base/t/compile-time.t @@ -0,0 +1,42 @@ +#!/usr/bin/perl -w + +use strict; +use Test::More tests => 3; + +my $Has_PH = $] < 5.009; +my $Field = $Has_PH ? "pseudo-hash field" : "class field"; + +{ + package Parent; + use fields qw(this that); + sub new { fields::new(shift) } +} + +{ + package Child; + use base qw(Parent); +} + +my Child $obj = Child->new; + +eval q(return; my Child $obj3 = $obj; $obj3->{notthere} = ""); +like $@, + qr/^No such .*field "notthere" in variable \$obj3 of type Child/, + "Compile failure of undeclared fields (helem)"; + +# Slices +# We should get compile time failures field name typos +SKIP: { + skip("Pseudo-hashes do not support compile-time slice checks", 2) + if $Has_PH; + + eval q(return; my Child $obj3 = $obj; my $k; @$obj3{$k,'notthere'} = ()); + like $@, + qr/^No such .*field "notthere" in variable \$obj3 of type Child/, + "Compile failure of undeclared fields (hslice)"; + + eval q(return; my Child $obj3 = $obj; my $k; @{$obj3}{$k,'notthere'} = ()); + like + $@, qr/^No such .*field "notthere" in variable \$obj3 of type Child/, + "Compile failure of undeclared fields (hslice (block form))"; +} diff --git a/lib/base/t/fields-5.6.0.t b/lib/base/t/fields-5.6.0.t new file mode 100644 index 0000000..93bca34 --- /dev/null +++ b/lib/base/t/fields-5.6.0.t @@ -0,0 +1,228 @@ +# The fields.pm and base.pm regression tests from 5.6.0 + +# We skip this on 5.9.0 and up since pseudohashes were removed and a lot +# of it won't work. +if( $] >= 5.009 ) { + print "1..0 # skip pseudo-hashes removed in 5.9.0\n"; + exit; +} + +use strict; +use vars qw($Total_tests); + +my $test_num = 1; +BEGIN { $| = 1; $^W = 1; } +print "1..$Total_tests\n"; +use fields; +use base; +print "ok $test_num\n"; +$test_num++; + +# Insert your test code below (better if it prints "ok 13" +# (correspondingly "not ok 13") depending on the success of chunk 13 +# of the test code): +sub ok { + my($test, $name) = @_; + print "not " unless $test; + print "ok $test_num"; + print " - $name" if defined $name; + print "\n"; + $test_num++; +} + +sub eqarray { + my($a1, $a2) = @_; + return 0 unless @$a1 == @$a2; + my $ok = 1; + for (0..$#{$a1}) { + unless($a1->[$_] eq $a2->[$_]) { + $ok = 0; + last; + } + } + return $ok; +} + +# Change this to your # of ok() calls + 1 +BEGIN { $Total_tests = 14 } + + +my $w; + +BEGIN { + $^W = 1; + + $SIG{__WARN__} = sub { + if ($_[0] =~ /^Hides field 'b1' in base class/) { + $w++; + return; + } + print $_[0]; + }; +} + +use strict; +use vars qw($DEBUG); + +package B1; +use fields qw(b1 b2 b3); + +package B2; +use fields '_b1'; +use fields qw(b1 _b2 b2); + +sub new { bless [], shift } + +package D1; +use base 'B1'; +use fields qw(d1 d2 d3); + +package D2; +use base 'B1'; +use fields qw(_d1 _d2); +use fields qw(d1 d2); + +package D3; +use base 'B2'; +use fields qw(b1 d1 _b1 _d1); # hide b1 + +package D4; +use base 'D3'; +use fields qw(_d3 d3); + +package M; +sub m {} + +package D5; +use base qw(M B2); + +package Foo::Bar; +use base 'B1'; + +package Foo::Bar::Baz; +use base 'Foo::Bar'; +use fields qw(foo bar baz); + +# Test repeatability for when modules get reloaded. +package B1; +use fields qw(b1 b2 b3); + +package D3; +use base 'B2'; +use fields qw(b1 d1 _b1 _d1); # hide b1 + +package main; + +sub fstr { + my $h = shift; + my @tmp; + for my $k (sort {$h->{$a} <=> $h->{$b}} keys %$h) { + my $v = $h->{$k}; + push(@tmp, "$k:$v"); + } + my $str = join(",", @tmp); + print "$h => $str\n" if $DEBUG; + $str; +} + +my %expect; +BEGIN { + %expect = ( + B1 => "b1:1,b2:2,b3:3", + B2 => "_b1:1,b1:2,_b2:3,b2:4", + D1 => "b1:1,b2:2,b3:3,d1:4,d2:5,d3:6", + D2 => "b1:1,b2:2,b3:3,_d1:4,_d2:5,d1:6,d2:7", + D3 => "b2:4,b1:5,d1:6,_b1:7,_d1:8", + D4 => "b2:4,b1:5,d1:6,_d3:9,d3:10", + D5 => "b1:2,b2:4", + 'Foo::Bar::Baz' => 'b1:1,b2:2,b3:3,foo:4,bar:5,baz:6', + ); + $Total_tests += int(keys %expect); +} +my $testno = 0; +while (my($class, $exp) = each %expect) { + no strict 'refs'; + my $fstr = fstr(\%{$class."::FIELDS"}); + ok( $fstr eq $exp, "'$fstr' eq '$exp'" ); +} + +# Did we get the appropriate amount of warnings? +ok( $w == 1 ); + +# A simple object creation and AVHV attribute access test +my B2 $obj1 = D3->new; +$obj1->{b1} = "B2"; +my D3 $obj2 = $obj1; +$obj2->{b1} = "D3"; + +ok( $obj1->[2] eq "B2" && $obj1->[5] eq "D3" ); + +# We should get compile time failures field name typos +eval q{ my D3 $obj3 = $obj2; $obj3->{notthere} = "" }; +ok( $@ && $@ =~ /^No such pseudo-hash field "notthere"/, + 'compile error -- field name typos' ); + + +# Slices +if( $] >= 5.006 ) { + @$obj1{"_b1", "b1"} = (17, 29); + ok( "@$obj1[1,2]" eq "17 29" ); + + @$obj1[1,2] = (44,28); + ok( "@$obj1{'b1','_b1','b1'}" eq "28 44 28" ); +} +else { + ok( 1, 'test skipped for perl < 5.6.0' ); + ok( 1, 'test skipped for perl < 5.6.0' ); +} + +my $ph = fields::phash(a => 1, b => 2, c => 3); +ok( fstr($ph) eq 'a:1,b:2,c:3' ); + +$ph = fields::phash([qw/a b c/], [1, 2, 3]); +ok( fstr($ph) eq 'a:1,b:2,c:3' ); + +# The way exists() works with psuedohashes changed from 5.005 to 5.6 +$ph = fields::phash([qw/a b c/], [1]); +if( $] > 5.006 ) { + ok( !( exists $ph->{b} or exists $ph->{c} or !exists $ph->{a} ) ); +} +else { + ok( !( defined $ph->{b} or defined $ph->{c} or !defined $ph->{a} ) ); +} + +eval { $ph = fields::phash("odd") }; +ok( $@ && $@ =~ /^Odd number of/ ); + + +# check if fields autovivify +if ( $] > 5.006 ) { + package Foo; + use fields qw(foo bar); + sub new { bless [], $_[0]; } + + package main; + my Foo $a = Foo->new(); + $a->{foo} = ['a', 'ok', 'c']; + $a->{bar} = { A => 'ok' }; + ok( $a->{foo}[1] eq 'ok' ); + ok( $a->{bar}->{A} eq 'ok' ); +} +else { + ok( 1, 'test skipped for perl < 5.6.0' ); + ok( 1, 'test skipped for perl < 5.6.0' ); +} + +# check if fields autovivify +{ + package Bar; + use fields qw(foo bar); + sub new { return fields::new($_[0]) } + + package main; + my Bar $a = Bar::->new(); + $a->{foo} = ['a', 'ok', 'c']; + $a->{bar} = { A => 'ok' }; + ok( $a->{foo}[1] eq 'ok' ); + ok( $a->{bar}->{A} eq 'ok' ); +} diff --git a/lib/base/t/fields-5.8.0.t b/lib/base/t/fields-5.8.0.t new file mode 100644 index 0000000..2da1412 --- /dev/null +++ b/lib/base/t/fields-5.8.0.t @@ -0,0 +1,254 @@ +#!/usr/bin/perl -w + +# We skip this on 5.9.0 and up since pseudohashes were removed and a lot of +# it won't work. +if( $] >= 5.009 ) { + print "1..0 # skip pseudo-hashes removed in 5.9.0\n"; + exit; +} + + +my $w; + +BEGIN { + $SIG{__WARN__} = sub { + if ($_[0] =~ /^Hides field 'b1' in base class/) { + $w++; + } + else { + print STDERR $_[0]; + } + }; +} + +use strict; +use vars qw($DEBUG); + +package B1; +use fields qw(b1 b2 b3); + +package B2; +use fields '_b1'; +use fields qw(b1 _b2 b2); + +sub new { bless [], shift } + +package D1; +use base 'B1'; +use fields qw(d1 d2 d3); + +package D2; +use base 'B1'; +use fields qw(_d1 _d2); +use fields qw(d1 d2); + +package D3; +use base 'B2'; +use fields qw(b1 d1 _b1 _d1); # hide b1 + +package D4; +use base 'D3'; +use fields qw(_d3 d3); + +package M; +sub m {} + +package D5; +use base qw(M B2); + +package Foo::Bar; +use base 'B1'; + +package Foo::Bar::Baz; +use base 'Foo::Bar'; +use fields qw(foo bar baz); + +# Test repeatability for when modules get reloaded. +package B1; +use fields qw(b1 b2 b3); + +package D3; +use base 'B2'; +use fields qw(b1 d1 _b1 _d1); # hide b1 + +package main; + +sub fstr { + local $SIG{__WARN__} = sub { + return if $_[0] =~ /^Pseudo-hashes are deprecated/ + }; + + my $h = shift; + my @tmp; + for my $k (sort {$h->{$a} <=> $h->{$b}} keys %$h) { + my $v = $h->{$k}; + push(@tmp, "$k:$v"); + } + my $str = join(",", @tmp); + print "$h => $str\n" if $DEBUG; + $str; +} + +my %expect = ( + B1 => "b1:1,b2:2,b3:3", + B2 => "_b1:1,b1:2,_b2:3,b2:4", + D1 => "b1:1,b2:2,b3:3,d1:4,d2:5,d3:6", + D2 => "b1:1,b2:2,b3:3,_d1:4,_d2:5,d1:6,d2:7", + D3 => "b2:4,b1:5,d1:6,_b1:7,_d1:8", + D4 => "b2:4,b1:5,d1:6,_d3:9,d3:10", + D5 => "b1:2,b2:4", + 'Foo::Bar::Baz' => 'b1:1,b2:2,b3:3,foo:4,bar:5,baz:6', +); + +print "1..", int(keys %expect)+21, "\n"; +my $testno = 0; +while (my($class, $exp) = each %expect) { + no strict 'refs'; + my $fstr = fstr(\%{$class."::FIELDS"}); + print "EXP: $exp\nGOT: $fstr\nnot " unless $fstr eq $exp; + print "ok ", ++$testno, "\n"; +} + +# Did we get the appropriate amount of warnings? +print "not " unless $w == 1; +print "ok ", ++$testno, "\n"; + +# A simple object creation and AVHV attribute access test +my B2 $obj1 = D3->new; +$obj1->{b1} = "B2"; +my D3 $obj2 = $obj1; +$obj2->{b1} = "D3"; + +print "not " unless $obj1->[2] eq "B2" && $obj1->[5] eq "D3"; +print "ok ", ++$testno, "\n"; + +# We should get compile time failures field name typos +eval q(my D3 $obj3 = $obj2; $obj3->{notthere} = ""); +print "not " unless $@ && $@ =~ /^No such pseudo-hash field "notthere"/; +print "ok ", ++$testno, "\n"; + +# Slices +...@$obj1{"_b1", "b1"} = (17, 29); +print "not " unless "@$obj1[1,2]" eq "17 29"; +print "ok ", ++$testno, "\n"; +...@$obj1[1,2] = (44,28); +print "not " unless "@$obj1{'b1','_b1','b1'}" eq "28 44 28"; +print "ok ", ++$testno, "\n"; + +{ + local $SIG{__WARN__} = sub { + return if $_[0] =~ /^Pseudo-hashes are deprecated/ + }; + + my $ph = fields::phash(a => 1, b => 2, c => 3); + print "not " unless fstr($ph) eq 'a:1,b:2,c:3'; + print "ok ", ++$testno, "\n"; + + $ph = fields::phash([qw/a b c/], [1, 2, 3]); + print "not " unless fstr($ph) eq 'a:1,b:2,c:3'; + print "ok ", ++$testno, "\n"; + + $ph = fields::phash([qw/a b c/], [1]); + print "not " if exists $ph->{b} or exists $ph->{c} or !exists $ph->{a}; + print "ok ", ++$testno, "\n"; + + eval '$ph = fields::phash("odd")'; + print "not " unless $@ && $@ =~ /^Odd number of/; + print "ok ", ++$testno, "\n"; +} + +#fields::_dump(); + +# check if fields autovivify +{ + package Foo; + use fields qw(foo bar); + sub new { bless [], $_[0]; } + + package main; + my Foo $a = Foo->new(); + $a->{foo} = ['a', 'ok ' . ++$testno, 'c']; + $a->{bar} = { A => 'ok ' . ++$testno }; + print $a->{foo}[1], "\n"; + print $a->{bar}->{A}, "\n"; +} + +# check if fields autovivify +{ + package Bar; + use fields qw(foo bar); + sub new { return fields::new($_[0]) } + + package main; + my Bar $a = Bar::->new(); + $a->{foo} = ['a', 'ok ' . ++$testno, 'c']; + $a->{bar} = { A => 'ok ' . ++$testno }; + print $a->{foo}[1], "\n"; + print $a->{bar}->{A}, "\n"; +} + + +# Test $VERSION bug +package No::Version; + +use vars qw($Foo); +sub VERSION { 42 } + +package Test::Version; + +use base qw(No::Version); +print "# $No::Version::VERSION\nnot " unless $No::Version::VERSION =~ /set by base\.pm/; +print "ok ", ++$testno ,"\n"; + +# Test Inverse of $VERSION bug base.pm should not clobber existing $VERSION +package Has::Version; + +BEGIN { $Has::Version::VERSION = '42' }; + +package Test::Version2; + +use base qw(Has::Version); +print "#$Has::Version::VERSION\nnot " unless $Has::Version::VERSION eq '42'; +print "ok ", ++$testno ," # Has::Version\n"; + +package main; + +my $eval1 = q{ + { + package Eval1; + { + package Eval2; + use base 'Eval1'; + $Eval2::VERSION = "1.02"; + } + $Eval1::VERSION = "1.01"; + } +}; + +eval $eval1; +printf "# %s\nnot ", $@ if $@; +print "ok ", ++$testno ," # eval1\n"; + +print "# $Eval1::VERSION\nnot " unless $Eval1::VERSION == 1.01; +print "ok ", ++$testno ," # Eval1::VERSION\n"; + +print "# $Eval2::VERSION\nnot " unless $Eval2::VERSION == 1.02; +print "ok ", ++$testno ," # Eval2::VERSION\n"; + + +eval q{use base reallyReAlLyNotexists;}; +print "not " unless $@; +print "ok ", ++$testno, " # really not I\n"; + +eval q{use base reallyReAlLyNotexists;}; +print "not " unless $@; +print "ok ", ++$testno, " # really not II\n"; + +BEGIN { $Has::Version_0::VERSION = 0 } + +package Test::Version3; + +use base qw(Has::Version_0); +print "#$Has::Version_0::VERSION\nnot " unless $Has::Version_0::VERSION == 0; +print "ok ", ++$testno ," # Version_0\n"; + diff --git a/lib/base/t/fields-base.t b/lib/base/t/fields-base.t index d3e8c7b..b27f066 100644 --- a/lib/base/t/fields-base.t +++ b/lib/base/t/fields-base.t @@ -245,6 +245,11 @@ package main; my X $self = shift; $self = fields::new($self) unless ref $self; $self->{X1} = "x1"; + # FIXME. This code is dead on blead becase the test is skipped. + # The test states that it's being skipped because restricted hashes + # don't support a feature. Presumably we need to make that feature + # supported. Bah. + # use Devel::Peek; Dump($self); $self->{_X2} = "_x2"; return $self; } @@ -275,6 +280,13 @@ package main; package main; + if ($Has_PH) { my Z $c = Z->new(); is($c->get_X2, '_x2', "empty intermediate class"); + } + else { + SKIP: { + skip "restricted hashes don't support private fields properly", 1; + } + } } diff --git a/t/lib/HasSigDie.pm b/lib/base/t/lib/HasSigDie.pm similarity index 100% rename from t/lib/HasSigDie.pm rename to lib/base/t/lib/HasSigDie.pm diff --git a/lib/base/t/sigdie.t b/lib/base/t/sigdie.t index 9237463..4173c48 100644 --- a/lib/base/t/sigdie.t +++ b/lib/base/t/sigdie.t @@ -3,7 +3,7 @@ BEGIN { if( $ENV{PERL_CORE} ) { chdir 't' if -d 't'; - @INC = qw(../lib ../t/lib); + @INC = qw(../lib ../lib/base/t/lib); } } diff --git a/lib/fields.pm b/lib/fields.pm index 61f02a2..c90bc0a 100644 --- a/lib/fields.pm +++ b/lib/fields.pm @@ -11,7 +11,7 @@ unless( eval q{require warnings::register; warnings::register->import; 1} ) { } use vars qw(%attr $VERSION); -$VERSION = '2.13'; +$VERSION = '2.14'; # constant.pm is slow sub PUBLIC () { 2**0 } diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 6c950bd..69cdbd8 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -2190,8 +2190,12 @@ neither as a system call or an ioctl call (SIOCATMARK). =item $* is no longer supported (S deprecated, syntax) The special variable C<$*>, deprecated in older perls, has -been removed as of 5.9.0 and is no longer supported. You should use the -C<//m> and C<//s> regexp modifiers instead. +been removed as of 5.9.0 and is no longer supported. In previous versions of perl the use of +C<$*> enabled or disabled multi-line matching within a string. + +Instead of using C<$*> you should use the C</m> (and maybe C</s>) regexp +modifiers. (In older versions: when C<$*> was set to a true value then all regular +expressions behaved as if they were written using C</m>.) =item $# is no longer supported diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index 405d2b5..ddae4ed 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -5356,6 +5356,24 @@ Examples: use sort '_mergesort'; # note discouraging _ @new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old; + +Warning: Care is required when sorting the list returned from a function. + +If you want to sort returned by the function call: find_records(@key) then +you can use: + @contact = sort { $a cmp $b } find_records @key; + @contact = sort +find_records(@key); + @contact = sort &find_records(@key); + @contact = sort(find_records(@key)); + +If instead you want to sort the array @key with the comparison routine +find_records then you can use: + @contact = sort { find_records() } @key; + @contact = sort find_records(@key); + @contact = sort(find_records @key); + @contact = sort(find_records (@key)); + + If you're using strict, you I<must not> declare $a and $b as lexicals. They are package globals. That means if you're in the C<main> package and type -- Perl5 Master Repository
