rpms/perl/FC-5 perl-5.8.8-R-switch.patch, NONE, 1.1 perl-5.8.8-U27116.patch, NONE, 1.1 perl-5.8.8-U27329.patch, NONE, 1.1 perl-5.8.8-U27391.patch, NONE, 1.1 perl-5.8.8-U27426.patch, NONE, 1.1 perl-5.8.8-U27509.patch, NONE, 1.1 perl-5.8.8-U27512.patch, NONE, 1.1 perl-5.8.8-U27604.patch, NONE, 1.1 perl-5.8.8-U27605.patch, NONE, 1.1 perl-5.8.8-U27914.patch, NONE, 1.1 perl-5.8.8-bz188441.patch, NONE, 1.1 perl-5.8.8-bz191416.patch, NONE, 1.1 perl-5.8.8-no_asm_page_h.patch, NONE, 1.1 perl-5.8.7-172396.patch, 1.1, 1.2 perl.spec, 1.88, 1.89
fedora-cvs-commits at redhat.com
fedora-cvs-commits at redhat.com
Fri Jun 2 23:19:26 UTC 2006
- Previous message (by thread): rpms/fontconfig/FC-5 fontconfig-2.3.95-ttf-collections.patch, NONE, 1.1 fontconfig-2.4-cmap-parsing.patch, NONE, 1.1 fontconfig.spec, 1.72, 1.73
- Next message (by thread): rpms/evolution/FC-5 evolution-2.6.2-badalloc-crash.patch, NONE, 1.1.2.1 evolution.spec, 1.137.2.1, 1.137.2.2
- Messages sorted by:
[ date ]
[ thread ]
[ subject ]
[ author ]
Author: jvdias
Update of /cvs/dist/rpms/perl/FC-5
In directory cvs.devel.redhat.com:/tmp/cvs-serv10485
Modified Files:
perl-5.8.7-172396.patch perl.spec
Added Files:
perl-5.8.8-R-switch.patch perl-5.8.8-U27116.patch
perl-5.8.8-U27329.patch perl-5.8.8-U27391.patch
perl-5.8.8-U27426.patch perl-5.8.8-U27509.patch
perl-5.8.8-U27512.patch perl-5.8.8-U27604.patch
perl-5.8.8-U27605.patch perl-5.8.8-U27914.patch
perl-5.8.8-bz188441.patch perl-5.8.8-bz191416.patch
perl-5.8.8-no_asm_page_h.patch
Log Message:
fix upstream bugs since 5.8.8 was released
perl-5.8.8-R-switch.patch:
embed.fnc | 2 +-
embed.h | 2 +-
perl.c | 17 ++++++++++++-----
pod/perlrun.pod | 21 +++++++++++++++++++++
proto.h | 2 +-
5 files changed, 36 insertions(+), 8 deletions(-)
--- NEW FILE perl-5.8.8-R-switch.patch ---
--- perl-5.8.8/pod/perlrun.pod.-R-switch 2006-01-13 11:29:17.000000000 -0500
+++ perl-5.8.8/pod/perlrun.pod 2006-06-02 00:29:17.000000000 -0400
@@ -11,6 +11,7 @@
S<[ B<-I>I<dir> ] [ B<-m>[B<->]I<module> ] [ B<-M>[B<->]I<'module...'> ] [ B<-f> ]>
S<[ B<-C [I<number/list>] >]>
S<[ B<-P> ]>
+ S<[ B<-R> ]>
S<[ B<-S> ]>
S<[ B<-x>[I<dir>] ]>
S<[ B<-i>[I<extension>] ]>
@@ -813,6 +814,26 @@
before being searched for on the PATH. On Unix platforms, the
program will be searched for strictly on the PATH.
+=item B<-R>
+X<-R>
+
+Disables the Red Hat module compatibility default search path.
+
+By default, the Red Hat perl distribution will prepend to the default
+search path (@INC) the -V:archname subdirectory of each member of
+the -V:inc_version_list under the perl vendor and site installation
+directories.
+i.e. in shell notation:
+ {-V:vendorlib_stem,-V:sitelib_stem}/{-V:inc_version_list}/-V:archname
+where inc_version_list includes every previous perl version shipped
+by Red Hat, to provide compatibility for binary modules installed under
+previous perl versions. This can be quite a long list of directories
+to search, which can slow down module loading. You can disable searching
+these previous perl version architecture specific directories by specifying
+the -R switch - then the default search path will be as for the default
+upstream perl release.
+
+
=item B<-t>
X<-t>
--- perl-5.8.8/proto.h.-R-switch 2006-06-01 19:13:32.000000000 -0400
+++ perl-5.8.8/proto.h 2006-06-01 23:15:04.000000000 -0400
@@ -1620,7 +1620,7 @@
STATIC void S_init_ids(pTHX);
STATIC void S_init_lexer(pTHX);
STATIC void S_init_main_stash(pTHX);
-STATIC void S_init_perllib(pTHX);
+STATIC void S_init_perllib(pTHX,bool rhi);
STATIC void S_init_postdump_symbols(pTHX_ int argc, char **argv, char **env);
STATIC void S_init_predump_symbols(pTHX);
STATIC void S_my_exit_jump(pTHX)
--- perl-5.8.8/embed.fnc.-R-switch 2006-06-01 19:13:32.000000000 -0400
+++ perl-5.8.8/embed.fnc 2006-06-01 23:21:25.000000000 -0400
@@ -1080,7 +1080,7 @@
s |void |init_ids
s |void |init_lexer
s |void |init_main_stash
-s |void |init_perllib
+s |void |init_perllib |bool redhat_incpush
s |void |init_postdump_symbols|int argc|NN char **argv|NULLOK char **env
s |void |init_predump_symbols
rs |void |my_exit_jump
--- perl-5.8.8/embed.h.-R-switch 2006-06-01 19:13:32.000000000 -0400
+++ perl-5.8.8/embed.h 2006-06-01 23:13:11.000000000 -0400
@@ -3170,7 +3170,7 @@
#define init_ids() S_init_ids(aTHX)
#define init_lexer() S_init_lexer(aTHX)
#define init_main_stash() S_init_main_stash(aTHX)
-#define init_perllib() S_init_perllib(aTHX)
+#define init_perllib(rhi) S_init_perllib(aTHX,rhi)
#define init_postdump_symbols(a,b,c) S_init_postdump_symbols(aTHX_ a,b,c)
#define init_predump_symbols() S_init_predump_symbols(aTHX)
#define my_exit_jump() S_my_exit_jump(aTHX)
--- perl-5.8.8/perl.c.-R-switch 2006-06-01 23:08:08.000000000 -0400
+++ perl-5.8.8/perl.c 2006-06-02 00:00:23.000000000 -0400
@@ -1649,6 +1649,7 @@
#ifdef USE_SITECUSTOMIZE
bool minus_f = FALSE;
#endif
+ bool redhat_incpush = TRUE;
PL_fdscript = -1;
PL_suidscript = -1;
@@ -1770,11 +1771,15 @@
PL_preprocess = TRUE;
s++;
goto reswitch;
+ case 'R':
+ redhat_incpush = FALSE;
+ s++;
+ goto reswitch;
case 'S':
forbid_setid("-S");
dosearch = TRUE;
s++;
- goto reswitch;
+ goto reswitch;
case 'V':
{
SV *opts_prog;
@@ -2062,7 +2067,7 @@
scriptname = "-";
}
- init_perllib();
+ init_perllib(redhat_incpush);
open_script(scriptname,dosearch,sv);
@@ -4736,7 +4741,7 @@
}
STATIC void
-S_init_perllib(pTHX)
+S_init_perllib(pTHX, bool redhat_incpush)
{
char *s;
if (!PL_tainting) {
@@ -4803,7 +4808,8 @@
* DLL-based path intuition to work correctly */
# if !defined(WIN32)
incpush(SITEARCH_EXP, FALSE, FALSE, TRUE);
- incpush_oldversion(aTHX_ SITEARCH_EXP);
+ if ( redhat_incpush )
+ incpush_oldversion(aTHX_ SITEARCH_EXP);
# endif
#endif
@@ -4825,7 +4831,8 @@
* DLL-based path intuition to work correctly */
# if !defined(WIN32)
incpush(PERL_VENDORARCH_EXP, FALSE, FALSE, TRUE);
- incpush_oldversion(aTHX_ PERL_VENDORARCH_EXP);
+ if ( redhat_incpush )
+ incpush_oldversion(aTHX_ PERL_VENDORARCH_EXP);
# endif
#endif
perl-5.8.8-U27116.patch:
pp.c | 6 +++++-
t/op/index.t | 14 +++++++++++++-
2 files changed, 18 insertions(+), 2 deletions(-)
--- NEW FILE perl-5.8.8-U27116.patch ---
--- perl-5.8.8/t/op/index.t.U27116 2005-10-31 09:11:17.000000000 -0500
+++ perl-5.8.8/t/op/index.t 2006-06-01 18:20:53.000000000 -0400
@@ -7,7 +7,7 @@
use strict;
require './test.pl';
-plan( tests => 58 );
+plan( tests => 66 );
my $foo = 'Now is the time for all good men to come to the aid of their country.';
@@ -121,3 +121,15 @@
is (index($text, $search_octets), -1);
is (rindex($text, $search_octets), -1);
}
+
+foreach my $utf8 ('', ', utf-8') {
+ foreach my $arraybase (0, 1, -1, -2) {
+ my $expect_pos = 2 + $arraybase;
+
+ my $prog = "\$[ = $arraybase; \$big = \"N\\xabN\\xab\"; ";
+ $prog .= '$big .= chr 256; chop $big; ' if $utf8;
+ $prog .= 'print rindex $big, "N", 2 + $[';
+
+ fresh_perl_is($prog, $expect_pos, {}, "\$[ = $arraybase$utf8");
+ }
+}
--- perl-5.8.8/pp.c.U27116 2006-06-01 17:04:25.000000000 -0400
+++ perl-5.8.8/pp.c 2006-06-01 18:19:16.000000000 -0400
@@ -3258,9 +3258,13 @@
if (MAXARG < 3)
offset = blen;
else {
+ /* arybase is in characters, like offset, so combine prior to the
+ UTF-8 to bytes calculation. */
+ offset -= arybase;
if (offset > 0 && big_utf8)
sv_pos_u2b(big, &offset, 0);
- offset = offset - arybase + llen;
+ /* llen is in bytes. */
+ offset += llen;
}
if (offset < 0)
offset = 0;
perl-5.8.8-U27329.patch:
pp.c | 18 ++++++++++++------
t/op/lc.t | 37 ++++++++++++++++++++++++++++++++++++-
2 files changed, 48 insertions(+), 7 deletions(-)
--- NEW FILE perl-5.8.8-U27329.patch ---
--- perl-5.8.8/t/op/lc.t.U27329 2005-11-07 09:22:36.000000000 -0500
+++ perl-5.8.8/t/op/lc.t 2006-06-01 22:02:13.000000000 -0400
@@ -6,7 +6,7 @@
require './test.pl';
}
-plan tests => 59;
+plan tests => 77;
$a = "HELLO.* world";
$b = "hello.* WORLD";
@@ -163,3 +163,38 @@
is($a, v10, "[perl #18857]");
}
}
+
+
+# [perl #38619] Bug in lc and uc (interaction between UTF-8, substr, and lc/uc)
+
+for ("a\x{100}", "xyz\x{100}") {
+ is(substr(uc($_), 0), uc($_), "[perl #38619] uc");
+}
+for ("A\x{100}", "XYZ\x{100}") {
+ is(substr(lc($_), 0), lc($_), "[perl #38619] lc");
+}
+for ("a\x{100}", "ßyz\x{100}") { # ß to Ss (different length)
+ is(substr(ucfirst($_), 0), ucfirst($_), "[perl #38619] ucfirst");
+}
+
+# Related to [perl #38619]
+# the original report concerns PERL_MAGIC_utf8.
+# these cases concern PERL_MAGIC_regex_global.
+
+for (map { $_ } "a\x{100}", "abc\x{100}", "\x{100}") {
+ chop; # get ("a", "abc", "") in utf8
+ my $return = uc($_) =~ /\G(.?)/g;
+ my $result = $return ? $1 : "not";
+ my $expect = (uc($_) =~ /(.?)/g)[0];
+ is($return, 1, "[perl #38619]");
+ is($result, $expect, "[perl #38619]");
+}
+
+for (map { $_ } "A\x{100}", "ABC\x{100}", "\x{100}") {
+ chop; # get ("A", "ABC", "") in utf8
+ my $return = lc($_) =~ /\G(.?)/g;
+ my $result = $return ? $1 : "not";
+ my $expect = (lc($_) =~ /(.?)/g)[0];
+ is($return, 1, "[perl #38619]");
+ is($result, $expect, "[perl #38619]");
+}
--- perl-5.8.8/pp.c.U27329 2006-06-01 21:30:14.000000000 -0400
+++ perl-5.8.8/pp.c 2006-06-01 21:53:37.000000000 -0400
@@ -3447,7 +3447,8 @@
if (slen > ulen)
sv_catpvn(TARG, (char*)(s + ulen), slen - ulen);
SvUTF8_on(TARG);
- SETs(TARG);
+ sv = TARG;
+ SETs(sv);
}
else {
s = (U8*)SvPV_force_nomg(sv, slen);
@@ -3502,7 +3503,8 @@
if (slen > ulen)
sv_catpvn(TARG, (char*)(s + ulen), slen - ulen);
SvUTF8_on(TARG);
- SETs(TARG);
+ sv = TARG;
+ SETs(sv);
}
else {
s = (U8*)SvPV_force_nomg(sv, slen);
@@ -3552,7 +3554,8 @@
if (!len) {
SvUTF8_off(TARG); /* decontaminate */
sv_setpvn(TARG, "", 0);
- SETs(TARG);
+ sv = TARG;
+ SETs(sv);
}
else {
STRLEN min = len + 1;
@@ -3585,7 +3588,8 @@
*d = '\0';
SvUTF8_on(TARG);
SvCUR_set(TARG, d - (U8*)SvPVX_const(TARG));
- SETs(TARG);
+ sv = TARG;
+ SETs(sv);
}
}
else {
@@ -3636,7 +3640,8 @@
if (!len) {
SvUTF8_off(TARG); /* decontaminate */
sv_setpvn(TARG, "", 0);
- SETs(TARG);
+ sv = TARG;
+ SETs(sv);
}
else {
STRLEN min = len + 1;
@@ -3688,7 +3693,8 @@
*d = '\0';
SvUTF8_on(TARG);
SvCUR_set(TARG, d - (U8*)SvPVX_const(TARG));
- SETs(TARG);
+ sv = TARG;
+ SETs(sv);
}
}
else {
perl-5.8.8-U27391.patch:
doop.c | 8 +--
embed.fnc | 6 +-
embed.h | 8 +--
global.sym | 2
pp.c | 26 +++++++---
proto.h | 6 +-
sv.c | 43 +++++++++++++----
sv.h | 14 +++++
t/op/bop.t | 148 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
9 files changed, 228 insertions(+), 33 deletions(-)
--- NEW FILE perl-5.8.8-U27391.patch ---
--- perl-5.8.8/t/op/bop.t.U27391 2006-01-06 17:44:14.000000000 -0500
+++ perl-5.8.8/t/op/bop.t 2006-06-01 18:43:20.000000000 -0400
@@ -15,7 +15,7 @@
# If you find tests are failing, please try adding names to tests to track
# down where the failure is, and supply your new names as a patch.
# (Just-in-time test naming)
-plan tests => 49;
+plan tests => 148;
# numerics
ok ((0xdead & 0xbeef) == 0x9ead);
@@ -197,3 +197,149 @@
$b &= "b";
ok($b =~ /b+$/, 'Unicode "b" is NUL-terminated');
}
+
+require "./test.pl";
+curr_test(50);
+
+# double magic tests
+
+sub TIESCALAR { bless { value => $_[1], orig => $_[1] } }
+sub STORE { $_[0]{store}++; $_[0]{value} = $_[1] }
+sub FETCH { $_[0]{fetch}++; $_[0]{value} }
+sub stores { tied($_[0])->{value} = tied($_[0])->{orig};
+ delete(tied($_[0])->{store}) || 0 }
+sub fetches { delete(tied($_[0])->{fetch}) || 0 }
+
+# numeric double magic tests
+
+tie $x, "main", 1;
+tie $y, "main", 3;
+
+is(($x | $y), 3);
+is(fetches($x), 1);
+is(fetches($y), 1);
+is(stores($x), 0);
+is(stores($y), 0);
+
+is(($x & $y), 1);
+is(fetches($x), 1);
+is(fetches($y), 1);
+is(stores($x), 0);
+is(stores($y), 0);
+
+is(($x ^ $y), 2);
+is(fetches($x), 1);
+is(fetches($y), 1);
+is(stores($x), 0);
+is(stores($y), 0);
+
+is(($x |= $y), 3);
+is(fetches($x), 2);
+is(fetches($y), 1);
+is(stores($x), 1);
+is(stores($y), 0);
+
+is(($x &= $y), 1);
+is(fetches($x), 2);
+is(fetches($y), 1);
+is(stores($x), 1);
+is(stores($y), 0);
+
+is(($x ^= $y), 2);
+is(fetches($x), 2);
+is(fetches($y), 1);
+is(stores($x), 1);
+is(stores($y), 0);
+
+is(~~$y, 3);
+is(fetches($y), 1);
+is(stores($y), 0);
+
+{ use integer;
+
+is(($x | $y), 3);
+is(fetches($x), 1);
+is(fetches($y), 1);
+is(stores($x), 0);
+is(stores($y), 0);
+
+is(($x & $y), 1);
+is(fetches($x), 1);
+is(fetches($y), 1);
+is(stores($x), 0);
+is(stores($y), 0);
+
+is(($x ^ $y), 2);
+is(fetches($x), 1);
+is(fetches($y), 1);
+is(stores($x), 0);
+is(stores($y), 0);
+
+is(($x |= $y), 3);
+is(fetches($x), 2);
+is(fetches($y), 1);
+is(stores($x), 1);
+is(stores($y), 0);
+
+is(($x &= $y), 1);
+is(fetches($x), 2);
+is(fetches($y), 1);
+is(stores($x), 1);
+is(stores($y), 0);
+
+is(($x ^= $y), 2);
+is(fetches($x), 2);
+is(fetches($y), 1);
+is(stores($x), 1);
+is(stores($y), 0);
+
+is(~$y, -4);
+is(fetches($y), 1);
+is(stores($y), 0);
+
+} # end of use integer;
+
+# stringwise double magic tests
+
+tie $x, "main", "a";
+tie $y, "main", "c";
+
+is(($x | $y), ("a" | "c"));
+is(fetches($x), 1);
+is(fetches($y), 1);
+is(stores($x), 0);
+is(stores($y), 0);
+
+is(($x & $y), ("a" & "c"));
+is(fetches($x), 1);
+is(fetches($y), 1);
+is(stores($x), 0);
+is(stores($y), 0);
+
+is(($x ^ $y), ("a" ^ "c"));
+is(fetches($x), 1);
+is(fetches($y), 1);
+is(stores($x), 0);
+is(stores($y), 0);
+
+is(($x |= $y), ("a" | "c"));
+is(fetches($x), 2);
+is(fetches($y), 1);
+is(stores($x), 1);
+is(stores($y), 0);
+
+is(($x &= $y), ("a" & "c"));
+is(fetches($x), 2);
+is(fetches($y), 1);
+is(stores($x), 1);
+is(stores($y), 0);
+
+is(($x ^= $y), ("a" ^ "c"));
+is(fetches($x), 2);
+is(fetches($y), 1);
+is(stores($x), 1);
+is(stores($y), 0);
+
+is(~~$y, "c");
+is(fetches($y), 1);
+is(stores($y), 0);
--- perl-5.8.8/pp.c.U27391 2006-06-01 18:19:16.000000000 -0400
+++ perl-5.8.8/pp.c 2006-06-01 18:43:19.000000000 -0400
@@ -2229,13 +2229,15 @@
dSP; dATARGET; tryAMAGICbin(band,opASSIGN);
{
dPOPTOPssrl;
+ if (SvGMAGICAL(left)) mg_get(left);
+ if (SvGMAGICAL(right)) mg_get(right);
if (SvNIOKp(left) || SvNIOKp(right)) {
if (PL_op->op_private & HINT_INTEGER) {
- const IV i = SvIV(left) & SvIV(right);
+ const IV i = SvIV_nomg(left) & SvIV_nomg(right);
SETi(i);
}
else {
- const UV u = SvUV(left) & SvUV(right);
+ const UV u = SvUV_nomg(left) & SvUV_nomg(right);
SETu(u);
}
}
@@ -2252,13 +2254,15 @@
dSP; dATARGET; tryAMAGICbin(bxor,opASSIGN);
{
dPOPTOPssrl;
+ if (SvGMAGICAL(left)) mg_get(left);
+ if (SvGMAGICAL(right)) mg_get(right);
if (SvNIOKp(left) || SvNIOKp(right)) {
if (PL_op->op_private & HINT_INTEGER) {
- const IV i = (USE_LEFT(left) ? SvIV(left) : 0) ^ SvIV(right);
+ const IV i = (USE_LEFT(left) ? SvIV_nomg(left) : 0) ^ SvIV_nomg(right);
SETi(i);
}
else {
- const UV u = (USE_LEFT(left) ? SvUV(left) : 0) ^ SvUV(right);
+ const UV u = (USE_LEFT(left) ? SvUV_nomg(left) : 0) ^ SvUV_nomg(right);
SETu(u);
}
}
@@ -2275,13 +2279,15 @@
dSP; dATARGET; tryAMAGICbin(bor,opASSIGN);
{
dPOPTOPssrl;
+ if (SvGMAGICAL(left)) mg_get(left);
+ if (SvGMAGICAL(right)) mg_get(right);
if (SvNIOKp(left) || SvNIOKp(right)) {
if (PL_op->op_private & HINT_INTEGER) {
- const IV i = (USE_LEFT(left) ? SvIV(left) : 0) | SvIV(right);
+ const IV i = (USE_LEFT(left) ? SvIV_nomg(left) : 0) | SvIV_nomg(right);
SETi(i);
}
else {
- const UV u = (USE_LEFT(left) ? SvUV(left) : 0) | SvUV(right);
+ const UV u = (USE_LEFT(left) ? SvUV_nomg(left) : 0) | SvUV_nomg(right);
SETu(u);
}
}
@@ -2376,13 +2382,15 @@
dSP; dTARGET; tryAMAGICun(compl);
{
dTOPss;
+ if (SvGMAGICAL(sv))
+ mg_get(sv);
if (SvNIOKp(sv)) {
if (PL_op->op_private & HINT_INTEGER) {
- const IV i = ~SvIV(sv);
+ const IV i = ~SvIV_nomg(sv);
SETi(i);
}
else {
- const UV u = ~SvUV(sv);
+ const UV u = ~SvUV_nomg(sv);
SETu(u);
}
}
@@ -2392,7 +2400,7 @@
STRLEN len;
(void)SvPV_nomg_const(sv,len); /* force check for uninit var */
- SvSetSV(TARG, sv);
+ sv_setsv_nomg(TARG, sv);
tmps = (U8*)SvPV_force(TARG, len);
anum = len;
if (SvUTF8(TARG)) {
--- perl-5.8.8/global.sym.U27391 2006-01-31 10:50:34.000000000 -0500
+++ perl-5.8.8/global.sym 2006-06-01 18:43:19.000000000 -0400
@@ -432,6 +432,7 @@
Perl_sv_2cv
Perl_sv_2io
Perl_sv_2iv
+Perl_sv_2iv_flags
Perl_sv_2mortal
Perl_sv_2nv
Perl_sv_2pv
@@ -439,6 +440,7 @@
Perl_sv_2pvbyte
Perl_sv_pvn_nomg
Perl_sv_2uv
+Perl_sv_2uv_flags
Perl_sv_iv
Perl_sv_uv
Perl_sv_nv
--- perl-5.8.8/proto.h.U27391 2006-01-31 10:50:34.000000000 -0500
+++ perl-5.8.8/proto.h 2006-06-01 18:43:19.000000000 -0400
@@ -1139,14 +1139,16 @@
PERL_CALLCONV bool Perl_sv_2bool(pTHX_ SV* sv);
PERL_CALLCONV CV* Perl_sv_2cv(pTHX_ SV* sv, HV** st, GV** gvp, I32 lref);
PERL_CALLCONV IO* Perl_sv_2io(pTHX_ SV* sv);
-PERL_CALLCONV IV Perl_sv_2iv(pTHX_ SV* sv);
+/* PERL_CALLCONV IV sv_2iv(pTHX_ SV* sv); */
+PERL_CALLCONV IV Perl_sv_2iv_flags(pTHX_ SV* sv, I32 flags);
PERL_CALLCONV SV* Perl_sv_2mortal(pTHX_ SV* sv);
PERL_CALLCONV NV Perl_sv_2nv(pTHX_ SV* sv);
/* PERL_CALLCONV char* sv_2pv(pTHX_ SV* sv, STRLEN* lp); */
PERL_CALLCONV char* Perl_sv_2pvutf8(pTHX_ SV* sv, STRLEN* lp);
PERL_CALLCONV char* Perl_sv_2pvbyte(pTHX_ SV* sv, STRLEN* lp);
PERL_CALLCONV char* Perl_sv_pvn_nomg(pTHX_ SV* sv, STRLEN* lp);
-PERL_CALLCONV UV Perl_sv_2uv(pTHX_ SV* sv);
+/* PERL_CALLCONV UV sv_2uv(pTHX_ SV* sv); */
+PERL_CALLCONV UV Perl_sv_2uv_flags(pTHX_ SV* sv, I32 flags);
PERL_CALLCONV IV Perl_sv_iv(pTHX_ SV* sv);
PERL_CALLCONV UV Perl_sv_uv(pTHX_ SV* sv);
PERL_CALLCONV NV Perl_sv_nv(pTHX_ SV* sv);
--- perl-5.8.8/embed.fnc.U27391 2006-01-31 09:40:27.000000000 -0500
+++ perl-5.8.8/embed.fnc 2006-06-01 18:43:19.000000000 -0400
@@ -727,14 +727,16 @@
Apd |bool |sv_2bool |NN SV* sv
Apd |CV* |sv_2cv |NULLOK SV* sv|NN HV** st|NN GV** gvp|I32 lref
Apd |IO* |sv_2io |NN SV* sv
-Apd |IV |sv_2iv |NN SV* sv
+Amb |IV |sv_2iv |NN SV* sv
+Apd |IV |sv_2iv_flags |NN SV* sv|I32 flags
Apd |SV* |sv_2mortal |NULLOK SV* sv
Apd |NV |sv_2nv |NN SV* sv
Amb |char* |sv_2pv |NN SV* sv|NULLOK STRLEN* lp
Apd |char* |sv_2pvutf8 |NN SV* sv|NULLOK STRLEN* lp
Apd |char* |sv_2pvbyte |NN SV* sv|NULLOK STRLEN* lp
Ap |char* |sv_pvn_nomg |NN SV* sv|NULLOK STRLEN* lp
-Apd |UV |sv_2uv |NN SV* sv
+Amb |UV |sv_2uv |NN SV* sv
+Apd |UV |sv_2uv_flags |NN SV* sv|I32 flags
Apd |IV |sv_iv |NN SV* sv
Apd |UV |sv_uv |NN SV* sv
Apd |NV |sv_nv |NN SV* sv
--- perl-5.8.8/embed.h.U27391 2006-01-31 10:50:34.000000000 -0500
+++ perl-5.8.8/embed.h 2006-06-01 18:43:19.000000000 -0400
@@ -780,13 +780,13 @@
#define sv_2bool Perl_sv_2bool
#define sv_2cv Perl_sv_2cv
#define sv_2io Perl_sv_2io
-#define sv_2iv Perl_sv_2iv
+#define sv_2iv_flags Perl_sv_2iv_flags
#define sv_2mortal Perl_sv_2mortal
#define sv_2nv Perl_sv_2nv
#define sv_2pvutf8 Perl_sv_2pvutf8
#define sv_2pvbyte Perl_sv_2pvbyte
#define sv_pvn_nomg Perl_sv_pvn_nomg
-#define sv_2uv Perl_sv_2uv
+#define sv_2uv_flags Perl_sv_2uv_flags
#define sv_iv Perl_sv_iv
#define sv_uv Perl_sv_uv
#define sv_nv Perl_sv_nv
@@ -2831,13 +2831,13 @@
#define sv_2bool(a) Perl_sv_2bool(aTHX_ a)
#define sv_2cv(a,b,c,d) Perl_sv_2cv(aTHX_ a,b,c,d)
#define sv_2io(a) Perl_sv_2io(aTHX_ a)
-#define sv_2iv(a) Perl_sv_2iv(aTHX_ a)
+#define sv_2iv_flags(a,b) Perl_sv_2iv_flags(aTHX_ a,b)
#define sv_2mortal(a) Perl_sv_2mortal(aTHX_ a)
#define sv_2nv(a) Perl_sv_2nv(aTHX_ a)
#define sv_2pvutf8(a,b) Perl_sv_2pvutf8(aTHX_ a,b)
#define sv_2pvbyte(a,b) Perl_sv_2pvbyte(aTHX_ a,b)
#define sv_pvn_nomg(a,b) Perl_sv_pvn_nomg(aTHX_ a,b)
-#define sv_2uv(a) Perl_sv_2uv(aTHX_ a)
+#define sv_2uv_flags(a,b) Perl_sv_2uv_flags(aTHX_ a,b)
#define sv_iv(a) Perl_sv_iv(aTHX_ a)
#define sv_uv(a) Perl_sv_uv(aTHX_ a)
#define sv_nv(a) Perl_sv_nv(aTHX_ a)
--- perl-5.8.8/sv.h.U27391 2006-01-02 09:51:46.000000000 -0500
+++ perl-5.8.8/sv.h 2006-06-01 18:43:20.000000000 -0400
@@ -953,6 +953,9 @@
=for apidoc Am|char*|SvPVx|SV* sv|STRLEN len
A version of C<SvPV> which guarantees to evaluate sv only once.
+=for apidoc Am|char*|SvPV_nomg|SV* sv|STRLEN len
+Like C<SvPV> but doesn't process magic.
+
=for apidoc Am|char*|SvPV_nolen|SV* sv
Returns a pointer to the string in the SV, or a stringified form of
the SV if the SV does not contain a string. The SV may cache the
@@ -962,6 +965,9 @@
Coerces the given SV to an integer and returns it. See C<SvIVx> for a
version which guarantees to evaluate sv only once.
+=for apidoc Am|IV|SvIV_nomg|SV* sv
+Like C<SvIV> but doesn't process magic.
+
=for apidoc Am|IV|SvIVx|SV* sv
Coerces the given SV to an integer and returns it. Guarantees to evaluate
sv only once. Use the more efficient C<SvIV> otherwise.
@@ -978,6 +984,9 @@
Coerces the given SV to an unsigned integer and returns it. See C<SvUVx>
for a version which guarantees to evaluate sv only once.
+=for apidoc Am|UV|SvUV_nomg|SV* sv
+Like C<SvUV> but doesn't process magic.
+
=for apidoc Am|UV|SvUVx|SV* sv
Coerces the given SV to an unsigned integer and returns it. Guarantees to
evaluate sv only once. Use the more efficient C<SvUV> otherwise.
@@ -1050,6 +1059,9 @@
#define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv))
#define SvNV(sv) (SvNOK(sv) ? SvNVX(sv) : sv_2nv(sv))
+#define SvIV_nomg(sv) (SvIOK(sv) ? SvIVX(sv) : sv_2iv_flags(sv, 0))
+#define SvUV_nomg(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv_flags(sv, 0))
+
/* ----*/
#define SvPV(sv, lp) SvPV_flags(sv, lp, SV_GMAGIC)
@@ -1251,6 +1263,8 @@
#define sv_2pv_nomg(sv, lp) sv_2pv_flags(sv, lp, 0)
#define sv_pvn_force(sv, lp) sv_pvn_force_flags(sv, lp, SV_GMAGIC)
#define sv_utf8_upgrade(sv) sv_utf8_upgrade_flags(sv, SV_GMAGIC)
+#define sv_2iv(sv) sv_2iv_flags(sv, SV_GMAGIC)
+#define sv_2uv(sv) sv_2uv_flags(sv, SV_GMAGIC)
/* Should be named SvCatPVN_utf8_upgrade? */
#define sv_catpvn_utf8_upgrade(dsv, sstr, slen, nsv) \
--- perl-5.8.8/sv.c.U27391 2006-01-16 07:22:21.000000000 -0500
+++ perl-5.8.8/sv.c 2006-06-01 18:43:19.000000000 -0400
@@ -2062,22 +2062,34 @@
}
#endif /* !NV_PRESERVES_UV*/
+/* sv_2iv() is now a macro using Perl_sv_2iv_flags();
+ * this function provided for binary compatibility only
+ */
+
+IV
+Perl_sv_2iv(pTHX_ register SV *sv)
+{
+ return sv_2iv_flags(sv, SV_GMAGIC);
+}
+
/*
-=for apidoc sv_2iv
+=for apidoc sv_2iv_flags
-Return the integer value of an SV, doing any necessary string conversion,
-magic etc. Normally used via the C<SvIV(sv)> and C<SvIVx(sv)> macros.
+Return the integer value of an SV, doing any necessary string
+conversion. If flags includes SV_GMAGIC, does an mg_get() first.
+Normally used via the C<SvIV(sv)> and C<SvIVx(sv)> macros.
=cut
*/
IV
-Perl_sv_2iv(pTHX_ register SV *sv)
+Perl_sv_2iv_flags(pTHX_ register SV *sv, I32 flags)
{
if (!sv)
return 0;
if (SvGMAGICAL(sv)) {
- mg_get(sv);
+ if (flags & SV_GMAGIC)
+ mg_get(sv);
if (SvIOKp(sv))
return SvIVX(sv);
if (SvNOKp(sv)) {
@@ -2361,23 +2373,34 @@
return SvIsUV(sv) ? (IV)SvUVX(sv) : SvIVX(sv);
}
+/* sv_2uv() is now a macro using Perl_sv_2uv_flags();
+ * this function provided for binary compatibility only
+ */
+
+UV
+Perl_sv_2uv(pTHX_ register SV *sv)
+{
+ return sv_2uv_flags(sv, SV_GMAGIC);
+}
+
/*
-=for apidoc sv_2uv
+=for apidoc sv_2uv_flags
Return the unsigned integer value of an SV, doing any necessary string
-conversion, magic etc. Normally used via the C<SvUV(sv)> and C<SvUVx(sv)>
-macros.
+conversion. If flags includes SV_GMAGIC, does an mg_get() first.
+Normally used via the C<SvUV(sv)> and C<SvUVx(sv)> macros.
=cut
*/
UV
-Perl_sv_2uv(pTHX_ register SV *sv)
+Perl_sv_2uv_flags(pTHX_ register SV *sv, I32 flags)
{
if (!sv)
return 0;
if (SvGMAGICAL(sv)) {
- mg_get(sv);
+ if (flags & SV_GMAGIC)
+ mg_get(sv);
if (SvIOKp(sv))
return SvUVX(sv);
if (SvNOKp(sv))
--- perl-5.8.8/doop.c.U27391 2006-01-08 15:58:53.000000000 -0500
+++ perl-5.8.8/doop.c 2006-06-01 18:43:19.000000000 -0400
@@ -1171,8 +1171,8 @@
if (sv != left || (optype != OP_BIT_AND && !SvOK(sv) && !SvGMAGICAL(sv)))
sv_setpvn(sv, "", 0); /* avoid undef warning on |= and ^= */
- lsave = lc = SvPV_const(left, leftlen);
- rsave = rc = SvPV_const(right, rightlen);
+ lsave = lc = SvPV_nomg_const(left, leftlen);
+ rsave = rc = SvPV_nomg_const(right, rightlen);
len = leftlen < rightlen ? leftlen : rightlen;
lensave = len;
if ((left_utf || right_utf) && (sv == left || sv == right)) {
@@ -1180,9 +1180,7 @@
Newxz(dc, needlen + 1, char);
}
else if (SvOK(sv) || SvTYPE(sv) > SVt_PVMG) {
- /* Fix this to nong when change 22613 is integrated.
- (Which in turn awaits merging sv_2iv and sv_2uv) */
- dc = SvPV_force_nolen(sv);
+ dc = SvPV_force_nomg_nolen(sv);
if (SvLEN(sv) < (STRLEN)(len + 1)) {
dc = SvGROW(sv, (STRLEN)(len + 1));
(void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1);
perl-5.8.8-U27426.patch:
perl.c | 3 +--
1 files changed, 1 insertion(+), 2 deletions(-)
--- NEW FILE perl-5.8.8-U27426.patch ---
--- perl-5.8.8/perl.c.U27426 2006-06-01 17:04:25.000000000 -0400
+++ perl-5.8.8/perl.c 2006-06-01 19:00:57.000000000 -0400
@@ -3076,8 +3076,7 @@
PL_minus_F = TRUE;
PL_splitstr = ++s;
while (*s && !isSPACE(*s)) ++s;
- *s = '\0';
- PL_splitstr = savepv(PL_splitstr);
+ PL_splitstr = savepvn(PL_splitstr, s - PL_splitstr);
return s;
case 'a':
PL_minus_a = TRUE;
perl-5.8.8-U27509.patch:
overload.t | 626 +++++++++++++++++++++++++++++++++----------------------------
1 files changed, 346 insertions(+), 280 deletions(-)
--- NEW FILE perl-5.8.8-U27509.patch ---
--- perl-5.8.8/lib/overload.t.U27509 2005-04-22 10:56:23.000000000 -0400
+++ perl-5.8.8/lib/overload.t 2006-06-01 19:13:32.000000000 -0400
@@ -46,92 +46,64 @@
package main;
-our $test = 0;
$| = 1;
-print "1..",&last,"\n";
+use Test::More tests => 508;
-sub test {
- $test++;
- if (@_ > 1) {
- my $comment = "";
- $comment = " # " . $_ [2] if @_ > 2;
- if ($_[0] eq $_[1]) {
- print "ok $test$comment\n";
- return 1;
- } else {
- $comment .= ": '$_[0]' ne '$_[1]'";
- print "not ok $test$comment\n";
- return 0;
- }
- } else {
- if (shift) {
- print "ok $test\n";
- return 1;
- } else {
- print "not ok $test\n";
- return 0;
- }
- }
-}
$a = new Oscalar "087";
$b= "$a";
-# All test numbers in comments are off by 1.
-# So much for hard-wiring them in :-) To fix this:
-test(1); # 1
-
-test ($b eq $a); # 2
-test ($b eq "087"); # 3
-test (ref $a eq "Oscalar"); # 4
-test ($a eq $a); # 5
-test ($a eq "087"); # 6
+is($b, $a);
+is($b, "087");
+is(ref $a, "Oscalar");
+is($a, $a);
+is($a, "087");
$c = $a + 7;
-test (ref $c eq "Oscalar"); # 7
-test (!($c eq $a)); # 8
-test ($c eq "94"); # 9
+is(ref $c, "Oscalar");
+isnt($c, $a);
+is($c, "94");
$b=$a;
-test (ref $a eq "Oscalar"); # 10
+is(ref $a, "Oscalar");
$b++;
-test (ref $b eq "Oscalar"); # 11
-test ( $a eq "087"); # 12
-test ( $b eq "88"); # 13
-test (ref $a eq "Oscalar"); # 14
+is(ref $b, "Oscalar");
+is($a, "087");
+is($b, "88");
+is(ref $a, "Oscalar");
$c=$b;
$c-=$a;
-test (ref $c eq "Oscalar"); # 15
-test ( $a eq "087"); # 16
-test ( $c eq "1"); # 17
-test (ref $a eq "Oscalar"); # 18
+is(ref $c, "Oscalar");
+is($a, "087");
+is($c, "1");
+is(ref $a, "Oscalar");
$b=1;
$b+=$a;
-test (ref $b eq "Oscalar"); # 19
-test ( $a eq "087"); # 20
-test ( $b eq "88"); # 21
-test (ref $a eq "Oscalar"); # 22
+is(ref $b, "Oscalar");
+is($a, "087");
+is($b, "88");
+is(ref $a, "Oscalar");
eval q[ package Oscalar; use overload ('++' => sub { $ {$_[0]}++;$_[0] } ) ];
$b=$a;
-test (ref $a eq "Oscalar"); # 23
+is(ref $a, "Oscalar");
$b++;
-test (ref $b eq "Oscalar"); # 24
-test ( $a eq "087"); # 25
-test ( $b eq "88"); # 26
-test (ref $a eq "Oscalar"); # 27
+is(ref $b, "Oscalar");
+is($a, "087");
+is($b, "88");
+is(ref $a, "Oscalar");
package Oscalar;
$dummy=bless \$dummy; # Now cache of method should be reloaded
@@ -140,10 +112,10 @@
$b=$a;
$b++;
-test (ref $b eq "Oscalar"); # 28
-test ( $a eq "087"); # 29
-test ( $b eq "88"); # 30
-test (ref $a eq "Oscalar"); # 31
+is(ref $b, "Oscalar");
+is($a, "087");
+is($b, "88");
+is(ref $a, "Oscalar");
undef $b; # Destroying updates tables too...
@@ -151,14 +123,14 @@
$b=$a;
-test (ref $a eq "Oscalar"); # 32
+is(ref $a, "Oscalar");
$b++;
-test (ref $b eq "Oscalar"); # 33
-test ( $a eq "087"); # 34
-test ( $b eq "88"); # 35
-test (ref $a eq "Oscalar"); # 36
+is(ref $b, "Oscalar");
+is($a, "087");
+is($b, "88");
+is(ref $a, "Oscalar");
package Oscalar;
$dummy=bless \$dummy; # Now cache of method should be reloaded
@@ -166,21 +138,21 @@
$b++;
-test (ref $b eq "Oscalar"); # 37
-test ( $a eq "087"); # 38
-test ( $b eq "90"); # 39
-test (ref $a eq "Oscalar"); # 40
+is(ref $b, "Oscalar");
+is($a, "087");
+is($b, "90");
+is(ref $a, "Oscalar");
$b=$a;
$b++;
-test (ref $b eq "Oscalar"); # 41
-test ( $a eq "087"); # 42
-test ( $b eq "89"); # 43
-test (ref $a eq "Oscalar"); # 44
+is(ref $b, "Oscalar");
+is($a, "087");
+is($b, "89");
+is(ref $a, "Oscalar");
-test ($b? 1:0); # 45
+ok($b? 1:0);
eval q[ package Oscalar; use overload ('=' => sub {$main::copies++;
package Oscalar;
@@ -189,44 +161,44 @@
$b=new Oscalar "$a";
-test (ref $b eq "Oscalar"); # 46
-test ( $a eq "087"); # 47
-test ( $b eq "087"); # 48
-test (ref $a eq "Oscalar"); # 49
+is(ref $b, "Oscalar");
+is($a, "087");
+is($b, "087");
+is(ref $a, "Oscalar");
$b++;
-test (ref $b eq "Oscalar"); # 50
-test ( $a eq "087"); # 51
-test ( $b eq "89"); # 52
-test (ref $a eq "Oscalar"); # 53
-test ($copies == 0); # 54
+is(ref $b, "Oscalar");
+is($a, "087");
+is($b, "89");
+is(ref $a, "Oscalar");
+is($copies, undef);
$b+=1;
-test (ref $b eq "Oscalar"); # 55
-test ( $a eq "087"); # 56
-test ( $b eq "90"); # 57
-test (ref $a eq "Oscalar"); # 58
-test ($copies == 0); # 59
+is(ref $b, "Oscalar");
+is($a, "087");
+is($b, "90");
+is(ref $a, "Oscalar");
+is($copies, undef);
$b=$a;
$b+=1;
-test (ref $b eq "Oscalar"); # 60
-test ( $a eq "087"); # 61
-test ( $b eq "88"); # 62
-test (ref $a eq "Oscalar"); # 63
-test ($copies == 0); # 64
+is(ref $b, "Oscalar");
+is($a, "087");
+is($b, "88");
+is(ref $a, "Oscalar");
+is($copies, undef);
$b=$a;
$b++;
-test (ref $b eq "Oscalar") || print ref $b,"=ref(b)\n"; # 65
-test ( $a eq "087"); # 66
-test ( $b eq "89"); # 67
-test (ref $a eq "Oscalar"); # 68
-test ($copies == 1); # 69
+is(ref $b, "Oscalar");
+is($a, "087");
+is($b, "89");
+is(ref $a, "Oscalar");
+is($copies, 1);
eval q[package Oscalar; use overload ('+=' => sub {$ {$_[0]} += 3*$_[1];
$_[0] } ) ];
@@ -235,34 +207,34 @@
$b=$a;
$b+=1;
-test (ref $b eq "Oscalar"); # 70
-test ( $a eq "087"); # 71
-test ( $b eq "90"); # 72
-test (ref $a eq "Oscalar"); # 73
-test ($copies == 2); # 74
+is(ref $b, "Oscalar");
+is($a, "087");
+is($b, "90");
+is(ref $a, "Oscalar");
+is($copies, 2);
$b+=$b;
-test (ref $b eq "Oscalar"); # 75
-test ( $b eq "360"); # 76
-test ($copies == 2); # 77
+is(ref $b, "Oscalar");
+is($b, "360");
+is($copies, 2);
$b=-$b;
-test (ref $b eq "Oscalar"); # 78
-test ( $b eq "-360"); # 79
-test ($copies == 2); # 80
+is(ref $b, "Oscalar");
+is($b, "-360");
+is($copies, 2);
$b=abs($b);
-test (ref $b eq "Oscalar"); # 81
-test ( $b eq "360"); # 82
-test ($copies == 2); # 83
+is(ref $b, "Oscalar");
+is($b, "360");
+is($copies, 2);
$b=abs($b);
-test (ref $b eq "Oscalar"); # 84
-test ( $b eq "360"); # 85
-test ($copies == 2); # 86
+is(ref $b, "Oscalar");
+is($b, "360");
+is($copies, 2);
eval q[package Oscalar;
use overload ('x' => sub {new Oscalar ( $_[2] ? "_.$_[1]._" x $ {$_[0]}
@@ -270,7 +242,7 @@
$a=new Oscalar "yy";
$a x= 3;
-test ($a eq "_.yy.__.yy.__.yy._"); # 87
+is($a, "_.yy.__.yy.__.yy._");
eval q[package Oscalar;
use overload ('.' => sub {new Oscalar ( $_[2] ?
@@ -279,7 +251,7 @@
$a=new Oscalar "xx";
-test ("b${a}c" eq "_._.b.__.xx._.__.c._"); # 88
+is("b${a}c", "_._.b.__.xx._.__.c._");
# Check inheritance of overloading;
{
@@ -288,26 +260,26 @@
}
$aI = new OscalarI "$a";
-test (ref $aI eq "OscalarI"); # 89
-test ("$aI" eq "xx"); # 90
-test ($aI eq "xx"); # 91
-test ("b${aI}c" eq "_._.b.__.xx._.__.c._"); # 92
+is(ref $aI, "OscalarI");
+is("$aI", "xx");
+is($aI, "xx");
+is("b${aI}c", "_._.b.__.xx._.__.c._");
# Here we test blessing to a package updates hash
eval "package Oscalar; no overload '.'";
-test ("b${a}" eq "_.b.__.xx._"); # 93
+is("b${a}", "_.b.__.xx._");
$x="1";
bless \$x, Oscalar;
-test ("b${a}c" eq "bxxc"); # 94
+is("b${a}c", "bxxc");
new Oscalar 1;
-test ("b${a}c" eq "bxxc"); # 95
+is("b${a}c", "bxxc");
# Negative overloading:
$na = eval { ~$a };
-test($@ =~ /no method found/); # 96
+like($@, qr/no method found/);
# Check AUTOLOADING:
@@ -318,32 +290,32 @@
eval "package Oscalar; sub comple; use overload '~' => 'comple'";
$na = eval { ~$a }; # Hash was not updated
-test($@ =~ /no method found/); # 97
+like($@, qr/no method found/);
bless \$x, Oscalar;
$na = eval { ~$a }; # Hash updated
warn "`$na', $@" if $@;
-test !$@; # 98
-test($na eq '_!_xx_!_'); # 99
+ok !$@;
+is($na, '_!_xx_!_');
$na = 0;
$na = eval { ~$aI }; # Hash was not updated
-test($@ =~ /no method found/); # 100
+like($@, qr/no method found/);
bless \$x, OscalarI;
$na = eval { ~$aI };
print $@;
-test !$@; # 101
-test($na eq '_!_xx_!_'); # 102
+ok(!$@);
+is($na, '_!_xx_!_');
eval "package Oscalar; sub rshft; use overload '>>' => 'rshft'";
$na = eval { $aI >> 1 }; # Hash was not updated
-test($@ =~ /no method found/); # 103
+like($@, qr/no method found/);
bless \$x, OscalarI;
@@ -352,20 +324,20 @@
$na = eval { $aI >> 1 };
print $@;
-test !$@; # 104
-test($na eq '_!_xx_!_'); # 105
+ok(!$@);
+is($na, '_!_xx_!_');
# warn overload::Method($a, '0+'), "\n";
-test (overload::Method($a, '0+') eq \&Oscalar::numify); # 106
-test (overload::Method($aI,'0+') eq \&Oscalar::numify); # 107
-test (overload::Overloaded($aI)); # 108
-test (!overload::Overloaded('overload')); # 109
+is(overload::Method($a, '0+'), \&Oscalar::numify);
+is(overload::Method($aI,'0+'), \&Oscalar::numify);
+ok(overload::Overloaded($aI));
+ok(!overload::Overloaded('overload'));
-test (! defined overload::Method($aI, '<<')); # 110
-test (! defined overload::Method($a, '<')); # 111
+ok(! defined overload::Method($aI, '<<'));
+ok(! defined overload::Method($a, '<'));
-test (overload::StrVal($aI) =~ /^OscalarI=SCALAR\(0x[\da-fA-F]+\)$/); # 112
-test (overload::StrVal(\$aI) eq "@{[\$aI]}"); # 113
+like (overload::StrVal($aI), qr/^OscalarI=SCALAR\(0x[\da-fA-F]+\)$/);
+is(overload::StrVal(\$aI), "@{[\$aI]}");
# Check overloading by methods (specified deep in the ISA tree).
{
@@ -379,16 +351,16 @@
$aII = \$aaII;
bless $aII, 'OscalarII';
bless \$fake, 'OscalarI'; # update the hash
-test(($aI | 3) eq '_<<_xx_<<_'); # 114
+is(($aI | 3), '_<<_xx_<<_');
# warn $aII << 3;
-test(($aII << 3) eq '_<<_087_<<_'); # 115
+is(($aII << 3), '_<<_087_<<_');
{
BEGIN { $int = 7; overload::constant 'integer' => sub {$int++; shift}; }
$out = 2**10;
}
-test($int, 9); # 116
-test($out, 1024); # 117
+is($int, 9);
+is($out, 1024);
$foo = 'foo';
$foo1 = 'f\'o\\o';
@@ -402,15 +374,15 @@
/b\b$foo.\./;
}
-test($out, 'foo'); # 118
-test($out, $foo); # 119
-test($out1, 'f\'o\\o'); # 120
-test($out1, $foo1); # 121
-test($out2, "a\afoo,\,"); # 122
-test("@q", "foo q f'o\\\\o q a\\a qq ,\\, qq"); # 123
-test($q, 11); # 124
-test("@qr", "b\\b qq .\\. qq"); # 125
-test($qr, 9); # 126
+is($out, 'foo');
+is($out, $foo);
+is($out1, 'f\'o\\o');
+is($out1, $foo1);
+is($out2, "a\afoo,\,");
+is("@q", "foo q f'o\\\\o q a\\a qq ,\\, qq");
+is($q, 11);
+is("@qr", "b\\b qq .\\. qq");
+is($qr, 9);
{
$_ = '!<b>!foo!<-.>!';
@@ -433,19 +405,19 @@
tr/A-Z/a-z/;
}
-test($out, '_<foo>_'); # 117
-test($out1, '_<f\'o\\o>_'); # 128
-test($out2, "_<a\a>_foo_<,\,>_"); # 129
-test("@q1", "foo q f'o\\\\o q a\\a qq ,\\, qq oups
+is($out, '_<foo>_');
+is($out1, '_<f\'o\\o>_');
+is($out2, "_<a\a>_foo_<,\,>_");
+is("@q1", "foo q f'o\\\\o q a\\a qq ,\\, qq oups
qq oups1
- q second part q tail here s A-Z tr a-z tr"); # 130
-test("@qr1", "b\\b qq .\\. qq try it q first part q yet another qq"); # 131
-test($res, 1); # 132
-test($a, "_<oups
->_"); # 133
-test($b, "_<oups1
->_"); # 134
-test($c, "bareword"); # 135
+ q second part q tail here s A-Z tr a-z tr");
+is("@qr1", "b\\b qq .\\. qq try it q first part q yet another qq");
+is($res, 1);
+is($a, "_<oups
+>_");
+is($b, "_<oups1
+>_");
+is($c, "bareword");
{
package symbolic; # Primitive symbolic calculator
@@ -513,24 +485,24 @@
{
my $foo = new symbolic 11;
my $baz = $foo++;
- test( (sprintf "%d", $foo), '12');
- test( (sprintf "%d", $baz), '11');
+ is((sprintf "%d", $foo), '12');
+ is((sprintf "%d", $baz), '11');
my $bar = $foo;
$baz = ++$foo;
- test( (sprintf "%d", $foo), '13');
- test( (sprintf "%d", $bar), '12');
- test( (sprintf "%d", $baz), '13');
+ is((sprintf "%d", $foo), '13');
+ is((sprintf "%d", $bar), '12');
+ is((sprintf "%d", $baz), '13');
my $ban = $foo;
$baz = ($foo += 1);
- test( (sprintf "%d", $foo), '14');
- test( (sprintf "%d", $bar), '12');
- test( (sprintf "%d", $baz), '14');
- test( (sprintf "%d", $ban), '13');
+ is((sprintf "%d", $foo), '14');
+ is((sprintf "%d", $bar), '12');
+ is((sprintf "%d", $baz), '14');
+ is((sprintf "%d", $ban), '13');
$baz = 0;
$baz = $foo++;
- test( (sprintf "%d", $foo), '15');
- test( (sprintf "%d", $baz), '14');
- test( "$foo", '[++ [+= [++ [++ [n 11] 1] 1] 1] 1]');
+ is((sprintf "%d", $foo), '15');
+ is((sprintf "%d", $baz), '14');
+ is("$foo", '[++ [+= [++ [++ [n 11] 1] 1] 1] 1]');
}
{
@@ -543,8 +515,8 @@
$side = (sqrt(1 + $side**2) - 1)/$side;
}
my $pi = $side*(2**($iter+2));
- test "$side", '[/ [- [sqrt [+ 1 [** [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]] 2]]] 1] [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]]]';
- test( (sprintf "%f", $pi), '3.182598');
+ is("$side", '[/ [- [sqrt [+ 1 [** [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]] 2]]] 1] [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]]]');
+ is((sprintf "%f", $pi), '3.182598');
}
{
@@ -556,8 +528,8 @@
$side = (sqrt(1 + $side**2) - 1)/$side;
}
my $pi = $side*(2**($iter+2));
- test "$side", '[/ [- [sqrt [+ 1 [** [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]] 2]]] 1] [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]]]';
- test( (sprintf "%f", $pi), '3.182598');
+ is("$side", '[/ [- [sqrt [+ 1 [** [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]] 2]]] 1] [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]]]');
+ is((sprintf "%f", $pi), '3.182598');
}
{
@@ -565,9 +537,9 @@
symbolic->vars($a, $b);
my $c = sqrt($a**2 + $b**2);
$a = 3; $b = 4;
- test( (sprintf "%d", $c), '5');
+ is((sprintf "%d", $c), '5');
$a = 12; $b = 5;
- test( (sprintf "%d", $c), '13');
+ is((sprintf "%d", $c), '13');
}
{
@@ -634,24 +606,24 @@
{
my $foo = new symbolic1 11;
my $baz = $foo++;
- test( (sprintf "%d", $foo), '12');
- test( (sprintf "%d", $baz), '11');
+ is((sprintf "%d", $foo), '12');
+ is((sprintf "%d", $baz), '11');
my $bar = $foo;
$baz = ++$foo;
- test( (sprintf "%d", $foo), '13');
- test( (sprintf "%d", $bar), '12');
- test( (sprintf "%d", $baz), '13');
+ is((sprintf "%d", $foo), '13');
+ is((sprintf "%d", $bar), '12');
+ is((sprintf "%d", $baz), '13');
my $ban = $foo;
$baz = ($foo += 1);
- test( (sprintf "%d", $foo), '14');
- test( (sprintf "%d", $bar), '12');
- test( (sprintf "%d", $baz), '14');
- test( (sprintf "%d", $ban), '13');
+ is((sprintf "%d", $foo), '14');
+ is((sprintf "%d", $bar), '12');
+ is((sprintf "%d", $baz), '14');
+ is((sprintf "%d", $ban), '13');
$baz = 0;
$baz = $foo++;
- test( (sprintf "%d", $foo), '15');
- test( (sprintf "%d", $baz), '14');
- test( "$foo", '[++ [+= [++ [++ [n 11] 1] 1] 1] 1]');
+ is((sprintf "%d", $foo), '15');
+ is((sprintf "%d", $baz), '14');
+ is("$foo", '[++ [+= [++ [++ [n 11] 1] 1] 1] 1]');
}
{
@@ -664,8 +636,8 @@
$side = (sqrt(1 + $side**2) - 1)/$side;
}
my $pi = $side*(2**($iter+2));
- test "$side", '[/ [- [sqrt [+ 1 [** [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]] 2]]] 1] [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]]]';
- test( (sprintf "%f", $pi), '3.182598');
+ is("$side", '[/ [- [sqrt [+ 1 [** [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]] 2]]] 1] [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]]]');
+ is((sprintf "%f", $pi), '3.182598');
}
{
@@ -677,8 +649,8 @@
$side = (sqrt(1 + $side**2) - 1)/$side;
}
my $pi = $side*(2**($iter+2));
- test "$side", '[/ [- [sqrt [+ 1 [** [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]] 2]]] 1] [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]]]';
- test( (sprintf "%f", $pi), '3.182598');
+ is("$side", '[/ [- [sqrt [+ 1 [** [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]] 2]]] 1] [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]]]');
+ is((sprintf "%f", $pi), '3.182598');
}
{
@@ -686,9 +658,9 @@
symbolic1->vars($a, $b);
my $c = sqrt($a**2 + $b**2);
$a = 3; $b = 4;
- test( (sprintf "%d", $c), '5');
+ is((sprintf "%d", $c), '5');
$a = 12; $b = 5;
- test( (sprintf "%d", $c), '13');
+ is((sprintf "%d", $c), '13');
}
{
@@ -702,9 +674,9 @@
{
my $seven = new two_face ("vii", 7);
- test( (sprintf "seven=$seven, seven=%d, eight=%d", $seven, $seven+1),
+ is((sprintf "seven=$seven, seven=%d, eight=%d", $seven, $seven+1),
'seven=vii, seven=7, eight=8');
- test( scalar ($seven =~ /i/), '1')
+ is(scalar ($seven =~ /i/), '1');
}
{
@@ -717,7 +689,7 @@
my @arr = map sorting->new($_), 0..12;
my @sorted1 = sort @arr;
my @sorted2 = map $$_, @sorted1;
- test "@sorted2", '0 10 7 4 1 11 8 5 12 2 9 6 3';
+ is("@sorted2", '0 10 7 4 1 11 8 5 12 2 9 6 3');
}
{
package iterator;
@@ -728,21 +700,21 @@
# XXX iterator overload not intended to work with CORE::GLOBAL?
if (defined &CORE::GLOBAL::glob) {
- test '1', '1'; # 175
- test '1', '1'; # 176
- test '1', '1'; # 177
+ is('1', '1');
+ is('1', '1');
+ is('1', '1');
}
else {
my $iter = iterator->new(5);
my $acc = '';
my $out;
$acc .= " $out" while $out = <${iter}>;
- test $acc, ' 5 4 3 2 1 0'; # 175
+ is($acc, ' 5 4 3 2 1 0');
$iter = iterator->new(5);
- test scalar <${iter}>, '5'; # 176
+ is(scalar <${iter}>, '5');
$acc = '';
$acc .= " $out" while $out = <$iter>;
- test $acc, ' 4 3 2 1 0'; # 177
+ is($acc, ' 4 3 2 1 0');
}
{
package deref;
@@ -773,53 +745,53 @@
# Hash:
my @cont = sort %$deref;
if ("\t" eq "\011") { # ascii
- test "@cont", '23 5 fake foo'; # 178
+ is("@cont", '23 5 fake foo');
}
else { # ebcdic alpha-numeric sort order
- test "@cont", 'fake foo 23 5'; # 178
+ is("@cont", 'fake foo 23 5');
}
my @keys = sort keys %$deref;
- test "@keys", 'fake foo'; # 179
+ is("@keys", 'fake foo');
my @val = sort values %$deref;
- test "@val", '23 5'; # 180
- test $deref->{foo}, 5; # 181
- test defined $deref->{bar}, ''; # 182
+ is("@val", '23 5');
+ is($deref->{foo}, 5);
+ is(defined $deref->{bar}, '');
my $key;
@keys = ();
push @keys, $key while $key = each %$deref;
@keys = sort @keys;
- test "@keys", 'fake foo'; # 183
- test exists $deref->{bar}, ''; # 184
- test exists $deref->{foo}, 1; # 185
+ is("@keys", 'fake foo');
+ is(exists $deref->{bar}, '');
+ is(exists $deref->{foo}, 1);
# Code:
- test $deref->(5), 39; # 186
- test &$deref(6), 40; # 187
+ is($deref->(5), 39);
+ is(&$deref(6), 40);
sub xxx_goto { goto &$deref }
- test xxx_goto(7), 41; # 188
+ is(xxx_goto(7), 41);
my $srt = bless { c => sub {$b <=> $a}
}, 'deref';
*srt = \&$srt;
my @sorted = sort srt 11, 2, 5, 1, 22;
- test "@sorted", '22 11 5 2 1'; # 189
+ is("@sorted", '22 11 5 2 1');
# Scalar
- test $$deref, 123; # 190
+ is($$deref, 123);
# Code
@sorted = sort $srt 11, 2, 5, 1, 22;
- test "@sorted", '22 11 5 2 1'; # 191
+ is("@sorted", '22 11 5 2 1');
# Array
- test "@$deref", '11 12 13'; # 192
- test $#$deref, '2'; # 193
+ is("@$deref", '11 12 13');
+ is($#$deref, '2');
my $l = @$deref;
- test $l, 3; # 194
- test $deref->[2], '13'; # 195
+ is($l, 3);
+ is($deref->[2], '13');
$l = pop @$deref;
- test $l, 13; # 196
+ is($l, 13);
$l = 1;
- test $deref->[$l], '12'; # 197
+ is($deref->[$l], '12');
# Repeated dereference
my $double = bless { h => $deref,
}, 'deref';
- test $double->{foo}, 5; # 198
+ is($double->{foo}, 5);
}
{
@@ -856,9 +828,9 @@
my $bar = new two_refs 3,4,5,6;
$bar->[2] = 11;
-test $bar->{two}, 11; # 199
+is($bar->{two}, 11);
$bar->{three} = 13;
-test $bar->[3], 13; # 200
+is($bar->[3], 13);
{
package two_refs_o;
@@ -867,9 +839,9 @@
$bar = new two_refs_o 3,4,5,6;
$bar->[2] = 11;
-test $bar->{two}, 11; # 201
+is($bar->{two}, 11);
$bar->{three} = 13;
-test $bar->[3], 13; # 202
+is($bar->[3], 13);
{
package two_refs1;
@@ -909,9 +881,9 @@
$bar = new two_refs_o 3,4,5,6;
$bar->[2] = 11;
-test $bar->{two}, 11; # 203
+is($bar->{two}, 11);
$bar->{three} = 13;
-test $bar->[3], 13; # 204
+is($bar->[3], 13);
{
package two_refs1_o;
@@ -920,9 +892,9 @@
$bar = new two_refs1_o 3,4,5,6;
$bar->[2] = 11;
-test $bar->{two}, 11; # 205
+is($bar->{two}, 11);
$bar->{three} = 13;
-test $bar->[3], 13; # 206
+is($bar->[3], 13);
{
package B;
@@ -932,12 +904,12 @@
my $aaa;
{ my $bbbb = 0; $aaa = bless \$bbbb, B }
-test !$aaa, 1; # 207
+is !$aaa, 1;
unless ($aaa) {
- test 'ok', 'ok'; # 208
+ pass();
} else {
- test 'is not', 'ok'; # 208
+ fail();
}
# check that overload isn't done twice by join
@@ -945,7 +917,7 @@
package Join;
use overload '""' => sub { $c++ };
my $x = join '', bless([]), 'pq', bless([]);
- main::test $x, '0pq1'; # 209
+ main::is $x, '0pq1';
};
# Test module-specific warning
@@ -954,10 +926,10 @@
my $a = "" ;
local $SIG{__WARN__} = sub {$a = $_[0]} ;
$x = eval ' overload::constant "integer" ; ' ;
- test($a eq "") ; # 210
+ is($a, "");
use warnings 'overload' ;
$x = eval ' overload::constant "integer" ; ' ;
- test($a =~ /^Odd number of arguments for overload::constant at/) ; # 211
+ like($a, qr/^Odd number of arguments for overload::constant at/);
}
{
@@ -965,10 +937,10 @@
my $a = "" ;
local $SIG{__WARN__} = sub {$a = $_[0]} ;
$x = eval ' overload::constant "fred" => sub {} ; ' ;
- test($a eq "") ; # 212
+ is($a, "");
use warnings 'overload' ;
$x = eval ' overload::constant "fred" => sub {} ; ' ;
- test($a =~ /^`fred' is not an overloadable type at/); # 213
+ like($a, qr/^`fred' is not an overloadable type at/);
}
{
@@ -976,10 +948,10 @@
my $a = "" ;
local $SIG{__WARN__} = sub {$a = $_[0]} ;
$x = eval ' overload::constant "integer" => 1; ' ;
- test($a eq "") ; # 214
+ is($a, "");
use warnings 'overload' ;
$x = eval ' overload::constant "integer" => 1; ' ;
- test($a =~ /^`1' is not a code reference at/); # 215
+ like($a, qr/^`1' is not a code reference at/);
}
{
@@ -1005,13 +977,13 @@
my $x = new noov_int 11;
my $int_x = int $x;
- main::test("$int_x" eq 20); # 216
+ main::is("$int_x", 20);
$x = new ov_int1 31;
$int_x = int $x;
- main::test("$int_x" eq 131); # 217
+ main::is("$int_x", 131);
$x = new ov_int2 51;
$int_x = int $x;
- main::test("$int_x" eq 1054); # 218
+ main::is("$int_x", 1054);
}
# make sure that we don't inifinitely recurse
@@ -1023,9 +995,10 @@
'bool' => sub { shift },
fallback => 1;
my $x = bless([]);
- main::test("$x" =~ /Recurse=ARRAY/); # 219
- main::test($x); # 220
- main::test($x+0 =~ /Recurse=ARRAY/); # 221
+ # For some reason beyond me these have to be oks rather than likes.
+ main::ok("$x" =~ /Recurse=ARRAY/);
+ main::ok($x);
+ main::ok($x+0 =~ qr/Recurse=ARRAY/);
}
# BugID 20010422.003
@@ -1056,7 +1029,7 @@
my $r = Foo->new(8);
$r = Foo->new(0);
-test(($r || 0) == 0); # 222
+is(($r || 0), 0);
package utf8_o;
@@ -1076,8 +1049,8 @@
my $utfvar = new utf8_o 200.2.1;
-test("$utfvar" eq 200.2.1); # 223 - stringify
-test("a$utfvar" eq "a".200.2.1); # 224 - overload via sv_2pv_flags
+is("$utfvar", 200.2.1); # 223 - stringify
+is("a$utfvar", "a".200.2.1); # 224 - overload via sv_2pv_flags
# 225..227 -- more %{} tests. Hangs in 5.6.0, okay in later releases.
# Basically this example implements strong encapsulation: if Hderef::import()
@@ -1093,9 +1066,9 @@
package main;
my $a = Foo->new;
$a->xet('b', 42);
-test ($a->xet('b'), 42);
-test (!defined eval { $a->{b} });
-test ($@ =~ /zap/);
+is ($a->xet('b'), 42);
+ok (!defined eval { $a->{b} });
+like ($@, qr/zap/);
{
package t229;
@@ -1110,7 +1083,7 @@
my $y = $x;
eval { $y++ };
}
- main::test (!$warn);
+ main::ok (!$warn);
}
{
@@ -1120,9 +1093,9 @@
$out1 = 0;
$out2 = 1;
}
- test($int, 2, "#24313"); # 230
- test($out1, 17, "#24313"); # 231
- test($out2, 17, "#24313"); # 232
+ is($int, 2, "#24313"); # 230
+ is($out1, 17, "#24313"); # 231
+ is($out2, 17, "#24313"); # 232
}
{
@@ -1146,16 +1119,16 @@
my $o = bless [], 'perl31793';
my $of = bless [], 'perl31793_fb';
my $no = bless [], 'no_overload';
- test (overload::StrVal(\"scalar") =~ /^SCALAR\(0x[0-9a-f]+\)$/);
- test (overload::StrVal([]) =~ /^ARRAY\(0x[0-9a-f]+\)$/);
- test (overload::StrVal({}) =~ /^HASH\(0x[0-9a-f]+\)$/);
- test (overload::StrVal(sub{1}) =~ /^CODE\(0x[0-9a-f]+\)$/);
- test (overload::StrVal(\*GLOB) =~ /^GLOB\(0x[0-9a-f]+\)$/);
- test (overload::StrVal(\$o) =~ /^REF\(0x[0-9a-f]+\)$/);
- test (overload::StrVal(qr/a/) =~ /^Regexp=SCALAR\(0x[0-9a-f]+\)$/);
- test (overload::StrVal($o) =~ /^perl31793=ARRAY\(0x[0-9a-f]+\)$/);
- test (overload::StrVal($of) =~ /^perl31793_fb=ARRAY\(0x[0-9a-f]+\)$/);
- test (overload::StrVal($no) =~ /^no_overload=ARRAY\(0x[0-9a-f]+\)$/);
+ like(overload::StrVal(\"scalar"), qr/^SCALAR\(0x[0-9a-f]+\)$/);
+ like(overload::StrVal([]), qr/^ARRAY\(0x[0-9a-f]+\)$/);
+ like(overload::StrVal({}), qr/^HASH\(0x[0-9a-f]+\)$/);
+ like(overload::StrVal(sub{1}), qr/^CODE\(0x[0-9a-f]+\)$/);
+ like(overload::StrVal(\*GLOB), qr/^GLOB\(0x[0-9a-f]+\)$/);
+ like(overload::StrVal(\$o), qr/^REF\(0x[0-9a-f]+\)$/);
+ like(overload::StrVal(qr/a/), qr/^Regexp=SCALAR\(0x[0-9a-f]+\)$/);
+ like(overload::StrVal($o), qr/^perl31793=ARRAY\(0x[0-9a-f]+\)$/);
+ like(overload::StrVal($of), qr/^perl31793_fb=ARRAY\(0x[0-9a-f]+\)$/);
+ like(overload::StrVal($no), qr/^no_overload=ARRAY\(0x[0-9a-f]+\)$/);
}
# These are all check that overloaded values rather than reference addressess
@@ -1174,9 +1147,102 @@
die if $@;
my $expect = eval $rcode;
die if $@;
- test ($got, $expect, $ocode) or print "# $rcode\n";
+ is ($got, $expect, $ocode) or print "# $rcode\n";
}
}
}
-# Last test is:
-sub last {493}
+{
+ # check that overloading works in regexes
+ {
+ package Foo493;
+ use overload
+ '""' => sub { "^$_[0][0]\$" },
+ '.' => sub {
+ bless [
+ $_[2]
+ ? (ref $_[1] ? $_[1][0] : $_[1]) . ':' .$_[0][0]
+ : $_[0][0] . ':' . (ref $_[1] ? $_[1][0] : $_[1])
+ ], 'Foo493'
+ };
+ }
+
+ my $a = bless [ "a" ], 'Foo493';
+ like('a', qr/$a/);
+ like('x:a', qr/x$a/);
+ like('x:a:=', qr/x$a=$/);
+ like('x:a:a:=', qr/x$a$a=$/);
+
+}
+
+{
+ package Sklorsh;
+ use overload
+ bool => sub { shift->is_cool };
+
+ sub is_cool {
+ $_[0]->{name} eq 'cool';
+ }
+
+ sub delete {
+ undef %{$_[0]};
+ bless $_[0], 'Brap';
+ return 1;
+ }
+
+ sub delete_with_self {
+ my $self = shift;
+ undef %$self;
+ bless $self, 'Brap';
+ return 1;
+ }
+
+ package Brap;
+
+ 1;
+
+ package main;
+
+ my $obj;
+ $obj = bless {name => 'cool'}, 'Sklorsh';
+ $obj->delete;
+ ok(eval {if ($obj) {1}; 1}, $@ || 'reblessed into nonexist namespace');
+
+ $obj = bless {name => 'cool'}, 'Sklorsh';
+ $obj->delete_with_self;
+ ok (eval {if ($obj) {1}; 1}, $@);
+
+ my $a = $b = {name => 'hot'};
+ bless $b, 'Sklorsh';
+ is(ref $a, 'Sklorsh');
+ is(ref $b, 'Sklorsh');
+ ok(!$b, "Expect overloaded boolean");
+ ok(!$a, "Expect overloaded boolean");
+}
+{
+ use Scalar::Util 'weaken';
+
+ package Shklitza;
+ use overload '""' => sub {"CLiK KLAK"};
+
+ package Ksshfwoom;
+
+ package main;
+
+ my ($obj, $ref);
+ $obj = bless do {my $a; \$a}, 'Shklitza';
+ $ref = $obj;
+
+ is ($obj, "CLiK KLAK");
+ is ($ref, "CLiK KLAK");
+
+ weaken $ref;
+ is ($ref, "CLiK KLAK");
+
+ bless $obj, 'Ksshfwoom';
+
+ like ($obj, qr/^Ksshfwoom=/);
+ like ($ref, qr/^Ksshfwoom=/);
+
+ undef $obj;
+ is ($ref, undef);
+}
perl-5.8.8-U27512.patch:
embed.fnc | 1 +
embed.h | 2 ++
proto.h | 1 +
sv.c | 61 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++----
4 files changed, 61 insertions(+), 4 deletions(-)
--- NEW FILE perl-5.8.8-U27512.patch ---
--- perl-5.8.8/sv.c.U27512 2006-06-01 18:43:19.000000000 -0400
+++ perl-5.8.8/sv.c 2006-06-01 19:13:32.000000000 -0400
@@ -7993,6 +7993,52 @@
return rv;
}
+/* This is a hack to cope with reblessing from class with overloading magic to
+ one without (or the other way). Search for every reference pointing to the
+ object. Can't use S_visit() because we would need to pass a parameter to
+ our function. */
+static void
+S_reset_amagic(pTHX_ SV *rv, const bool on) {
+ /* It is assumed that you've already turned magic on/off on rv */
+ SV* sva;
+ SV *const target = SvRV(rv);
+ /* Less 1 for the reference we've already dealt with. */
+ U32 how_many = SvREFCNT(target) - 1;
+ MAGIC *mg;
+
+ if (SvMAGICAL(target) && (mg = mg_find(target, PERL_MAGIC_backref))) {
+ /* Back referneces also need to be found, but aren't part of the
+ target's reference count. */
+ how_many += 1 + av_len((AV*)mg->mg_obj);
+ }
+
+ if (!how_many) {
+ /* There was only 1 reference to this object. */
+ return;
+ }
+
+ for (sva = PL_sv_arenaroot; sva; sva = (SV*)SvANY(sva)) {
+ register const SV * const svend = &sva[SvREFCNT(sva)];
+ register SV* sv;
+ for (sv = sva + 1; sv < svend; ++sv) {
+ if (SvTYPE(sv) != SVTYPEMASK
+ && (sv->sv_flags & SVf_ROK) == SVf_ROK
+ && SvREFCNT(sv)
+ && SvRV(sv) == target
+ && sv != rv) {
+ if (on)
+ SvAMAGIC_on(sv);
+ else
+ SvAMAGIC_off(sv);
+ if (--how_many == 0) {
+ /* We have found them all. */
+ return;
+ }
+ }
+ }
+ }
+}
+
/*
=for apidoc sv_bless
@@ -8025,10 +8071,17 @@
(void)SvUPGRADE(tmpRef, SVt_PVMG);
SvSTASH_set(tmpRef, (HV*)SvREFCNT_inc(stash));
- if (Gv_AMG(stash))
- SvAMAGIC_on(sv);
- else
- SvAMAGIC_off(sv);
+ if (Gv_AMG(stash)) {
+ if (!SvAMAGIC(sv)) {
+ SvAMAGIC_on(sv);
+ S_reset_amagic(aTHX_ sv, TRUE);
+ }
+ } else {
+ if (SvAMAGIC(sv)) {
+ SvAMAGIC_off(sv);
+ S_reset_amagic(aTHX_ sv, FALSE);
+ }
+ }
if(SvSMAGICAL(tmpRef))
if(mg_find(tmpRef, PERL_MAGIC_ext) || mg_find(tmpRef, PERL_MAGIC_uvar))
--- perl-5.8.8/proto.h.U27512 2006-06-01 18:43:19.000000000 -0400
+++ perl-5.8.8/proto.h 2006-06-01 19:13:32.000000000 -0400
@@ -1875,6 +1875,7 @@
#
STATIC bool S_utf8_mg_pos(pTHX_ SV *sv, MAGIC **mgp, STRLEN **cachep, I32 i, I32 *offsetp, I32 uoff, const U8 **sp, const U8 *start, const U8 *send);
STATIC bool S_utf8_mg_pos_init(pTHX_ SV *sv, MAGIC **mgp, STRLEN **cachep, I32 i, I32 offsetp, const U8 *s, const U8 *start);
+STATIC void S_reset_amagic(pTHX_ SV *rv, const bool on);
#endif
#if defined(PERL_IN_TOKE_C) || defined(PERL_DECL_PROT)
--- perl-5.8.8/embed.h.U27512 2006-06-01 18:43:19.000000000 -0400
+++ perl-5.8.8/embed.h 2006-06-01 19:13:32.000000000 -0400
@@ -1348,6 +1348,7 @@
#ifdef PERL_CORE
#define utf8_mg_pos S_utf8_mg_pos
#define utf8_mg_pos_init S_utf8_mg_pos_init
+#define reset_amagic S_reset_amagic
#endif
#endif
#if defined(PERL_IN_TOKE_C) || defined(PERL_DECL_PROT)
@@ -3390,6 +3391,7 @@
#ifdef PERL_CORE
#define utf8_mg_pos(a,b,c,d,e,f,g,h,i) S_utf8_mg_pos(aTHX_ a,b,c,d,e,f,g,h,i)
#define utf8_mg_pos_init(a,b,c,d,e,f,g) S_utf8_mg_pos_init(aTHX_ a,b,c,d,e,f,g)
+#define reset_amagic(a,b) S_reset_amagic(aTHX_ a,b)
#endif
#endif
#if defined(PERL_IN_TOKE_C) || defined(PERL_DECL_PROT)
--- perl-5.8.8/embed.fnc.U27512 2006-06-01 18:43:19.000000000 -0400
+++ perl-5.8.8/embed.fnc 2006-06-01 19:13:32.000000000 -0400
@@ -1276,6 +1276,7 @@
s |bool |utf8_mg_pos_init |NN SV *sv|NN MAGIC **mgp \
|NN STRLEN **cachep|I32 i|I32 offsetp \
|NN const U8 *s|NN const U8 *start
+s |void |reset_amagic |NN SV *rv|const bool on
#endif
#if defined(PERL_IN_TOKE_C) || defined(PERL_DECL_PROT)
perl-5.8.8-U27604.patch:
MANIFEST | 1 +
regexec.c | 18 ++++++++++--------
t/op/regexp.t | 3 ++-
t/op/regexp_qr.t | 10 ++++++++++
4 files changed, 23 insertions(+), 9 deletions(-)
--- NEW FILE perl-5.8.8-U27604.patch ---
--- /dev/null 2006-06-01 12:59:27.771303750 -0400
+++ perl-5.8.8/t/op/regexp_qr.t 2006-06-01 19:24:53.000000000 -0400
@@ -0,0 +1,10 @@
+#!./perl
+
+$qr = 1;
+for $file ('./op/regexp.t', './t/op/regexp.t', ':op:regexp.t') {
+ if (-r $file) {
+ do $file;
+ exit;
+ }
+}
+die "Cannot find ./op/regexp.t or ./t/op/regexp.t\n";
--- perl-5.8.8/t/op/regexp.t.U27604 2001-10-27 14:09:24.000000000 -0400
+++ perl-5.8.8/t/op/regexp.t 2006-06-01 19:24:53.000000000 -0400
@@ -49,6 +49,7 @@
$bang = sprintf "\\%03o", ord "!"; # \41 would not be portable.
$ffff = chr(0xff) x 2;
$nulnul = "\0" x 2;
+$OP = $qr ? 'qr' : 'm';
$| = 1;
print "1..$numtests\n# $iters iterations\n";
@@ -73,7 +74,7 @@
$result =~ s/B//i unless $skip;
for $study ('', 'study \$subject') {
$c = $iters;
- eval "$study; \$match = (\$subject =~ m$pat) while \$c--; \$got = \"$repl\";";
+ eval "$study; \$match = (\$subject =~ $OP$pat) while \$c--; \$got = \"$repl\";";
chomp( $err = $@ );
if ($result eq 'c') {
if ($err !~ m!^\Q$expect!) { print "not ok $. (compile) $input => `$err'\n"; next TEST }
--- perl-5.8.8/regexec.c.U27604 2006-01-08 15:59:30.000000000 -0500
+++ perl-5.8.8/regexec.c 2006-06-01 19:24:53.000000000 -0400
@@ -412,6 +412,7 @@
I32 ml_anch;
register char *other_last = Nullch; /* other substr checked before this */
char *check_at = Nullch; /* check substr found at this pos */
+ const I32 multiline = PL_multiline | (prog->reganch & PMf_MULTILINE);
#ifdef DEBUGGING
const char * const i_strpos = strpos;
SV * const dsv = PERL_DEBUG_PAD_ZERO(0);
@@ -473,7 +474,7 @@
if (prog->reganch & ROPT_ANCH) { /* Match at beg-of-str or after \n */
ml_anch = !( (prog->reganch & ROPT_ANCH_SINGLE)
|| ( (prog->reganch & ROPT_ANCH_BOL)
- && !PL_multiline ) ); /* Check after \n? */
+ && !multiline ) ); /* Check after \n? */
if (!ml_anch) {
if ( !(prog->reganch & (ROPT_ANCH_GPOS /* Checked by the caller */
@@ -568,11 +569,11 @@
else if (prog->reganch & ROPT_CANY_SEEN)
s = fbm_instr((U8*)(s + start_shift),
(U8*)(strend - end_shift),
- check, PL_multiline ? FBMrf_MULTILINE : 0);
+ check, multiline ? FBMrf_MULTILINE : 0);
else
s = fbm_instr(HOP3(s, start_shift, strend),
HOP3(strend, -end_shift, strbeg),
- check, PL_multiline ? FBMrf_MULTILINE : 0);
+ check, multiline ? FBMrf_MULTILINE : 0);
/* Update the count-of-usability, remove useless subpatterns,
unshift s. */
@@ -643,7 +644,7 @@
HOP3(HOP3(last1, prog->anchored_offset, strend)
+ SvCUR(must), -(SvTAIL(must)!=0), strbeg),
must,
- PL_multiline ? FBMrf_MULTILINE : 0
+ multiline ? FBMrf_MULTILINE : 0
);
DEBUG_r(PerlIO_printf(Perl_debug_log,
"%s anchored substr \"%s%.*s%s\"%s",
@@ -704,7 +705,7 @@
s = fbm_instr((unsigned char*)s,
(unsigned char*)last + SvCUR(must)
- (SvTAIL(must)!=0),
- must, PL_multiline ? FBMrf_MULTILINE : 0);
+ must, multiline ? FBMrf_MULTILINE : 0);
/* FIXME - DEBUG_EXECUTE_r if that is merged to maint */
DEBUG_r(PerlIO_printf(Perl_debug_log, "%s floating substr \"%s%.*s%s\"%s",
(s ? "Found" : "Contradicts"),
@@ -1639,6 +1640,7 @@
char *scream_olds;
SV* oreplsv = GvSV(PL_replgv);
const bool do_utf8 = DO_UTF8(sv);
+ const I32 multiline = PL_multiline | (prog->reganch & PMf_MULTILINE);
#ifdef DEBUGGING
SV *dsv0 = PERL_DEBUG_PAD_ZERO(0);
SV *dsv1 = PERL_DEBUG_PAD_ZERO(1);
@@ -1756,7 +1758,7 @@
if (prog->reganch & (ROPT_ANCH & ~ROPT_ANCH_GPOS)) {
if (s == startpos && regtry(prog, startpos))
goto got_it;
- else if (PL_multiline || (prog->reganch & ROPT_IMPLICIT)
+ else if (multiline || (prog->reganch & ROPT_IMPLICIT)
|| (prog->reganch & ROPT_ANCH_MBOL)) /* XXXX SBOL? */
{
char *end;
@@ -1889,7 +1891,7 @@
end_shift, &scream_pos, 0))
: (s = fbm_instr((unsigned char*)HOP3(s, back_min, strend),
(unsigned char*)strend, must,
- PL_multiline ? FBMrf_MULTILINE : 0))) ) {
+ multiline ? FBMrf_MULTILINE : 0))) ) {
/* we may be pointing at the wrong string */
if ((flags & REXEC_SCREAM) && RX_MATCH_COPIED(prog))
s = strbeg + (s - SvPVX_const(sv));
@@ -1990,7 +1992,7 @@
if (SvTAIL(float_real)) {
if (memEQ(strend - len + 1, little, len - 1))
last = strend - len + 1;
- else if (!PL_multiline)
+ else if (!multiline)
last = memEQ(strend - len, little, len)
? strend - len : Nullch;
else
--- perl-5.8.8/MANIFEST.U27604 2006-01-31 18:27:53.000000000 -0500
+++ perl-5.8.8/MANIFEST 2006-06-01 19:24:52.000000000 -0400
@@ -2802,6 +2802,7 @@
t/op/ref.t See if refs and objects work
t/op/regexp_noamp.t See if regular expressions work with optimizations
t/op/regexp.t See if regular expressions work
+t/op/regexp_qr.t See if regular expressions work as qr//
t/op/regmesg.t See if one can get regular expression errors
t/op/repeat.t See if x operator works
t/op/re_tests Regular expressions for regexp.t
perl-5.8.8-U27605.patch:
mg.c | 13 +++++++------
perl.c | 2 +-
2 files changed, 8 insertions(+), 7 deletions(-)
--- NEW FILE perl-5.8.8-U27605.patch ---
--- perl-5.8.8/mg.c.U27605 2006-01-27 15:23:21.000000000 -0500
+++ perl-5.8.8/mg.c 2006-06-01 19:37:17.000000000 -0400
@@ -2520,10 +2520,10 @@
#endif
/* PL_origalen is set in perl_parse(). */
s = SvPV_force(sv,len);
- if (len >= (STRLEN)PL_origalen) {
- /* Longer than original, will be truncated. */
- Copy(s, PL_origargv[0], PL_origalen, char);
- PL_origargv[0][PL_origalen - 1] = 0;
+ if (len >= (STRLEN)PL_origalen-1) {
+ /* Longer than original, will be truncated. We assume that
+ * PL_origalen bytes are available. */
+ Copy(s, PL_origargv[0], PL_origalen-1, char);
}
else {
/* Shorter than original, will be padded. */
@@ -2536,9 +2536,10 @@
* --jhi */
(int)' ',
PL_origalen - len - 1);
- for (i = 1; i < PL_origargc; i++)
- PL_origargv[i] = 0;
}
+ PL_origargv[0][PL_origalen-1] = 0;
+ for (i = 1; i < PL_origargc; i++)
+ PL_origargv[i] = 0;
UNLOCK_DOLLARZERO_MUTEX;
break;
#endif
--- perl-5.8.8/perl.c.U27605 2006-06-01 19:00:57.000000000 -0400
+++ perl-5.8.8/perl.c 2006-06-01 19:37:17.000000000 -0400
@@ -1561,7 +1561,7 @@
}
}
}
- PL_origalen = s - PL_origargv[0];
+ PL_origalen = s - PL_origargv[0] + 1;
}
if (PL_do_undump) {
perl-5.8.8-U27914.patch:
scope.c | 12 +++++++++++-
t/op/local.t | 18 +++++++++++++++++-
2 files changed, 28 insertions(+), 2 deletions(-)
--- NEW FILE perl-5.8.8-U27914.patch ---
--- perl-5.8.8/t/op/local.t.U27914 2006-01-03 10:11:35.000000000 -0500
+++ perl-5.8.8/t/op/local.t 2006-06-01 19:49:54.000000000 -0400
@@ -4,7 +4,7 @@
chdir 't' if -d 't';
require './test.pl';
}
-plan tests => 81;
+plan tests => 85;
my $list_assignment_supported = 1;
@@ -313,3 +313,19 @@
{ local @x{c,d,e}; }
ok(! exists $x{c});
}
+
+# local() and readonly magic variables
+
+eval { local $1 = 1 };
+like($@, qr/Modification of a read-only value attempted/);
+
+eval { for ($1) { local $_ = 1 } };
+like($@, qr/Modification of a read-only value attempted/);
+
+# make sure $1 is still read-only
+eval { for ($1) { local $_ = 1 } };
+is($@, "");
+
+# The s/// adds 'g' magic to $_, but it should remain non-readonly
+eval { for("a") { for $x (1,2) { local $_="b"; s/(.*)/+$1/ } } };
+is($@, "");
--- perl-5.8.8/scope.c.U27914 2005-09-30 09:56:51.000000000 -0400
+++ perl-5.8.8/scope.c 2006-06-01 19:49:54.000000000 -0400
@@ -205,9 +205,9 @@
register SV * const sv = *sptr = NEWSV(0,0);
if (SvTYPE(osv) >= SVt_PVMG && SvMAGIC(osv) && SvTYPE(osv) != SVt_PVGV) {
+ MAGIC *mg;
sv_upgrade(sv, SvTYPE(osv));
if (SvGMAGICAL(osv)) {
- MAGIC* mg;
const bool oldtainted = PL_tainted;
mg_get(osv); /* note, can croak! */
if (PL_tainting && PL_tainted &&
@@ -220,6 +220,16 @@
PL_tainted = oldtainted;
}
SvMAGIC_set(sv, SvMAGIC(osv));
+ /* if it's a special scalar or if it has no 'set' magic,
+ * propagate the SvREADONLY flag. --rgs 20030922 */
+ for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
+ if (mg->mg_type == '\0'
+ || !(mg->mg_virtual && mg->mg_virtual->svt_set))
+ {
+ SvFLAGS(sv) |= SvREADONLY(osv);
+ break;
+ }
+ }
SvFLAGS(sv) |= SvMAGICAL(osv);
/* XXX SvMAGIC() is *shared* between osv and sv. This can
* lead to coredumps when both SVs are destroyed without one
perl-5.8.8-bz188441.patch:
CGI.pm | 2 +-
1 files changed, 1 insertion(+), 1 deletion(-)
--- NEW FILE perl-5.8.8-bz188441.patch ---
--- perl-5.8.8/lib/CGI.pm.bz188441 2006-01-08 11:40:30.000000000 -0500
+++ perl-5.8.8/lib/CGI.pm 2006-04-12 18:49:26.000000000 -0400
@@ -2650,7 +2650,7 @@
return $url if $base;
$url .= $uri;
} elsif ($relative) {
- ($url) = $script_name =~ m!([^/]+)$!;
+ ($url) = $uri =~ m!([^/]+)$!;
} elsif ($absolute) {
$url = $uri;
}
perl-5.8.8-bz191416.patch:
t/lib/h2ph.pht | 10 +++++-----
utils/h2ph.PL | 2 +-
2 files changed, 6 insertions(+), 6 deletions(-)
--- NEW FILE perl-5.8.8-bz191416.patch ---
--- perl-5.8.8/t/lib/h2ph.pht.bz191416 2004-12-27 14:55:34.000000000 -0500
+++ perl-5.8.8/t/lib/h2ph.pht 2006-05-11 15:12:10.000000000 -0400
@@ -28,21 +28,21 @@
eval q((($a) < ($b) ? ($a) : ($b)));
}' unless defined(&MIN);
}
- if(!(defined (defined(&__SOMETHING_MORE_IMPORTANT) ? &__SOMETHING_MORE_IMPORTANT : 0))) {
+ if(!(defined (defined(&__SOMETHING_MORE_IMPORTANT) ? &__SOMETHING_MORE_IMPORTANT : undef))) {
}
- elsif(!(defined (defined(&__SOMETHING_REALLY_REALLY_IMPORTANT) ? &__SOMETHING_REALLY_REALLY_IMPORTANT : 0))) {
+ elsif(!(defined (defined(&__SOMETHING_REALLY_REALLY_IMPORTANT) ? &__SOMETHING_REALLY_REALLY_IMPORTANT : undef))) {
die("Nup, can't go on");
} else {
eval 'sub EVERYTHING_IS_OK () {1;}' unless defined(&EVERYTHING_IS_OK);
}
undef(&WHATEVER) if defined(&WHATEVER);
- if((!((defined (defined(&__SOMETHING_TRIVIAL) ? &__SOMETHING_TRIVIAL : 0) && defined (defined(&__SOMETHING_LESS_SO) ? &__SOMETHING_LESS_SO : 0))) || defined (defined(&__SOMETHING_OVERPOWERING) ? &__SOMETHING_OVERPOWERING : 0))) {
+ if((!((defined (defined(&__SOMETHING_TRIVIAL) ? &__SOMETHING_TRIVIAL : undef) && defined (defined(&__SOMETHING_LESS_SO) ? &__SOMETHING_LESS_SO : undef))) || defined (defined(&__SOMETHING_OVERPOWERING) ? &__SOMETHING_OVERPOWERING : undef))) {
eval 'sub WHATEVER () {6;}' unless defined(&WHATEVER);
}
- elsif(!(defined (defined(&__SOMETHING_TRIVIAL) ? &__SOMETHING_TRIVIAL : 0)) ) {
+ elsif(!(defined (defined(&__SOMETHING_TRIVIAL) ? &__SOMETHING_TRIVIAL : undef)) ) {
eval 'sub WHATEVER () {7;}' unless defined(&WHATEVER);
}
- elsif(!(defined (defined(&__SOMETHING_LESS_SO) ? &__SOMETHING_LESS_SO : 0)) ) {
+ elsif(!(defined (defined(&__SOMETHING_LESS_SO) ? &__SOMETHING_LESS_SO : undef)) ) {
eval 'sub WHATEVER () {8;}' unless defined(&WHATEVER);
} else {
eval 'sub WHATEVER () {1000;}' unless defined(&WHATEVER);
--- perl-5.8.8/utils/h2ph.PL.bz191416 2006-05-11 15:10:52.000000000 -0400
+++ perl-5.8.8/utils/h2ph.PL 2006-05-11 15:11:49.000000000 -0400
@@ -514,7 +514,7 @@
}
} else {
if ($inif && $new !~ /defined\s*\($/) {
- $new .= '(defined(&' . $id . ') ? &' . $id . ' : 0)';
+ $new .= '(defined(&' . $id . ') ? &' . $id . ' : undef)';
} elsif (/^\[/) {
$new .= " \$$id";
} else {
perl-5.8.8-no_asm_page_h.patch:
SysV.xs | 3 ---
1 files changed, 3 deletions(-)
--- NEW FILE perl-5.8.8-no_asm_page_h.patch ---
--- perl-5.8.8/ext/IPC/SysV/SysV.xs.no_asm_page_h 2001-06-30 14:46:07.000000000 -0400
+++ perl-5.8.8/ext/IPC/SysV/SysV.xs 2006-06-02 17:37:22.000000000 -0400
@@ -3,9 +3,6 @@
#include "XSUB.h"
#include <sys/types.h>
-#ifdef __linux__
-# include <asm/page.h>
-#endif
#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
#ifndef HAS_SEM
# include <sys/ipc.h>
perl-5.8.7-172396.patch:
Configure | 54 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
config_h.SH | 13 ++++++++++++-
reentr.inc | 4 ++--
3 files changed, 68 insertions(+), 3 deletions(-)
Index: perl-5.8.7-172396.patch
===================================================================
RCS file: /cvs/dist/rpms/perl/FC-5/perl-5.8.7-172396.patch,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- perl-5.8.7-172396.patch 3 Nov 2005 19:14:29 -0000 1.1
+++ perl-5.8.7-172396.patch 2 Jun 2006 23:19:24 -0000 1.2
@@ -1,21 +1,6 @@
---- perl-5.8.7/reentr.inc.161305 2005-11-03 12:56:58.000000000 -0500
-+++ perl-5.8.7/reentr.inc 2005-11-03 12:58:16.000000000 -0500
-@@ -1368,10 +1368,10 @@
- #ifdef HAS_LOCALTIME_R
- # undef localtime
- # if !defined(localtime) && LOCALTIME_R_PROTO == REENTRANT_PROTO_S_TS
--# define localtime(a) (localtime_r(a, &PL_reentrant_buffer->_localtime_struct) ? &PL_reentrant_buffer->_localtime_struct : 0)
-+# define localtime(a) ( L_R_TZSET localtime_r(a, &PL_reentrant_buffer->_localtime_struct) ? &PL_reentrant_buffer->_localtime_struct : 0)
- # endif
- # if !defined(localtime) && LOCALTIME_R_PROTO == REENTRANT_PROTO_I_TS
--# define localtime(a) (localtime_r(a, &PL_reentrant_buffer->_localtime_struct) == 0 ? &PL_reentrant_buffer->_localtime_struct : 0)
-+# define localtime(a) ( L_R_TZSET localtime_r(a, &PL_reentrant_buffer->_localtime_struct) == 0 ? &PL_reentrant_buffer->_localtime_struct : 0)
- # endif
- #endif /* HAS_LOCALTIME_R */
-
---- perl-5.8.7/config_h.SH.161305 2005-04-30 10:34:20.000000000 -0400
-+++ perl-5.8.7/config_h.SH 2005-11-03 12:58:16.000000000 -0500
-@@ -1916,7 +1916,18 @@
+--- perl-5.8.8/config_h.SH.bz172396 2005-10-31 13:13:05.000000000 -0500
++++ perl-5.8.8/config_h.SH 2006-05-11 16:20:36.000000000 -0400
+@@ -1912,7 +1912,18 @@
*/
#$d_localtime_r HAS_LOCALTIME_R /**/
#define LOCALTIME_R_PROTO $localtime_r_proto /**/
@@ -35,9 +20,24 @@
/* HAS_LONG_DOUBLE:
* This symbol will be defined if the C compiler supports long
* doubles.
---- perl-5.8.7/Configure.161305 2005-11-03 12:56:58.000000000 -0500
-+++ perl-5.8.7/Configure 2005-11-03 13:13:54.000000000 -0500
-@@ -528,6 +528,7 @@
+--- perl-5.8.8/reentr.inc.bz172396 2006-05-11 16:20:36.000000000 -0400
++++ perl-5.8.8/reentr.inc 2006-05-11 16:20:36.000000000 -0400
+@@ -1368,10 +1368,10 @@
+ #ifdef HAS_LOCALTIME_R
+ # undef localtime
+ # if !defined(localtime) && LOCALTIME_R_PROTO == REENTRANT_PROTO_S_TS
+-# define localtime(a) (localtime_r(a, &PL_reentrant_buffer->_localtime_struct) ? &PL_reentrant_buffer->_localtime_struct : 0)
++# define localtime(a) ( L_R_TZSET localtime_r(a, &PL_reentrant_buffer->_localtime_struct) ? &PL_reentrant_buffer->_localtime_struct : 0)
+ # endif
+ # if !defined(localtime) && LOCALTIME_R_PROTO == REENTRANT_PROTO_I_TS
+-# define localtime(a) (localtime_r(a, &PL_reentrant_buffer->_localtime_struct) == 0 ? &PL_reentrant_buffer->_localtime_struct : 0)
++# define localtime(a) ( L_R_TZSET localtime_r(a, &PL_reentrant_buffer->_localtime_struct) == 0 ? &PL_reentrant_buffer->_localtime_struct : 0)
+ # endif
+ #endif /* HAS_LOCALTIME_R */
+
+--- perl-5.8.8/Configure.bz172396 2006-05-11 16:20:36.000000000 -0400
++++ perl-5.8.8/Configure 2006-05-11 16:21:47.000000000 -0400
+@@ -542,6 +542,7 @@
d_libm_lib_version=''
d_link=''
d_localtime_r=''
@@ -45,7 +45,7 @@
localtime_r_proto=''
d_locconv=''
d_lockf=''
-@@ -14023,7 +14024,55 @@
+@@ -14261,7 +14262,59 @@
*) localtime_r_proto=0
;;
esac
@@ -69,16 +69,17 @@
+ *tz_e = (char*)malloc(16),
+ *tz_w = (char*)malloc(16);
+ struct tm tm_e, tm_w;
-+
++ memset(&tm_e,'\0',sizeof(struct tm));
++ memset(&tm_w,'\0',sizeof(struct tm));
+ strcpy(tz_e,e_tz);
+ strcpy(tz_w,w_tz);
-+
+
+ putenv(tz_e);
+ localtime_r(&t, &tm_e);
+
+ putenv(tz_w);
+ localtime_r(&t, &tm_w);
-
++
+ if( memcmp(&tm_e, &tm_w, sizeof(struct tm)) == 0 )
+ return 1;
+ return 0;
@@ -97,11 +98,14 @@
+ fi;
+ rm -f try.c;
+ ;;
++ *)
++ d_localtime_r_needs_tzset=undef;
++ ;;
+esac
: see if localeconv exists
set localeconv d_locconv
eval $inlibc
-@@ -20769,6 +20818,7 @@
+@@ -21220,6 +21273,7 @@
d_libm_lib_version='$d_libm_lib_version'
d_link='$d_link'
d_localtime_r='$d_localtime_r'
Index: perl.spec
===================================================================
RCS file: /cvs/dist/rpms/perl/FC-5/perl.spec,v
retrieving revision 1.88
retrieving revision 1.89
diff -u -r1.88 -r1.89
--- perl.spec 8 Mar 2006 22:54:37 -0000 1.88
+++ perl.spec 2 Jun 2006 23:19:24 -0000 1.89
@@ -5,7 +5,7 @@
%define multilib_64_archs x86_64 s390x ppc64 sparc64
%define perlver 5.8.8
-%define perlrel 4
+%define perlrel 5
%define perlepoch 4
%{?!perl_debugging: %define perl_debugging 0}
@@ -154,7 +154,25 @@
Patch34: perl-5.8.8-up27284.patch
# Fix for bug 183553 / upstream bug 38657:
Patch35: perl-5.8.8-bz183553_ubz38657.patch
+#
+Patch188841: perl-5.8.8-bz188441.patch
+#
+Patch191416: perl-5.8.8-bz191416.patch
+Patch27116: perl-5.8.8-U27116.patch
+Patch27391: perl-5.8.8-U27391.patch
+Patch27426: perl-5.8.8-U27426.patch
+Patch27509: perl-5.8.8-U27509.patch
+Patch27512: perl-5.8.8-U27512.patch
+Patch27604: perl-5.8.8-U27604.patch
+Patch27605: perl-5.8.8-U27605.patch
+Patch27914: perl-5.8.8-U27914.patch
+Patch27329: perl-5.8.8-U27329.patch
+Patch36: perl-5.8.8-R-switch.patch
+Patch37: perl-5.8.8-no_asm_page_h.patch
+# ^- stop IPC/SysV.c including <asm/page.h> for getpagesize(), which
+# is now declared by including <unistd.h> .
+#
BuildRoot: %{_tmppath}/%{name}-%{version}-%{release}-root-%(%{__id_u} -n)
BuildRequires: gawk, grep, tcsh, dos2unix, man, groff
BuildRequires: gdbm-devel, db4-devel
@@ -334,6 +352,32 @@
%patch35 -p1
+%patch188841 -p1
+
+%patch191416 -p1
+
+%patch27116 -p1
+
+%patch27391 -p1
+
+%patch27426 -p1
+
+%patch27509 -p1
+
+%patch27512 -p1
+
+%patch27604 -p1
+
+%patch27605 -p1
+
+%patch27914 -p1
+
+%patch27329 -p1
+
+%patch36 -p1
+
+%patch37 -p1
+
# Candidates for doc recoding (need case by case review):
# find . -name "*.pod" -o -name "README*" -o -name "*.pm" | xargs file -i | grep charset= | grep -v '\(us-ascii\|utf-8\)'
recode()
@@ -421,10 +465,7 @@
-Dinc_version_list='%{perlmodcompat}' \
-Dscriptdir='%{_bindir}'
-make
-# perl 5.8.6 - some tests fail (see bug #127023 comments #{31,32,34})
-# So ? then we should fix the tests / fix perl!
-# make test || /bin/true
+make %{?_smp_mflags}
make test
@@ -505,8 +546,6 @@
# Core modules removal
#
find $RPM_BUILD_ROOT -name '*NDBM*' | xargs rm -rfv
-find $RPM_BUILD_ROOT -name '*DBM_Filter*' | xargs rm -rfv
-
find $RPM_BUILD_ROOT -type f -name '*.bs' -a -empty -exec rm -f {} ';'
@@ -519,7 +558,6 @@
%clean
rm -rf $RPM_BUILD_ROOT
-
%files
%defattr(-,root,root,-)
%{_mandir}/man1/*.1*
@@ -536,12 +574,42 @@
%if %{suidperl}
%files suidperl
-%defattr(-,root,root,-)
%{_bindir}/suidperl
%{_bindir}/sperl%{perlver}
%endif
%changelog
+* Thu Jun 01 2006 Jason Vas Dias <jvdias at redhat.com> - 4:5.8.8-5
+- Fix upstream perl bug 38454:
+ 'rindex corrects for $[ on bytes rather than UTF-8'
+ apply upstream patch #27116
+- Fix upstream perl bug 24816:
+ 'Magic vars seem unsure if they are purely numeric'
+ ( perl -wle 'print $? = $? ^ "3"' -> 'Argument "^C" isn't numeric' )
+ apply upstream patch #27391
+- Avoid writing over the input string in the case 'F' in moreswitches.
+ apply upstream patch #27426
+- Fix upstream perl bug 34925 - 'overload and rebless' -
+ apply upstream patches #27509, #27512
+- Fix upstream perl bug 3038 - '$qr = qr/^a$/m; $x =~ $qr; fails'
+ apply upstream patch #27604
+- apply upstream patch #27605 - 'Fix off-by-one in $0 set magic.'
+- Fix upstream perl bug 23141 - '($_) = () fails to set $_ to undef'
+ apply upstream patch #27914
+- Fix upstream perl bug 38619 -
+ 'Bug in lc and uc (interaction between UTF-8, substr, and lc/uc)'
+ apply upstream patch #27329
+- Give users the '-R' option to disable the Red Hat
+ module compatibility default search path extension (incpush.patch).
+
+* Thu May 11 2006 Jason Vas Dias <jvdias at redhat.com> - 4:5.8.8-5
+- Fix bug 191416: make h2ph generate correct code for cpp statements
+ like: '#if defined A || defined B'
+- Fix 172396.patch for non-threaded builds
+
+* Wed Apr 12 2006 Jason Vas Dias <jvdias at redhat.com> - 4:5.8.8-5
+- Fix bug 188841: make CGI.pm's url(-relative) handle rewrites
+
* Tue Mar 01 2006 Jason Vas Dias <jvdias at redhat.com> - 4:5.8.8-4
- Fix bug 183553 / upstream bug 38657: fix -d:Foo=bar processing
- rebuild with new gcc-4.1.0-1, released today
- Previous message (by thread): rpms/fontconfig/FC-5 fontconfig-2.3.95-ttf-collections.patch, NONE, 1.1 fontconfig-2.4-cmap-parsing.patch, NONE, 1.1 fontconfig.spec, 1.72, 1.73
- Next message (by thread): rpms/evolution/FC-5 evolution-2.6.2-badalloc-crash.patch, NONE, 1.1.2.1 evolution.spec, 1.137.2.1, 1.137.2.2
- Messages sorted by:
[ date ]
[ thread ]
[ subject ]
[ author ]
More information about the fedora-cvs-commits
mailing list