Change 33945 by [EMAIL PROTECTED] on 2008/05/28 20:51:40
Integrate:
[ 33553]
Subject: [PATCH] apidoc mismatch for Perl_magic_clearhint
From: Vincent Pit <[EMAIL PROTECTED]>
Date: Mon, 24 Mar 2008 21:30:10 +0100
Message-ID: <[EMAIL PROTECTED]>
[ 33554]
Subject: [PATCH] IO::Socket::INET unnecessarily resolves "udp"
From: Niko Tyni <[EMAIL PROTECTED]>
Date: Mon, 24 Mar 2008 23:32:24 +0200
Message-Id: <[EMAIL PROTECTED]>
[ 33556]
Subject: [PATCH] borg parent.pm
From: "Yitzchak Scott-Thoennes" <[EMAIL PROTECTED]>
Date: Wed, 5 Mar 2008 17:19:32 -0800 (PST)
Message-ID: <[EMAIL PROTECTED]>
Plus bump base.pm's version to a non-alpha number
[ 33557]
Subject: Re: [PATCH] Double warning with perl -we 'my $a; substr $a, 0,
10,
From: Vincent Pit <[EMAIL PROTECTED]>
Date: Sat, 22 Mar 2008 13:37:42 +0100
Message-ID: <[EMAIL PROTECTED]>
[ 33560]
Use sv_setpvs() like a few lines before since change #33557
[ 33584]
Subject: [PATCH] MAD dump xml escape regex
From: Gerard Goossen <[EMAIL PROTECTED]>
Date: Thu, 27 Mar 2008 13:55:31 +0100
Message-ID: <[EMAIL PROTECTED]>
[ 33594]
Subject: [PATCH] Re: Tests failed on PPC64
From: Dominic Dunlop <[EMAIL PROTECTED]>
Message-Id: <[EMAIL PROTECTED]>
Date: Fri, 14 Mar 2008 14:45:39 +0100
[ 33608]
Subject: [PATCH] add -v to regen.pl and friends
From: "Robin Barker" <[EMAIL PROTECTED]>
Date: Wed, 19 Mar 2008 10:55:59 -0000
Message-ID: <[EMAIL PROTECTED]>
Affected files ...
... //depot/maint-5.10/perl/MANIFEST#28 integrate
... //depot/maint-5.10/perl/Makefile.SH#6 integrate
... //depot/maint-5.10/perl/Porting/Maintainers.pl#9 integrate
... //depot/maint-5.10/perl/dump.c#7 integrate
... //depot/maint-5.10/perl/ext/IO/lib/IO/Socket/INET.pm#2 integrate
... //depot/maint-5.10/perl/lib/base.pm#2 integrate
... //depot/maint-5.10/perl/lib/parent.pm#1 branch
... //depot/maint-5.10/perl/lib/parent/t/compile-time-file.t#1 branch
... //depot/maint-5.10/perl/lib/parent/t/compile-time.t#1 branch
... //depot/maint-5.10/perl/lib/parent/t/lib/Dummy.pm#1 branch
... //depot/maint-5.10/perl/lib/parent/t/lib/Dummy/Outside.pm#1 branch
... //depot/maint-5.10/perl/lib/parent/t/lib/Dummy2.plugin#1 branch
... //depot/maint-5.10/perl/lib/parent/t/lib/FileThatOnlyExistsAsPMC.pmc#1
branch
... //depot/maint-5.10/perl/lib/parent/t/lib/ReturnsFalse.pm#1 branch
... //depot/maint-5.10/perl/lib/parent/t/parent-classfromclassfile.t#1 branch
... //depot/maint-5.10/perl/lib/parent/t/parent-classfromfile.t#1 branch
... //depot/maint-5.10/perl/lib/parent/t/parent-pmc.t#1 branch
... //depot/maint-5.10/perl/lib/parent/t/parent-returns-false.t#1 branch
... //depot/maint-5.10/perl/lib/parent/t/parent.t#1 branch
... //depot/maint-5.10/perl/mad/t/p55.t#3 integrate
... //depot/maint-5.10/perl/mg.c#9 integrate
... //depot/maint-5.10/perl/pod/perlintern.pod#4 integrate
... //depot/maint-5.10/perl/pp.c#7 integrate
... //depot/maint-5.10/perl/regen.pl#4 integrate
... //depot/maint-5.10/perl/regen_lib.pl#3 integrate
... //depot/maint-5.10/perl/t/lib/warnings/9uninit#6 integrate
... //depot/maint-5.10/perl/t/op/reg_namedcapture.t#2 integrate
... //depot/maint-5.10/perl/t/op/switch.t#3 integrate
Differences ...
==== //depot/maint-5.10/perl/MANIFEST#28 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST#27~33943~ 2008-05-28 08:54:22.000000000 -0700
+++ perl/MANIFEST 2008-05-28 13:51:40.000000000 -0700
@@ -2327,6 +2327,19 @@
lib/Package/Constants/t/01_list.t Package::Constants tests
lib/Params/Check.pm Params::Check
lib/Params/Check/t/01_Params-Check.t Params::Check tests
+lib/parent.pm Establish an ISA relationship with base classes at compile time
+lib/parent/t/compile-time-file.t tests for parent.pm
+lib/parent/t/compile-time.t tests for parent.pm
+lib/parent/t/lib/Dummy2.plugin test files for parent.pm
+lib/parent/t/lib/Dummy.pm test files for parent.pm
+lib/parent/t/lib/Dummy/Outside.pm test files for parent.pm
+lib/parent/t/lib/FileThatOnlyExistsAsPMC.pmc test files for parent.pm
+lib/parent/t/lib/ReturnsFalse.pm test files for parent.pm
+lib/parent/t/parent-classfromclassfile.t tests for parent.pm
+lib/parent/t/parent-classfromfile.t tests for parent.pm
+lib/parent/t/parent-pmc.t tests for parent.pm
+lib/parent/t/parent-returns-false.t tests for parent.pm
+lib/parent/t/parent.t tests for parent.pm
lib/perl5db.pl Perl debugging routines
lib/perl5db.t Tests for the Perl debugger
lib/perl5db/t/eval-line-bug Tests for the Perl debugger
==== //depot/maint-5.10/perl/Makefile.SH#6 (text) ====
Index: perl/Makefile.SH
--- perl/Makefile.SH#5~33904~ 2008-05-21 09:37:54.000000000 -0700
+++ perl/Makefile.SH 2008-05-28 13:51:40.000000000 -0700
@@ -998,9 +998,12 @@
.PHONY: regen_headers regen_pods regen_all
-regen regen_headers: FORCE
+regen: FORCE
-perl regen.pl
+regen_headers: FORCE
+ -perl regen.pl -v
+
regen_pods: FORCE
-cd pod; $(LDLIBPTH) $(MAKE) regen_pods
==== //depot/maint-5.10/perl/Porting/Maintainers.pl#9 (text) ====
Index: perl/Porting/Maintainers.pl
--- perl/Porting/Maintainers.pl#8~33915~ 2008-05-23 07:57:46.000000000
-0700
+++ perl/Porting/Maintainers.pl 2008-05-28 13:51:40.000000000 -0700
@@ -17,6 +17,7 @@
'arandal' => 'Allison Randal <[EMAIL PROTECTED]>',
'audreyt' => 'Audrey Tang <[EMAIL PROTECTED]>',
'avar' => 'Ævar Arnfjörð Bjarmason <[EMAIL PROTECTED]>',
+ 'corion' => 'Max Maischein <[EMAIL PROTECTED]>',
'craig' => 'Craig Berry <[EMAIL PROTECTED]>',
'dankogai' => 'Dan Kogai <[EMAIL PROTECTED]>',
'dconway' => 'Damian Conway <[EMAIL PROTECTED]>',
@@ -652,6 +653,13 @@
'CPAN' => 1,
},
+ 'parent' =>
+ {
+ 'MAINTAINER' => 'corion',
+ 'FILES' => q[lib/parent lib/parent.pm],
+ 'CPAN' => 1,
+ },
+
'perlebcdic' =>
{
'MAINTAINER' => 'pvhp',
==== //depot/maint-5.10/perl/ext/IO/lib/IO/Socket/INET.pm#2 (text) ====
Index: perl/ext/IO/lib/IO/Socket/INET.pm
--- perl/ext/IO/lib/IO/Socket/INET.pm#1~32694~ 2007-12-22 01:23:09.000000000
-0800
+++ perl/ext/IO/lib/IO/Socket/INET.pm 2008-05-28 13:51:40.000000000 -0700
@@ -27,7 +27,7 @@
);
my %proto_number;
$proto_number{tcp} = Socket::IPPROTO_TCP() if defined &Socket::IPPROTO_TCP;
-$proto_number{upd} = Socket::IPPROTO_UDP() if defined &Socket::IPPROTO_UDP;
+$proto_number{udp} = Socket::IPPROTO_UDP() if defined &Socket::IPPROTO_UDP;
$proto_number{icmp} = Socket::IPPROTO_ICMP() if defined &Socket::IPPROTO_ICMP;
my %proto_name = reverse %proto_number;
==== //depot/maint-5.10/perl/lib/base.pm#2 (text) ====
Index: perl/lib/base.pm
--- perl/lib/base.pm#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/lib/base.pm 2008-05-28 13:51:40.000000000 -0700
@@ -2,7 +2,8 @@
use strict 'vars';
use vars qw($VERSION);
-$VERSION = '2.13';
+$VERSION = '2.14';
+$VERSION = eval $VERSION;
# constant.pm is slow
sub SUCCESS () { 1 }
@@ -192,6 +193,9 @@
=head1 DESCRIPTION
+Unless you are using the C<fields> pragma, consider this module discouraged
+in favor of the lighter-weight C<parent>.
+
Allows you to both load one or more modules, while setting up inheritance from
those modules at the same time. Roughly similar in effect to
==== //depot/maint-5.10/perl/lib/parent.pm#1 (text) ====
Index: perl/lib/parent.pm
--- /dev/null 2008-05-07 15:08:24.549929899 -0700
+++ perl/lib/parent.pm 2008-05-28 13:51:40.000000000 -0700
@@ -0,0 +1,136 @@
+package parent;
+use strict;
+use vars qw($VERSION);
+$VERSION = '0.221';
+
+sub import {
+ my $class = shift;
+
+ my $inheritor = caller(0);
+
+ if ( @_ and $_[0] eq '-norequire' ) {
+ shift @_;
+ } else {
+ for ( my @filename = @_ ) {
+ if ( $_ eq $inheritor ) {
+ warn "Class '$inheritor' tried to inherit from itself\n";
+ };
+
+ s{::|'}{/}g;
+ require "$_.pm"; # dies if the file is not found
+ }
+ }
+
+ {
+ no strict 'refs';
+ # This is more efficient than push for the new MRO
+ # at least until the new MRO is fixed
+ @{"$inheritor\::ISA"} = (@{"$inheritor\::ISA"} , @_);
+ };
+};
+
+"All your base are belong to us"
+
+__END__
+
+=head1 NAME
+
+parent - Establish an ISA relationship with base classes at compile time
+
+=head1 SYNOPSIS
+
+ package Baz;
+ use parent qw(Foo Bar);
+
+=head1 DESCRIPTION
+
+Allows you to both load one or more modules, while setting up inheritance from
+those modules at the same time. Mostly similar in effect to
+
+ package Baz;
+ BEGIN {
+ require Foo;
+ require Bar;
+ push @ISA, qw(Foo Bar);
+ }
+
+By default, every base class needs to live in a file of its own.
+If you want to have a subclass and its parent class in the same file, you
+can tell C<parent> not to load any modules by using the C<-norequire> switch:
+
+ package Foo;
+ sub exclaim { "I CAN HAS PERL" }
+
+ package DoesNotLoadFooBar;
+ use parent -norequire, 'Foo', 'Bar';
+ # will not go looking for Foo.pm or Bar.pm
+
+This is equivalent to the following code:
+
+ package Foo;
+ sub exclaim { "I CAN HAS PERL" }
+
+ package DoesNotLoadFooBar;
+ push @DoesNotLoadFooBar::ISA, 'Foo';
+
+This is also helpful for the case where a package lives within
+a differently named file:
+
+ package MyHash;
+ use Tie::Hash;
+ use parent -norequire, 'Tie::StdHash';
+
+This is equivalent to the following code:
+
+ package MyHash;
+ require Tie::Hash;
+ push @ISA, 'Tie::StdHash';
+
+If you want to load a subclass from a file that C<require> would
+not consider an eligible filename (that is, it does not end in
+either C<.pm> or C<.pmc>), use the following code:
+
+ package MySecondPlugin;
+ require './plugins/custom.plugin'; # contains Plugin::Custom
+ use parent -norequire, 'Plugin::Custom';
+
+=head1 DIAGNOSTICS
+
+=over 4
+
+=item Class 'Foo' tried to inherit from itself
+
+Attempting to inherit from yourself generates a warning.
+
+ use Foo;
+ use parent 'Foo';
+
+=back
+
+=head1 HISTORY
+
+This module was forked from L<base> to remove the cruft
+that had accumulated in it.
+
+=head1 CAVEATS
+
+=head1 SEE ALSO
+
+L<base>
+
+=head1 AUTHORS AND CONTRIBUTORS
+
+Rafaël Garcia-Suarez, Bart Lateur, Max Maischein, Anno Siegel, Michael Schwern
+
+=head1 MAINTAINER
+
+Max Maischein C< [EMAIL PROTECTED] >
+
+Copyright (c) 2007 Max Maischein C<< <[EMAIL PROTECTED]> >>
+Based on the idea of C<base.pm>, which was introduced with Perl 5.004_04.
+
+=head1 LICENSE
+
+This module is released under the same terms as Perl itself.
+
+=cut
==== //depot/maint-5.10/perl/lib/parent/t/compile-time-file.t#1 (text) ====
Index: perl/lib/parent/t/compile-time-file.t
--- /dev/null 2008-05-07 15:08:24.549929899 -0700
+++ perl/lib/parent/t/compile-time-file.t 2008-05-28 13:51:40.000000000
-0700
@@ -0,0 +1,47 @@
+#!/usr/bin/perl -w
+BEGIN {
+ if( $ENV{PERL_CORE} ) {
+ chdir 't' if -d 't';
+ chdir '../lib/parent';
+ @INC = '..';
+ }
+}
+
+use strict;
+use Test::More tests => 9;
+use lib 't/lib';
+
+{
+ package Child;
+ use parent 'Dummy';
+}
+
+{
+ package Child2;
+ require Dummy;
+ use parent -norequire, 'Dummy::InlineChild';
+}
+
+{
+ package Child3;
+ use parent "Dummy'Outside";
+}
+
+my $obj = {};
+bless $obj, 'Child';
+isa_ok $obj, 'Dummy';
+can_ok $obj, 'exclaim';
+is $obj->exclaim, "I CAN FROM Dummy", 'Inheritance is set up correctly';
+
+$obj = {};
+bless $obj, 'Child2';
+isa_ok $obj, 'Dummy::InlineChild';
+can_ok $obj, 'exclaim';
+is $obj->exclaim, "I CAN FROM Dummy::InlineChild", 'Inheritance is set up
correctly for inlined classes';
+
+$obj = {};
+bless $obj, 'Child3';
+isa_ok $obj, 'Dummy::Outside';
+can_ok $obj, 'exclaim';
+is $obj->exclaim, "I CAN FROM Dummy::Outside", "Inheritance is set up
correctly for classes inherited from via '";
+
==== //depot/maint-5.10/perl/lib/parent/t/compile-time.t#1 (text) ====
Index: perl/lib/parent/t/compile-time.t
--- /dev/null 2008-05-07 15:08:24.549929899 -0700
+++ perl/lib/parent/t/compile-time.t 2008-05-28 13:51:40.000000000 -0700
@@ -0,0 +1,21 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More tests => 3;
+
+{
+ package MyParent;
+ sub exclaim { "I CAN HAS PERL?" }
+}
+
+{
+ package Child;
+ use parent -norequire, 'MyParent';
+}
+
+my $obj = {};
+bless $obj, 'Child';
+isa_ok $obj, 'MyParent', 'Inheritance';
+can_ok $obj, 'exclaim';
+is $obj->exclaim, "I CAN HAS PERL?", 'Inheritance is set up correctly';
+
==== //depot/maint-5.10/perl/lib/parent/t/lib/Dummy.pm#1 (text) ====
Index: perl/lib/parent/t/lib/Dummy.pm
--- /dev/null 2008-05-07 15:08:24.549929899 -0700
+++ perl/lib/parent/t/lib/Dummy.pm 2008-05-28 13:51:40.000000000 -0700
@@ -0,0 +1,12 @@
+package Dummy;
+
+# Attempt to emulate a bug with finding the version in Exporter.
+$VERSION = '5.562';
+
+sub exclaim { "I CAN FROM " . __PACKAGE__ }
+
+package Dummy::InlineChild;
+
+sub exclaim { "I CAN FROM " . __PACKAGE__ }
+
+1;
==== //depot/maint-5.10/perl/lib/parent/t/lib/Dummy/Outside.pm#1 (text) ====
Index: perl/lib/parent/t/lib/Dummy/Outside.pm
--- /dev/null 2008-05-07 15:08:24.549929899 -0700
+++ perl/lib/parent/t/lib/Dummy/Outside.pm 2008-05-28 13:51:40.000000000
-0700
@@ -0,0 +1,6 @@
+package Dummy::Outside;
+
+sub exclaim { "I CAN FROM " . __PACKAGE__ }
+
+1;
+
==== //depot/maint-5.10/perl/lib/parent/t/lib/Dummy2.plugin#1 (text) ====
Index: perl/lib/parent/t/lib/Dummy2.plugin
--- /dev/null 2008-05-07 15:08:24.549929899 -0700
+++ perl/lib/parent/t/lib/Dummy2.plugin 2008-05-28 13:51:40.000000000 -0700
@@ -0,0 +1,7 @@
+package Dummy2;
+sub exclaim { "I CAN FROM " . __PACKAGE__ }
+
+package Dummy2::InlineChild;
+sub exclaim { "I CAN FROM " . __PACKAGE__ }
+
+1;
==== //depot/maint-5.10/perl/lib/parent/t/lib/FileThatOnlyExistsAsPMC.pmc#1
(text) ====
Index: perl/lib/parent/t/lib/FileThatOnlyExistsAsPMC.pmc
--- /dev/null 2008-05-07 15:08:24.549929899 -0700
+++ perl/lib/parent/t/lib/FileThatOnlyExistsAsPMC.pmc 2008-05-28
13:51:40.000000000 -0700
@@ -0,0 +1,5 @@
+package FileThatOnlyExistsAsPMC;
+
+sub exclaim { "I CAN FROM " . __PACKAGE__ }
+
+1;
==== //depot/maint-5.10/perl/lib/parent/t/lib/ReturnsFalse.pm#1 (text) ====
Index: perl/lib/parent/t/lib/ReturnsFalse.pm
--- /dev/null 2008-05-07 15:08:24.549929899 -0700
+++ perl/lib/parent/t/lib/ReturnsFalse.pm 2008-05-28 13:51:40.000000000
-0700
@@ -0,0 +1,5 @@
+package ReturnsFalse;
+
+sub exclaim { "I CAN FROM " . __PACKAGE__ }
+
+0;
==== //depot/maint-5.10/perl/lib/parent/t/parent-classfromclassfile.t#1 (text)
====
Index: perl/lib/parent/t/parent-classfromclassfile.t
--- /dev/null 2008-05-07 15:08:24.549929899 -0700
+++ perl/lib/parent/t/parent-classfromclassfile.t 2008-05-28
13:51:40.000000000 -0700
@@ -0,0 +1,21 @@
+#!/usr/bin/perl -w
+
+BEGIN {
+ if( $ENV{PERL_CORE} ) {
+ chdir 't' if -d 't';
+ chdir '../lib/parent';
+ @INC = '..';
+ }
+}
+
+use strict;
+use Test::More tests => 3;
+use lib 't/lib';
+
+use_ok('parent');
+
+# Tests that a bare (non-double-colon) class still loads
+# and does not get treated as a file:
+eval q{package Test1; require Dummy; use parent -norequire,
'Dummy::InlineChild'; };
+is $@, '', "Loading an unadorned class works";
+isn't $INC{"Dummy.pm"}, undef, 'We loaded Dummy.pm';
==== //depot/maint-5.10/perl/lib/parent/t/parent-classfromfile.t#1 (text) ====
Index: perl/lib/parent/t/parent-classfromfile.t
--- /dev/null 2008-05-07 15:08:24.549929899 -0700
+++ perl/lib/parent/t/parent-classfromfile.t 2008-05-28 13:51:40.000000000
-0700
@@ -0,0 +1,25 @@
+#!/usr/bin/perl -w
+
+BEGIN {
+ if( $ENV{PERL_CORE} ) {
+ chdir 't' if -d 't';
+ chdir '../lib/parent';
+ @INC = '..';
+ }
+}
+
+use strict;
+use Test::More tests => 4;
+use lib 't/lib';
+
+use_ok('parent');
+
+my $base = './t';
+
+# Tests that a bare (non-double-colon) class still loads
+# and does not get treated as a file:
+eval sprintf q{package Test2; require '%s/lib/Dummy2.plugin'; use parent
-norequire, 'Dummy2::InlineChild' }, $base;
+is $@, '', "Loading a class from a file works";
+isn't $INC{"$base/lib/Dummy2.plugin"}, undef, "We loaded the plugin file";
+my $o = bless {}, 'Test2';
+isa_ok $o, 'Dummy2::InlineChild';
==== //depot/maint-5.10/perl/lib/parent/t/parent-pmc.t#1 (text) ====
Index: perl/lib/parent/t/parent-pmc.t
--- /dev/null 2008-05-07 15:08:24.549929899 -0700
+++ perl/lib/parent/t/parent-pmc.t 2008-05-28 13:51:40.000000000 -0700
@@ -0,0 +1,32 @@
+#!/usr/bin/perl -w
+BEGIN {
+ if( $ENV{PERL_CORE} ) {
+ chdir 't' if -d 't';
+ chdir '../lib/parent';
+ @INC = '..';
+ }
+}
+
+use strict;
+use Test::More;
+use lib 't/lib';
+
+plan skip_all => ".pmc are only available with 5.6 and later" if $] < 5.006;
+plan tests => 3;
+
+use vars qw($got_here);
+
+my $res = eval q{
+ package MyTest;
+
+ use parent 'FileThatOnlyExistsAsPMC';
+
+ 1
+};
+my $error = $@;
+
+is $res, 1, "Block ran until the end";
+is $error, '', "No error";
+
+my $obj = bless {}, 'FileThatOnlyExistsAsPMC';
+can_ok $obj, 'exclaim';
==== //depot/maint-5.10/perl/lib/parent/t/parent-returns-false.t#1 (text) ====
Index: perl/lib/parent/t/parent-returns-false.t
--- /dev/null 2008-05-07 15:08:24.549929899 -0700
+++ perl/lib/parent/t/parent-returns-false.t 2008-05-28 13:51:40.000000000
-0700
@@ -0,0 +1,26 @@
+#!/usr/bin/perl -w
+BEGIN {
+ if( $ENV{PERL_CORE} ) {
+ chdir 't' if -d 't';
+ chdir '../lib/parent';
+ @INC = '..';
+ }
+}
+
+use strict;
+use Test::More tests => 2;
+use lib 't/lib';
+
+use vars qw($got_here);
+
+my $res = eval q{
+ package MyTest;
+
+ use parent 'ReturnsFalse';
+
+ $main::got_here++
+};
+my $error = $@;
+
+is $got_here, undef, "The block did not run to its end.";
+like $error, q{/^ReturnsFalse.pm did not return a true value at /}, "A module
that returns a false value raises an error";
==== //depot/maint-5.10/perl/lib/parent/t/parent.t#1 (text) ====
Index: perl/lib/parent/t/parent.t
--- /dev/null 2008-05-07 15:08:24.549929899 -0700
+++ perl/lib/parent/t/parent.t 2008-05-28 13:51:40.000000000 -0700
@@ -0,0 +1,81 @@
+#!/usr/bin/perl -w
+
+BEGIN {
+ if( $ENV{PERL_CORE} ) {
+ chdir 't' if -d 't';
+ chdir '../lib/parent';
+ @INC = '..';
+ }
+}
+
+use strict;
+use Test::More tests => 10;
+
+use_ok('parent');
+
+
+package No::Version;
+
+use vars qw($Foo);
+sub VERSION { 42 }
+
+package Test::Version;
+
+use parent -norequire, 'No::Version';
+::is( $No::Version::VERSION, undef, '$VERSION gets left alone' );
+
+# Test Inverse: parent.pm should not clobber existing $VERSION
+package Has::Version;
+
+BEGIN { $Has::Version::VERSION = '42' };
+
+package Test::Version2;
+
+use parent -norequire, 'Has::Version';
+::is( $Has::Version::VERSION, 42 );
+
+package main;
+
+my $eval1 = q{
+ {
+ package Eval1;
+ {
+ package Eval2;
+ use parent -norequire, 'Eval1';
+ $Eval2::VERSION = "1.02";
+ }
+ $Eval1::VERSION = "1.01";
+ }
+};
+
+eval $eval1;
+is( $@, '' );
+
+# String comparisons, just to be safe from floating-point errors
+is( $Eval1::VERSION, '1.01' );
+
+is( $Eval2::VERSION, '1.02' );
+
+
+eval q{use parent 'reallyReAlLyNotexists'};
+like( $@, q{/^Can't locate reallyReAlLyNotexists.pm in [EMAIL PROTECTED]
\([EMAIL PROTECTED] contains:/}, 'baseclass that does not exist');
+
+eval q{use parent 'reallyReAlLyNotexists'};
+like( $@, q{/^Can't locate reallyReAlLyNotexists.pm in [EMAIL PROTECTED]
\([EMAIL PROTECTED] contains:/}, ' still failing on 2nd load');
+{
+ my $warning;
+ local $SIG{__WARN__} = sub { $warning = shift };
+ eval q{package HomoGenous; use parent 'HomoGenous';};
+ like($warning, q{/^Class 'HomoGenous' tried to inherit from itself/},
+ ' self-inheriting');
+}
+
+{
+ BEGIN { $Has::Version_0::VERSION = 0 }
+
+ package Test::Version3;
+
+ use parent -norequire, 'Has::Version_0';
+ ::is( $Has::Version_0::VERSION, 0, '$VERSION==0 preserved' );
+}
+
==== //depot/maint-5.10/perl/mad/t/p55.t#3 (text) ====
Index: perl/mad/t/p55.t
--- perl/mad/t/p55.t#2~33943~ 2008-05-28 08:54:22.000000000 -0700
+++ perl/mad/t/p55.t 2008-05-28 13:51:40.000000000 -0700
@@ -75,30 +75,10 @@
../t/op/exec.t
../t/io/say.t
-../t/io/open.t
-../t/op/gv.t
-../t/op/re.t
-../t/op/tr.t
-../t/op/die.t
-../t/op/pat.t
-../t/op/reg_namedcapture.t
-../t/op/reg_email.t
-../t/op/reg_nc_tie.t
-../t/op/utf8decode.t
../t/op/state.t
-../t/op/subst.t
-../t/op/goto.t
../t/op/tiehandle.t
-../t/op/pack.t
../t/op/each_array.t
-../t/op/sprintf.t
-../t/op/attrs.t
-../t/op/universal.t
-../t/op/regexp.t
../t/lib/cygwin.t
-../t/run/switchd.t
-../t/comp/proto.t
-../t/win32/system.t
|;
my @files;
==== //depot/maint-5.10/perl/mg.c#9 (text) ====
Index: perl/mg.c
--- perl/mg.c#8~33943~ 2008-05-28 08:54:22.000000000 -0700
+++ perl/mg.c 2008-05-28 13:51:40.000000000 -0700
@@ -3039,7 +3039,7 @@
}
/*
-=for apidoc magic_sethint
+=for apidoc magic_clearhint
Triggered by a delete from %^H, records the key to
C<PL_compiling.cop_hints_hash>.
==== //depot/maint-5.10/perl/pod/perlintern.pod#4 (text+w) ====
Index: perl/pod/perlintern.pod
--- perl/pod/perlintern.pod#3~33135~ 2008-01-30 11:50:56.000000000 -0800
+++ perl/pod/perlintern.pod 2008-05-28 13:51:40.000000000 -0700
@@ -433,12 +433,25 @@
=over 8
-=item magic_sethint
-X<magic_sethint>
+=item magic_clearhint
+X<magic_clearhint>
Triggered by a delete from %^H, records the key to
C<PL_compiling.cop_hints_hash>.
+ int magic_clearhint(SV* sv, MAGIC* mg)
+
+=for hackers
+Found in file mg.c
+
+=item magic_sethint
+X<magic_sethint>
+
+Triggered by a store to %^H, records the key/value pair to
+C<PL_compiling.cop_hints_hash>. It is assumed that hints aren't storing
+anything that would need a deep copy. Maybe we should warn if we find a
+reference.
+
int magic_sethint(SV* sv, MAGIC* mg)
=for hackers
==== //depot/maint-5.10/perl/pp.c#7 (text) ====
Index: perl/pp.c
--- perl/pp.c#6~33921~ 2008-05-24 09:32:36.000000000 -0700
+++ perl/pp.c 2008-05-28 13:51:40.000000000 -0700
@@ -3172,6 +3172,8 @@
repl = SvPV_const(repl_sv_copy, repl_len);
repl_is_utf8 = DO_UTF8(repl_sv_copy) && SvCUR(sv);
}
+ if (!SvOK(sv))
+ sv_setpvs(sv, "");
sv_insert(sv, pos, rem, repl, repl_len);
if (repl_is_utf8)
SvUTF8_on(sv);
@@ -3191,7 +3193,7 @@
else if (SvOK(sv)) /* is it defined ? */
(void)SvPOK_only_UTF8(sv);
else
- sv_setpvn(sv,"",0); /* avoid lexical reincarnation */
+ sv_setpvs(sv, ""); /* avoid lexical reincarnation */
}
if (SvTYPE(TARG) < SVt_PVLV) {
==== //depot/maint-5.10/perl/regen.pl#4 (text) ====
Index: perl/regen.pl
--- perl/regen.pl#3~33944~ 2008-05-28 11:24:46.000000000 -0700
+++ perl/regen.pl 2008-05-28 13:51:40.000000000 -0700
@@ -11,7 +11,6 @@
use strict;
my $perl = $^X;
-require 'regen_lib.pl';
# keep warnings.pl in sync with the CPAN distribution by not requiring core
# changes. Um, what ?
# safer_unlink ("warnings.h", "lib/warnings.pm");
@@ -45,10 +44,11 @@
}
foreach my $pl (keys %gen) {
- print "$^X $pl\n";
+ my @command = ($^X, $pl, @ARGV);
+ print "@command\n";
my %cksum0;
%cksum0 = do_cksum($pl) unless $pl eq 'warnings.pl'; # the files were removed
- system "$^X $pl";
+ system @command;
next if $pl eq 'warnings.pl'; # the files were removed
my %cksum1 = do_cksum($pl);
my @chg;
==== //depot/maint-5.10/perl/regen_lib.pl#3 (text) ====
Index: perl/regen_lib.pl
--- perl/regen_lib.pl#2~33944~ 2008-05-28 11:24:46.000000000 -0700
+++ perl/regen_lib.pl 2008-05-28 13:51:40.000000000 -0700
@@ -1,6 +1,6 @@
#!/usr/bin/perl -w
use strict;
-use vars qw($Is_W32 $Is_OS2 $Is_Cygwin $Is_NetWare $Needs_Write);
+use vars qw($Is_W32 $Is_OS2 $Is_Cygwin $Is_NetWare $Needs_Write $Verbose);
use Config; # Remember, this is running using an existing perl
use File::Compare;
use Symbol;
@@ -17,6 +17,8 @@
$Needs_Write = $Is_OS2 || $Is_W32 || $Is_Cygwin || $Is_NetWare;
[EMAIL PROTECTED] = grep { not($_ eq '-v' and $Verbose = 1) } @ARGV;
+
sub safer_unlink {
my @names = @_;
my $cnt = 0;
@@ -44,7 +46,7 @@
my ($from, $to) = @_;
if (compare($from, $to) == 0) {
- warn "no changes between '$from' & '$to'\n";
+ warn "no changes between '$from' & '$to'\n" if $Verbose;
safer_unlink($from);
return;
}
==== //depot/maint-5.10/perl/t/lib/warnings/9uninit#6 (text) ====
Index: perl/t/lib/warnings/9uninit
--- perl/t/lib/warnings/9uninit#5~33944~ 2008-05-28 11:24:46.000000000
-0700
+++ perl/t/lib/warnings/9uninit 2008-05-28 13:51:40.000000000 -0700
@@ -874,7 +874,6 @@
Use of uninitialized value $m2 in substr at - line 7.
Use of uninitialized value $g1 in substr at - line 7.
Use of uninitialized value $m1 in substr at - line 7.
-Use of uninitialized value $m1 in substr at - line 7.
Use of uninitialized value $g1 in substr at - line 8.
Use of uninitialized value $m1 in substr at - line 8.
Use of uninitialized value in scalar assignment at - line 8.
==== //depot/maint-5.10/perl/t/op/reg_namedcapture.t#2 (text) ====
Index: perl/t/op/reg_namedcapture.t
--- perl/t/op/reg_namedcapture.t#1~32694~ 2007-12-22 01:23:09.000000000
-0800
+++ perl/t/op/reg_namedcapture.t 2008-05-28 13:51:40.000000000 -0700
@@ -3,9 +3,13 @@
BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
+ unless ( -r "$INC[0]/Errno.pm") {
+ print "1..0 # Skip: Errno.pm not yet available\n";
+ exit 0;
+ }
}
-# WARNING: Do not use anymodules as part of this test code.
+# WARNING: Do not directly use any modules as part of this test code.
# We could get action at a distance that would invalidate the tests.
print "1..2\n";
@@ -15,6 +19,8 @@
'X'=~/(?<X>X)/;
print eval '*X{HASH}{X} || 1' ? "" :"not ","ok ",++$test,"\n";
-# And since its a similar case we check %! as well
+# And since it's a similar case we check %! as well. Note that
+# this can't be done until ../lib/Errno.pm is in place, as the
+# glob hits $!, which needs that module.
*Y = *!;
print 0<keys(%Y) ? "" :"not ","ok ",++$test,"\n";
==== //depot/maint-5.10/perl/t/op/switch.t#3 (text) ====
Index: perl/t/op/switch.t
--- perl/t/op/switch.t#2~33943~ 2008-05-28 08:54:22.000000000 -0700
+++ perl/t/op/switch.t 2008-05-28 13:51:40.000000000 -0700
@@ -802,98 +802,101 @@
is($ok2, 1, "Calling sub indirectly (false)");
}
-# Test overloading
-{ package OverloadTest;
-
- use overload '""' => sub{"string value of obj"};
-
- use overload "~~" => sub {
- my ($self, $other, $reversed) = @_;
- if ($reversed) {
- $self->{left} = $other;
- $self->{right} = $self;
- $self->{reversed} = 1;
- } else {
- $self->{left} = $self;
- $self->{right} = $other;
- $self->{reversed} = 0;
- }
- $self->{called} = 1;
- return $self->{retval};
- };
+SKIP: {
+ skip "Scalar/Util.pm not yet available", 20
+ unless -r "$INC[0]/Scalar/Util.pm";
+ # Test overloading
+ { package OverloadTest;
+
+ use overload '""' => sub{"string value of obj"};
+
+ use overload "~~" => sub {
+ my ($self, $other, $reversed) = @_;
+ if ($reversed) {
+ $self->{left} = $other;
+ $self->{right} = $self;
+ $self->{reversed} = 1;
+ } else {
+ $self->{left} = $self;
+ $self->{right} = $other;
+ $self->{reversed} = 0;
+ }
+ $self->{called} = 1;
+ return $self->{retval};
+ };
- sub new {
- my ($pkg, $retval) = @_;
- bless {
- called => 0,
- retval => $retval,
- }, $pkg;
+ sub new {
+ my ($pkg, $retval) = @_;
+ bless {
+ called => 0,
+ retval => $retval,
+ }, $pkg;
+ }
+ }
+
+ {
+ my $test = "Overloaded obj in given (true)";
+ my $obj = OverloadTest->new(1);
+ my $matched;
+ given($obj) {
+ when ("other arg") {$matched = 1}
+ default {$matched = 0}
+ }
+
+ is($obj->{called}, 1, "$test: called");
+ ok($matched, "$test: matched");
+ is($obj->{left}, "string value of obj", "$test: left");
+ is($obj->{right}, "other arg", "$test: right");
+ ok(!$obj->{reversed}, "$test: not reversed");
}
-}
-{
- my $test = "Overloaded obj in given (true)";
- my $obj = OverloadTest->new(1);
- my $matched;
- given($obj) {
- when ("other arg") {$matched = 1}
- default {$matched = 0}
- }
+ {
+ my $test = "Overloaded obj in given (false)";
+ my $obj = OverloadTest->new(0);
+ my $matched;
+ given($obj) {
+ when ("other arg") {$matched = 1}
+ }
- is($obj->{called}, 1, "$test: called");
- ok($matched, "$test: matched");
- is($obj->{left}, "string value of obj", "$test: left");
- is($obj->{right}, "other arg", "$test: right");
- ok(!$obj->{reversed}, "$test: not reversed");
-}
-
-{
- my $test = "Overloaded obj in given (false)";
- my $obj = OverloadTest->new(0);
- my $matched;
- given($obj) {
- when ("other arg") {$matched = 1}
+ is($obj->{called}, 1, "$test: called");
+ ok(!$matched, "$test: not matched");
+ is($obj->{left}, "string value of obj", "$test: left");
+ is($obj->{right}, "other arg", "$test: right");
+ ok(!$obj->{reversed}, "$test: not reversed");
}
-
- is($obj->{called}, 1, "$test: called");
- ok(!$matched, "$test: not matched");
- is($obj->{left}, "string value of obj", "$test: left");
- is($obj->{right}, "other arg", "$test: right");
- ok(!$obj->{reversed}, "$test: not reversed");
-}
-{
- my $test = "Overloaded obj in when (true)";
- my $obj = OverloadTest->new(1);
- my $matched;
- given("topic") {
- when ($obj) {$matched = 1}
- default {$matched = 0}
- }
+ {
+ my $test = "Overloaded obj in when (true)";
+ my $obj = OverloadTest->new(1);
+ my $matched;
+ given("topic") {
+ when ($obj) {$matched = 1}
+ default {$matched = 0}
+ }
- is($obj->{called}, 1, "$test: called");
- ok($matched, "$test: matched");
- is($obj->{left}, "topic", "$test: left");
- is($obj->{right}, "string value of obj", "$test: right");
- ok($obj->{reversed}, "$test: reversed");
-}
-
-{
- my $test = "Overloaded obj in when (false)";
- my $obj = OverloadTest->new(0);
- my $matched;
- given("topic") {
- when ($obj) {$matched = 1}
- default {$matched = 0}
+ is($obj->{called}, 1, "$test: called");
+ ok($matched, "$test: matched");
+ is($obj->{left}, "topic", "$test: left");
+ is($obj->{right}, "string value of obj", "$test: right");
+ ok($obj->{reversed}, "$test: reversed");
}
+
+ {
+ my $test = "Overloaded obj in when (false)";
+ my $obj = OverloadTest->new(0);
+ my $matched;
+ given("topic") {
+ when ($obj) {$matched = 1}
+ default {$matched = 0}
+ }
- is($obj->{called}, 1, "$test: called");
- ok(!$matched, "$test: not matched");
- is($obj->{left}, "topic", "$test: left");
- is($obj->{right}, "string value of obj", "$test: right");
- ok($obj->{reversed}, "$test: reversed");
+ is($obj->{called}, 1, "$test: called");
+ ok(!$matched, "$test: not matched");
+ is($obj->{left}, "topic", "$test: left");
+ is($obj->{right}, "string value of obj", "$test: right");
+ ok($obj->{reversed}, "$test: reversed");
+ }
}
-
# Okay, that'll do for now. The intricacies of the smartmatch
# semantics are tested in t/op/smartmatch.t
__END__
End of Patch.
