Change 26692 by [EMAIL PROTECTED] on 2006/01/07 00:24:12
Integrate:
[ 26215]
Subject: [PATCH] fix wrong pool error in cygwin build
From: Yitzchak Scott-Thoennes <[EMAIL PROTECTED]>
Date: Nov 27, 2005 9:29 AM
Message-ID: <[EMAIL PROTECTED]>
[ 26226]
Revert change #22520 (optimise away my $foo = undef and similar
constructs), in order to fix bug perl #37776
[ 26227]
Fix B::Concise tests after change #26226
[ 26228]
The regexp engine should check SV flags rather than SV type for
determining if something is a reference, because under the debugger
the value returned by the swash code is SVt_PVMG.
Not doing this has the side effect of repeatedly reassigning the
same array element, which causes destructors to fire on the reassignment
which in turn causes &utf8::DESTROY to run outside of the pseudo-safety
of save_re_context, which under the debugger involves re-entering the
regexp engine, which causes corruption of the regexp engine's global
state.
[ 26253]
NULL is a legal value for newXS()'s name parameter.
(This caused strange build failures with gcc4 -O3)
[ 26258]
Subject: Re: [perl #37836] Simple Regex causes SEGV when run on
specific data
From: SADAHIRO Tomoyuki <[EMAIL PROTECTED]>
Date: Tue, 06 Dec 2005 00:35:52 +0900
Message-Id: <[EMAIL PROTECTED]>
[ 26259]
"Malformed UTF-8 character" was a severe warning, and can now be
also a fatal error (since change #26258)
[ 26325]
Fix *printf %*vd with mixed Latin 1/UTF-8. (Fixes bug 37889)
[ 26373]
Prevent require() from attempting to open directories and block
devices. This fixes RT #24404.
[ 26375]
Added test for change #26373.
[ 26376]
change #26373 broke threaded builds (aTHX_ now superfluous)
[ 26377]
comp/require.t exits early for the case of UTF-8 or EBCDIC, so need to
add "new" tests before the end.
[ 26397]
Subject: [PATCH] Make script embedded in patchlevel.h work on win32.
From: demerphq <[EMAIL PROTECTED]> Mailed-By: perl.org
Date: Dec 17, 2005 7:52 PM
Message-ID: <[EMAIL PROTECTED]>
[ 26431]
Fix for [perl #37999] lc() + Latin-1 chars is failing erratically
based on copying part of change #22196 from do_chomp() to do_chop().
[ 26441]
Subject: [PATCH] wrong setting in canned win32/config.vc64 file
From: "Jan Dubois" <[EMAIL PROTECTED]>
Date: Wed, 21 Dec 2005 15:04:30 -0800
Message-ID: <[EMAIL PROTECTED]>
[ 26551]
Calling Perl_hv_clear_placeholders while the hash iterator was active
would turn lazy delete on, causing the hash to become corrupted at the
next iterator change.
[ 26581]
Subject: [EMAIL PROTECTED] & earlier - buffer overrun in VMS.C
From: "John E. Malmberg" <[EMAIL PROTECTED]>
Date: Mon, 02 Jan 2006 14:05:43 -0500
Message-id: <[EMAIL PROTECTED]>
[ 26591]
ithreads: SVs that were only on the tmps stack leaked
[ 26659]
Subject: MinGW and lib/CORE/Win32.h
From: "Sisyphus" <[EMAIL PROTECTED]>
Date: Wed, 4 Jan 2006 21:29:19 +1100
Message-ID: <[EMAIL PROTECTED]>
Affected files ...
... //depot/maint-5.8/perl/cygwin/cygwin.c#5 integrate
... //depot/maint-5.8/perl/doop.c#33 integrate
... //depot/maint-5.8/perl/embed.fnc#119 integrate
... //depot/maint-5.8/perl/embed.h#90 integrate
... //depot/maint-5.8/perl/ext/B/t/optree_varinit.t#10 integrate
... //depot/maint-5.8/perl/hv.c#73 integrate
... //depot/maint-5.8/perl/lib/Hash/Util.t#12 integrate
... //depot/maint-5.8/perl/op.c#119 integrate
... //depot/maint-5.8/perl/patchlevel.h#167 integrate
... //depot/maint-5.8/perl/pod/perldiag.pod#81 integrate
... //depot/maint-5.8/perl/pp_ctl.c#110 integrate
... //depot/maint-5.8/perl/proto.h#109 integrate
... //depot/maint-5.8/perl/regexec.c#57 integrate
... //depot/maint-5.8/perl/sv.c#205 integrate
... //depot/maint-5.8/perl/t/comp/require.t#8 integrate
... //depot/maint-5.8/perl/t/op/my.t#3 edit
... //depot/maint-5.8/perl/t/uni/sprintf.t#2 integrate
... //depot/maint-5.8/perl/vms/vms.c#17 integrate
... //depot/maint-5.8/perl/win32/config.vc64#18 integrate
... //depot/maint-5.8/perl/win32/win32.h#7 integrate
Differences ...
==== //depot/maint-5.8/perl/cygwin/cygwin.c#5 (text) ====
Index: perl/cygwin/cygwin.c
--- perl/cygwin/cygwin.c#4~25572~ 2005-09-22 09:46:28.000000000 -0700
+++ perl/cygwin/cygwin.c 2006-01-06 16:24:12.000000000 -0800
@@ -147,7 +147,7 @@
Perl_croak(aTHX_ "Usage: Cwd::cwd()");
if((cwd = getcwd(NULL, -1))) {
ST(0) = sv_2mortal(newSVpv(cwd, 0));
- safesysfree(cwd);
+ free(cwd);
#ifndef INCOMPLETE_TAINTS
SvTAINTED_on(ST(0));
#endif
==== //depot/maint-5.8/perl/doop.c#33 (text) ====
Index: perl/doop.c
--- perl/doop.c#32~26689~ 2006-01-06 15:03:51.000000000 -0800
+++ perl/doop.c 2006-01-06 16:24:12.000000000 -0800
@@ -967,6 +967,13 @@
if (SvREADONLY(sv))
Perl_croak(aTHX_ PL_no_modify);
}
+
+ if (PL_encoding && !SvUTF8(sv)) {
+ /* like in do_chomp(), utf8-ize the sv as a side-effect
+ * if we're using encoding. */
+ sv_recode_to_utf8(sv, PL_encoding);
+ }
+
s = SvPV(sv, len);
if (len && !SvPOK(sv))
s = SvPV_force(sv, len);
==== //depot/maint-5.8/perl/embed.fnc#119 (text) ====
Index: perl/embed.fnc
--- perl/embed.fnc#118~26686~ 2006-01-06 14:05:28.000000000 -0800
+++ perl/embed.fnc 2006-01-06 16:24:12.000000000 -0800
@@ -525,7 +525,7 @@
Apa |OP* |newSLICEOP |I32 flags|NULLOK OP* subscript|NULLOK OP*
listop
Apa |OP* |newSTATEOP |I32 flags|NULLOK char* label|NULLOK OP* o
Ap |CV* |newSUB |I32 floor|NULLOK OP* o|NULLOK OP* proto|NULLOK
OP* block
-Apd |CV* |newXS |NN char* name|NN XSUBADDR_t f|NN char* filename
+Apd |CV* |newXS |NULLOK char* name|NN XSUBADDR_t f|NN char*
filename
Apda |AV* |newAV
Apa |OP* |newAVREF |NN OP* o
Apa |OP* |newBINOP |I32 type|I32 flags|NULLOK OP* first|NULLOK OP*
last
@@ -1132,6 +1132,7 @@
sR |I32 |dopoptosub_at |NN const PERL_CONTEXT* cxstk|I32 startingblock
s |void |save_lines |NULLOK AV *array|NN SV *sv
sR |OP* |doeval |int gimme|NULLOK OP** startop|NULLOK CV*
outside|U32 seq
+sR |PerlIO *|check_type_and_open|NN const char *name|NN const char *mode
sR |PerlIO *|doopen_pm |NN const char *name|NN const char *mode
sR |bool |path_is_absolute|NN const char *name
#endif
==== //depot/maint-5.8/perl/embed.h#90 (text+w) ====
Index: perl/embed.h
--- perl/embed.h#89~26568~ 2006-01-02 04:09:25.000000000 -0800
+++ perl/embed.h 2006-01-06 16:24:12.000000000 -0800
@@ -1194,6 +1194,7 @@
#define dopoptosub_at S_dopoptosub_at
#define save_lines S_save_lines
#define doeval S_doeval
+#define check_type_and_open S_check_type_and_open
#define doopen_pm S_doopen_pm
#define path_is_absolute S_path_is_absolute
#endif
@@ -3230,6 +3231,7 @@
#define dopoptosub_at(a,b) S_dopoptosub_at(aTHX_ a,b)
#define save_lines(a,b) S_save_lines(aTHX_ a,b)
#define doeval(a,b,c,d) S_doeval(aTHX_ a,b,c,d)
+#define check_type_and_open(a,b) S_check_type_and_open(aTHX_ a,b)
#define doopen_pm(a,b) S_doopen_pm(aTHX_ a,b)
#define path_is_absolute(a) S_path_is_absolute(aTHX_ a)
#endif
==== //depot/maint-5.8/perl/ext/B/t/optree_varinit.t#10 (text) ====
Index: perl/ext/B/t/optree_varinit.t
--- perl/ext/B/t/optree_varinit.t#9~24302~ 2005-04-22 14:25:13.000000000
-0700
+++ perl/ext/B/t/optree_varinit.t 2006-01-06 16:24:12.000000000 -0800
@@ -131,15 +131,19 @@
code => sub {my $a=undef},
bcopts => '-basic',
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
-3 <1> leavesub[1 ref] K/REFC,1 ->(end)
-- <@> lineseq KP ->3
-1 <;> nextstate(main 24 optree.t:99) v ->2
-2 <0> padsv[$a:24,25] sRM*/LVINTRO ->3
-EOT_EOT
-# 3 <1> leavesub[1 ref] K/REFC,1 ->(end)
-# - <@> lineseq KP ->3
-# 1 <;> nextstate(main 54 optree.t:149) v ->2
-# 2 <0> padsv[$a:54,55] sRM*/LVINTRO ->3
+5 <1> leavesub[1 ref] K/REFC,1 ->(end)
+- <@> lineseq KP ->5
+1 <;> nextstate(main 641 optree_varinit.t:130) v ->2
+4 <2> sassign sKS/2 ->5
+2 <0> undef s ->3
+3 <0> padsv[$a:641,642] sRM*/LVINTRO ->4
+EOT_EOT
+# 5 <1> leavesub[1 ref] K/REFC,1 ->(end)
+# - <@> lineseq KP ->5
+# 1 <;> nextstate(main 641 optree_varinit.t:130) v ->2
+# 4 <2> sassign sKS/2 ->5
+# 2 <0> undef s ->3
+# 3 <0> padsv[$a:641,642] sRM*/LVINTRO ->4
EONT_EONT
checkOptree ( name => 'sub {our $a=undef}',
@@ -190,15 +194,19 @@
prog => 'my $a=undef',
bcopts => '-basic',
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
-4 <@> leave[1 ref] vKP/REFC ->(end)
+6 <@> leave[1 ref] vKP/REFC ->(end)
1 <0> enter ->2
2 <;> nextstate(main 1 -e:1) v ->3
-3 <0> padsv[$a:1,2] vRM*/LVINTRO ->4
+5 <2> sassign vKS/2 ->6
+3 <0> undef s ->4
+4 <0> padsv[$a:1,2] sRM*/LVINTRO ->5
EOT_EOT
-# 4 <@> leave[1 ref] vKP/REFC ->(end)
+# 6 <@> leave[1 ref] vKP/REFC ->(end)
# 1 <0> enter ->2
# 2 <;> nextstate(main 1 -e:1) v ->3
-# 3 <0> padsv[$a:1,2] vRM*/LVINTRO ->4
+# 5 <2> sassign vKS/2 ->6
+# 3 <0> undef s ->4
+# 4 <0> padsv[$a:1,2] sRM*/LVINTRO ->5
EONT_EONT
checkOptree ( name => 'our $a=undef',
==== //depot/maint-5.8/perl/hv.c#73 (text) ====
Index: perl/hv.c
--- perl/hv.c#72~26688~ 2006-01-06 14:22:00.000000000 -0800
+++ perl/hv.c 2006-01-06 16:24:12.000000000 -0800
@@ -1540,7 +1540,7 @@
*oentry = HeNEXT(entry);
if (first && !*oentry)
HvFILL(hv)--; /* This linked list is now empty. */
- if (HvEITER_get(hv))
+ if (entry == HvEITER_get(hv))
HvLAZYDEL_on(hv);
else
hv_free_ent(hv, entry);
==== //depot/maint-5.8/perl/lib/Hash/Util.t#12 (text) ====
Index: perl/lib/Hash/Util.t
--- perl/lib/Hash/Util.t#11~22454~ 2004-03-07 03:57:56.000000000 -0800
+++ perl/lib/Hash/Util.t 2006-01-06 16:24:12.000000000 -0800
@@ -6,7 +6,7 @@
chdir 't';
}
}
-use Test::More tests => 173;
+use Test::More tests => 179;
use strict;
my @Exported_Funcs;
@@ -323,3 +323,22 @@
is ($counter, 0, "0 objects after clear $state");
}
}
+
+{
+ my %hash = map {$_,$_} qw(fwiffffff foosht teeoo);
+ lock_keys(%hash);
+ delete $hash{fwiffffff};
+ is (scalar keys %hash, 2);
+ unlock_keys(%hash);
+ is (scalar keys %hash, 2);
+
+ my ($first, $value) = each %hash;
+ is ($hash{$first}, $value, "Key has the expected value before the lock");
+ lock_keys(%hash);
+ is ($hash{$first}, $value, "Key has the expected value after the lock");
+
+ my ($second, $v2) = each %hash;
+
+ is ($hash{$first}, $value, "Still correct after iterator advances");
+ is ($hash{$second}, $v2, "Other key has the expected value");
+}
==== //depot/maint-5.8/perl/op.c#119 (text) ====
Index: perl/op.c
--- perl/op.c#118~26688~ 2006-01-06 14:22:00.000000000 -0800
+++ perl/op.c 2006-01-06 16:24:12.000000000 -0800
@@ -3304,15 +3304,6 @@
/* Result of assignment is always 1 (or we'd be dead already) */
return newSVOP(OP_CONST, 0, newSViv(1));
}
- /* optimise C<my @x = ()> to C<my @x>, and likewise for hashes */
- if ((left->op_type == OP_PADAV || left->op_type == OP_PADHV)
- && right->op_type == OP_STUB
- && (left->op_private & OPpLVAL_INTRO))
- {
- op_free(right);
- left->op_flags &= ~(OPf_REF|OPf_SPECIAL);
- return left;
- }
curop = list(force_list(left));
o = newBINOP(OP_AASSIGN, flags, list(force_list(right)), curop);
o->op_private = (U8)(0 | (flags >> 8));
@@ -5782,19 +5773,6 @@
return kid;
}
}
- /* optimise C<my $x = undef> to C<my $x> */
- if (kid->op_type == OP_UNDEF) {
- OP * const kkid = kid->op_sibling;
- if (kkid && kkid->op_type == OP_PADSV
- && (kkid->op_private & OPpLVAL_INTRO))
- {
- cLISTOPo->op_first = NULL;
- kid->op_sibling = NULL;
- op_free(o);
- op_free(kid);
- return kkid;
- }
- }
return o;
}
==== //depot/maint-5.8/perl/patchlevel.h#167 (text) ====
Index: perl/patchlevel.h
--- perl/patchlevel.h#166~25826~ 2005-10-23 13:14:50.000000000 -0700
+++ perl/patchlevel.h 2006-01-06 16:24:12.000000000 -0800
@@ -100,6 +100,7 @@
}
close PLOUT or die "Couldn't close filehandle writing to patchlevel.new : $!";
close PLIN or die "Couldn't close filehandle reading from patchlevel.h : $!";
+close DATA; # needed to allow unlink to work win32.
unlink "patchlevel.bak" or warn "Couldn't unlink patchlevel.bak : $!"
if -e "patchlevel.bak";
rename "patchlevel.h", "patchlevel.bak" or
==== //depot/maint-5.8/perl/pod/perldiag.pod#81 (text) ====
Index: perl/pod/perldiag.pod
--- perl/pod/perldiag.pod#80~26621~ 2006-01-03 11:20:46.000000000 -0800
+++ perl/pod/perldiag.pod 2006-01-06 16:24:12.000000000 -0800
@@ -2056,7 +2056,8 @@
=item Malformed UTF-8 character (%s)
-(W utf8) Perl detected something that didn't comply with UTF-8 encoding rules.
+(S utf8) (F) Perl detected something that didn't comply with UTF-8
+encoding rules.
One possible cause is that you read in data that you thought to be in
UTF-8 but it wasn't (it was for example legacy 8-bit data). Another
==== //depot/maint-5.8/perl/pp_ctl.c#110 (text) ====
Index: perl/pp_ctl.c
--- perl/pp_ctl.c#109~26689~ 2006-01-06 15:03:51.000000000 -0800
+++ perl/pp_ctl.c 2006-01-06 16:24:12.000000000 -0800
@@ -2989,6 +2989,23 @@
}
STATIC PerlIO *
+S_check_type_and_open(pTHX_ const char *name, const char *mode)
+{
+ Stat_t st;
+ int st_rc;
+ st_rc = PerlLIO_stat(name, &st);
+ if (st_rc < 0) {
+ return Nullfp;
+ }
+
+ if(S_ISDIR(st.st_mode) || S_ISBLK(st.st_mode)) {
+ Perl_die(aTHX_ "%s %s not allowed in require",
+ S_ISDIR(st.st_mode) ? "Directory" : "Block device", name);
+ }
+ return PerlIO_open(name, mode);
+}
+
+STATIC PerlIO *
S_doopen_pm(pTHX_ const char *name, const char *mode)
{
#ifndef PERL_DISABLE_PMC
@@ -3000,27 +3017,27 @@
const char * const pmc = SvPV_nolen_const(pmcsv);
Stat_t pmcstat;
if (PerlLIO_stat(pmc, &pmcstat) < 0) {
- fp = PerlIO_open(name, mode);
+ fp = check_type_and_open(name, mode);
}
else {
Stat_t pmstat;
if (PerlLIO_stat(name, &pmstat) < 0 ||
pmstat.st_mtime < pmcstat.st_mtime)
{
- fp = PerlIO_open(pmc, mode);
+ fp = check_type_and_open(pmc, mode);
}
else {
- fp = PerlIO_open(name, mode);
+ fp = check_type_and_open(name, mode);
}
}
SvREFCNT_dec(pmcsv);
}
else {
- fp = PerlIO_open(name, mode);
+ fp = check_type_and_open(name, mode);
}
return fp;
#else
- return PerlIO_open(name, mode);
+ return check_type_and_open(name, mode);
#endif /* !PERL_DISABLE_PMC */
}
==== //depot/maint-5.8/perl/proto.h#109 (text+w) ====
Index: perl/proto.h
--- perl/proto.h#108~26686~ 2006-01-06 14:05:28.000000000 -0800
+++ perl/proto.h 2006-01-06 16:24:12.000000000 -0800
@@ -1420,7 +1420,6 @@
PERL_CALLCONV CV* Perl_newSUB(pTHX_ I32 floor, OP* o, OP* proto, OP*
block);
PERL_CALLCONV CV* Perl_newXS(pTHX_ char* name, XSUBADDR_t f, char*
filename)
- __attribute__nonnull__(pTHX_1)
__attribute__nonnull__(pTHX_2)
__attribute__nonnull__(pTHX_3);
@@ -3043,6 +3042,11 @@
STATIC OP* S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
__attribute__warn_unused_result__;
+STATIC PerlIO * S_check_type_and_open(pTHX_ const char *name, const
char *mode)
+ __attribute__warn_unused_result__
+ __attribute__nonnull__(pTHX_1)
+ __attribute__nonnull__(pTHX_2);
+
STATIC PerlIO * S_doopen_pm(pTHX_ const char *name, const char *mode)
__attribute__warn_unused_result__
__attribute__nonnull__(pTHX_1)
==== //depot/maint-5.8/perl/regexec.c#57 (text) ====
Index: perl/regexec.c
--- perl/regexec.c#56~26689~ 2006-01-06 15:03:51.000000000 -0800
+++ perl/regexec.c 2006-01-06 16:24:12.000000000 -0800
@@ -4351,7 +4351,7 @@
* documentation of these array elements. */
si = *ary;
- a = SvTYPE(ary[1]) == SVt_RV ? &ary[1] : 0;
+ a = SvROK(ary[1]) ? &ary[1] : 0;
b = SvTYPE(ary[2]) == SVt_PVAV ? &ary[2] : 0;
if (a)
@@ -4392,9 +4392,13 @@
STRLEN len = 0;
STRLEN plen;
- if (do_utf8 && !UTF8_IS_INVARIANT(c))
+ if (do_utf8 && !UTF8_IS_INVARIANT(c)) {
c = utf8n_to_uvchr((U8 *)p, UTF8_MAXBYTES, &len,
- ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY);
+ ckWARN(WARN_UTF8) ? UTF8_CHECK_ONLY :
+ UTF8_ALLOW_ANYUV|UTF8_CHECK_ONLY);
+ if (len == (STRLEN)-1)
+ Perl_croak(aTHX_ "Malformed UTF-8 character (fatal)");
+ }
plen = lenp ? *lenp : UNISKIP(NATIVE_TO_UNI(c));
if (do_utf8 || (flags & ANYOF_UNICODE)) {
==== //depot/maint-5.8/perl/sv.c#205 (text) ====
Index: perl/sv.c
--- perl/sv.c#204~26688~ 2006-01-06 14:22:00.000000000 -0800
+++ perl/sv.c 2006-01-06 16:24:12.000000000 -0800
@@ -8729,8 +8729,16 @@
vecsv = svix < svmax ? svargs[svix++] : &PL_sv_undef;
}
dotstr = SvPV_const(vecsv, dotstrlen);
+ /* Keep the DO_UTF8 test *after* the SvPV call, else things go
+ bad with tied or overloaded values that return UTF8. */
if (DO_UTF8(vecsv))
is_utf8 = TRUE;
+ else if (has_utf8) {
+ vecsv = sv_mortalcopy(vecsv);
+ sv_utf8_upgrade(vecsv);
+ dotstr = SvPV_const(vecsv, dotstrlen);
+ is_utf8 = TRUE;
+ }
}
if (args) {
vecsv = va_arg(*args, SV*);
@@ -11527,6 +11535,20 @@
else {
init_stacks();
ENTER; /* perl_destruct() wants to LEAVE; */
+
+ /* although we're not duplicating the tmps stack, we should still
+ * add entries for any SVs on the tmps stack that got cloned by a
+ * non-refcount means (eg a temp in @_); otherwise they will be
+ * orphaned
+ */
+ for (i = 0; i<= proto_perl->Ttmps_ix; i++) {
+ SV *nsv = (SV*)ptr_table_fetch(PL_ptr_table,
+ proto_perl->Ttmps_stack[i]);
+ if (nsv && !SvREFCNT(nsv)) {
+ EXTEND_MORTAL(1);
+ PL_tmps_stack[++PL_tmps_ix] = SvREFCNT_inc(nsv);
+ }
+ }
}
PL_start_env = proto_perl->Tstart_env; /* XXXXXX */
==== //depot/maint-5.8/perl/t/comp/require.t#8 (xtext) ====
Index: perl/t/comp/require.t
--- perl/t/comp/require.t#7~21579~ 2003-10-30 11:24:06.000000000 -0800
+++ perl/t/comp/require.t 2006-01-06 16:24:12.000000000 -0800
@@ -11,8 +11,8 @@
my $Is_EBCDIC = (ord('A') == 193) ? 1 : 0;
my $Is_UTF8 = (${^OPEN} || "") =~ /:utf8/;
-my $total_tests = 30;
-if ($Is_EBCDIC || $Is_UTF8) { $total_tests = 27; }
+my $total_tests = 31;
+if ($Is_EBCDIC || $Is_UTF8) { $total_tests = 28; }
print "1..$total_tests\n";
sub do_require {
@@ -147,6 +147,20 @@
@foo = eval {require bleah}; delete $INC{"bleah.pm"}; ++$::i;
eval {require bleah};
+# Test for fix of RT #24404 : "require $scalar" may load a directory
+my $r = "threads";
+eval { require $r };
+$i++;
+if($@ =~ /Directory .*threads not allowed in require/) {
+ print "ok $i\n";
+} else {
+ print "not ok $i\n";
+}
+
+############################
+#### Add new tests here ####
+############################
+
# UTF-encoded things - skipped on EBCDIC machines and on UTF-8 input
if ($Is_EBCDIC || $Is_UTF8) { exit; }
==== //depot/maint-5.8/perl/t/op/my.t#3 (xtext) ====
Index: perl/t/op/my.t
--- perl/t/op/my.t#2~22784~ 2004-05-05 14:43:32.000000000 -0700
+++ perl/t/op/my.t 2006-01-06 16:24:12.000000000 -0800
@@ -2,7 +2,7 @@
# $RCSfile: my.t,v $
-print "1..33\n";
+print "1..36\n";
sub foo {
my($a, $b) = @_;
@@ -111,3 +111,13 @@
eval { my $x = opth };
print "not " if $@;
print "ok 33\n";
+# my $foo = undef should always assign [perl #37776]
+{
+ my $count = 34;
+ loop:
+ my $test = undef;
+ print "not " if defined $test;
+ print "ok $count\n";
+ $test = 42;
+ goto loop if ++$count < 37;
+}
==== //depot/maint-5.8/perl/t/uni/sprintf.t#2 (text) ====
Index: perl/t/uni/sprintf.t
--- perl/t/uni/sprintf.t#1~17645~ 2002-07-19 12:29:57.000000000 -0700
+++ perl/t/uni/sprintf.t 2006-01-06 16:24:12.000000000 -0800
@@ -6,7 +6,7 @@
require "test.pl";
}
-plan tests => 25;
+plan tests => 52;
$a = "B\x{fc}f";
$b = "G\x{100}r";
@@ -137,3 +137,19 @@
$sprintf = sprintf "%s%s", $w, "$w\x{100}";
is(substr($sprintf,0,2), $w, "utf8 echo echo");
}
+
+my @values =(chr 110, chr 255, chr 256);
+
+foreach my $prefix (@values) {
+ foreach my $vector (map {$_ . $_} @values) {
+
+ my $format = "$prefix%*vd";
+
+ foreach my $dot (@values) {
+ my $result = sprintf $format, $dot, $vector;
+ is (length $result, 8)
+ or print "# ", join (',', map {ord $_} $prefix, $dot, $vector),
+ "\n";
+ }
+ }
+}
==== //depot/maint-5.8/perl/vms/vms.c#17 (text) ====
Index: perl/vms/vms.c
--- perl/vms/vms.c#16~26577~ 2006-01-02 08:41:40.000000000 -0800
+++ perl/vms/vms.c 2006-01-06 16:24:12.000000000 -0800
@@ -3458,7 +3458,7 @@
else retspec = __fileify_retbuf;
cp1 = esa;
cp2 = retspec;
- while (*cp1 != ':') *(cp2++) = *(cp1++);
+ while ((*cp1 != ':') && (*cp1 != '\0')) *(cp2++) = *(cp1++);
strcpy(cp2,":[000000]");
cp1 += 2;
strcpy(cp2+9,cp1);
==== //depot/maint-5.8/perl/win32/config.vc64#18 (text) ====
Index: perl/win32/config.vc64
--- perl/win32/config.vc64#17~26115~ 2005-11-13 12:31:44.000000000 -0800
+++ perl/win32/config.vc64 2006-01-06 16:24:12.000000000 -0800
@@ -309,7 +309,7 @@
d_nanosleep='undef'
d_nice='undef'
d_nl_langinfo='undef'
-d_nv_preserves_uv='define'
+d_nv_preserves_uv='undef'
d_nv_zero_is_allbits_zero='define'
d_off64_t='undef'
d_old_pthread_create_joinable='undef'
==== //depot/maint-5.8/perl/win32/win32.h#7 (text) ====
Index: perl/win32/win32.h
--- perl/win32/win32.h#6~21623~ 2003-11-02 11:52:04.000000000 -0800
+++ perl/win32/win32.h 2006-01-06 16:24:12.000000000 -0800
@@ -230,6 +230,17 @@
# endif
#endif
+/* <stdint.h>, pulled in by <io.h> as of mingw-runtime-3.3, typedef's
+ * (u)intptr_t but doesn't set the _(U)INTPTR_T_DEFINED defines */
+#ifdef _STDINT_H
+# ifndef _INTPTR_T_DEFINED
+# define _INTPTR_T_DEFINED
+# endif
+# ifndef _UINTPTR_T_DEFINED
+# define _UINTPTR_T_DEFINED
+# endif
+#endif
+
#endif /* __MINGW32__ */
/* both GCC/Mingw32 and MSVC++ 4.0 are missing this, so we put it here */
End of Patch.
