Change 18271 by jhi@lyta on 2002/12/09 02:41:11
Integrate
[ 18249]
Suppress a compilation warning reported by Jarkko
(variable initialization skipped by goto).
[ 18250]
Fix bug #18874, essentially by reverting change #11890.
Add a regression test for it.
[ 18251]
Fix two cases of buffer overflow in the lexer.
[ 18259]
Subject: [PATCH] Re: [perl #18651] Hash::Util's lock_key() breaks hash
From: Nicholas Clark <[EMAIL PROTECTED]>
Date: Mon, 2 Dec 2002 21:48:29 +0000
Message-ID: <[EMAIL PROTECTED]>
[ 18260]
Document that $ENV{TERM} may produce taint failures.
Subject: Re: [perl #18717] spurious failures in regression test
From: Slaven Rezic <[EMAIL PROTECTED]>
Date: 29 Nov 2002 22:11:46 +0100
Message-ID: <[EMAIL PROTECTED]>
[ 18261]
Change the set of characters that are considered to be
safe in $ENV{TERM} for taint checkings.
[ 18262]
getservbyport() should accept an empty string as its
proto argument (as does getservbyname()).
Subject: Re: Is this a bug or am I being stupid?
From: Slaven Rezic <[EMAIL PROTECTED]>
Date: 08 Dec 2002 01:54:37 +0100
Message-ID: <[EMAIL PROTECTED]>
[ 18263]
Subject: Re: [perl #18888] $Exporter::Verbose=1 does not work for testing,
$Heavy::Verbose is not setting the value to $Exporter::Verbose
From: Slaven Rezic <[EMAIL PROTECTED]>
Date: 08 Dec 2002 01:31:45 +0100
Message-ID: <[EMAIL PROTECTED]>
[ 18264]
Subject: Re: [perl #18165] "0" fails as right-hand argument to ..
From: Slaven Rezic <[EMAIL PROTECTED]>
Date: 30 Nov 2002 00:07:05 +0100
Message-ID: <[EMAIL PROTECTED]>
[ 18265]
Subject: Re: [perl #18927] barewords with no errors
From: Abe Timmerman <[EMAIL PROTECTED]>
Date: Sun, 8 Dec 2002 17:12:56 +0100
Message-Id: <[EMAIL PROTECTED]>
[ 18266]
Subject: Re: [perl #18107] lc(), uc() and ucfirst() broken inside utf8 regex
From: Abhijit Menon-Sen <[EMAIL PROTECTED]>
Date: Wed, 6 Nov 2002 19:38:11 +0530
Message-ID: <[EMAIL PROTECTED]>
[ 18267]
Subject: Re: [perl #18238] timezone and gmt offset as output by
POSIX::strftime() are sometimes wrong
From: Slaven Rezic <[EMAIL PROTECTED]>
Date: 09 Nov 2002 23:21:16 +0100
Message-ID: <[EMAIL PROTECTED]>
[ 18268]
fix #18266 sprintf format mismatch
[ 18269]
Subject: Re: Bug in Filter::Simple
From: Slaven Rezic <[EMAIL PROTECTED]>
Date: 07 Nov 2002 10:01:41 +0100
Message-ID: <[EMAIL PROTECTED]>
[ 18270]
Subject: [perl #18256] xsubpp can make nested comments in C code
From: Nicholas Clark (via RT) <[EMAIL PROTECTED]>
Date: 7 Nov 2002 14:58:14 -0000
Message-Id: <[EMAIL PROTECTED]>
(plus regen Configure)
Affected files ...
.... //depot/maint-5.8/perl/Configure#8 edit
.... //depot/maint-5.8/perl/config_h.SH#6 edit
.... //depot/maint-5.8/perl/ext/Filter/Util/Call/Call.xs#2 integrate
.... //depot/maint-5.8/perl/ext/Filter/t/call.t#2 integrate
.... //depot/maint-5.8/perl/ext/POSIX/t/posix.t#3 integrate
.... //depot/maint-5.8/perl/hv.c#4 integrate
.... //depot/maint-5.8/perl/lib/English.pm#2 integrate
.... //depot/maint-5.8/perl/lib/English.t#2 integrate
.... //depot/maint-5.8/perl/lib/Exporter/Heavy.pm#3 integrate
.... //depot/maint-5.8/perl/lib/ExtUtils/xsubpp#2 integrate
.... //depot/maint-5.8/perl/lib/Hash/Util.t#4 integrate
.... //depot/maint-5.8/perl/pod/perldiag.pod#11 integrate
.... //depot/maint-5.8/perl/pp_ctl.c#4 integrate
.... //depot/maint-5.8/perl/pp_sys.c#6 integrate
.... //depot/maint-5.8/perl/regcomp.c#7 integrate
.... //depot/maint-5.8/perl/t/cmd/for.t#2 integrate
.... //depot/maint-5.8/perl/t/comp/parser.t#3 integrate
.... //depot/maint-5.8/perl/t/lib/strict/subs#3 integrate
.... //depot/maint-5.8/perl/t/op/lc.t#5 integrate
.... //depot/maint-5.8/perl/taint.c#2 integrate
.... //depot/maint-5.8/perl/toke.c#4 integrate
.... //depot/maint-5.8/perl/util.c#8 integrate
Differences ...
==== //depot/maint-5.8/perl/Configure#8 (xtext) ====
Index: perl/Configure
--- perl/Configure#7~18197~ Wed Nov 27 20:14:27 2002
+++ perl/Configure Sun Dec 8 18:41:11 2002
@@ -20,7 +20,7 @@
# $Id: Head.U,v 3.0.1.9 1997/02/28 15:02:09 ram Exp $
#
-# Generated on Thu Nov 28 06:52:33 EET 2002 [metaconfig 3.0 PL70]
+# Generated on Mon Dec 9 05:42:31 EET 2002 [metaconfig 3.0 PL70]
# (with additional metaconfig patches by [EMAIL PROTECTED])
cat >c1$$ <<EOF
==== //depot/maint-5.8/perl/config_h.SH#6 (text) ====
Index: perl/config_h.SH
--- perl/config_h.SH#5~18197~ Wed Nov 27 20:14:27 2002
+++ perl/config_h.SH Sun Dec 8 18:41:11 2002
@@ -983,10 +983,15 @@
* This symbol, if defined, indicates to the C program that
* the struct tm has a tm_zone field.
*/
+/* HAS_TM_TM_GMTOFF:
+ * This symbol, if defined, indicates to the C program that
+ * the struct tm has a tm_gmtoff field.
+ */
#$i_time I_TIME /**/
#$i_systime I_SYS_TIME /**/
#$i_systimek I_SYS_TIME_KERNEL /**/
#$d_tm_tm_zone HAS_TM_TM_ZONE /**/
+#$d_tm_tm_gmtoff HAS_TM_TM_GMTOFF /**/
/* VAL_O_NONBLOCK:
* This symbol is to be used during open() or fcntl(F_SETFL) to turn on
==== //depot/maint-5.8/perl/ext/Filter/Util/Call/Call.xs#2 (text) ====
Index: perl/ext/Filter/Util/Call/Call.xs
--- perl/ext/Filter/Util/Call/Call.xs#1~17645~ Fri Jul 19 12:29:57 2002
+++ perl/ext/Filter/Util/Call/Call.xs Sun Dec 8 18:41:11 2002
@@ -235,7 +235,8 @@
filter_del()
CODE:
dMY_CXT;
- FILTER_ACTIVE(FILTER_DATA(IDX)) = FALSE ;
+ if (PL_rsfp_filters && IDX <= av_len(PL_rsfp_filters) && FILTER_DATA(IDX) &&
+FILTER_ACTIVE(FILTER_DATA(IDX)))
+ FILTER_ACTIVE(FILTER_DATA(IDX)) = FALSE ;
==== //depot/maint-5.8/perl/ext/Filter/t/call.t#2 (text) ====
Index: perl/ext/Filter/t/call.t
--- perl/ext/Filter/t/call.t#1~17645~ Fri Jul 19 12:29:57 2002
+++ perl/ext/Filter/t/call.t Sun Dec 8 18:41:11 2002
@@ -15,7 +15,7 @@
use vars qw($Inc $Perl);
-print "1..28\n" ;
+print "1..32\n" ;
$Perl = "$Perl -w" ;
@@ -24,12 +24,14 @@
my $filename = "call.tst" ;
+my $filename2 = "call2.tst" ;
my $filenamebin = "call.bin" ;
my $module = "MyTest" ;
my $module2 = "MyTest2" ;
my $module3 = "MyTest3" ;
my $module4 = "MyTest4" ;
my $module5 = "MyTest5" ;
+my $module6 = "MyTest6" ;
my $nested = "nested" ;
my $block = "block" ;
my $redir = $^O eq 'MacOS' ? "" : "2>&1";
@@ -781,14 +783,47 @@
}
+{
+
+# no without use
+# see Message-ID: <[EMAIL PROTECTED]>
+####################
+
+writeFile("${module6}.pm", <<EOM);
+package ${module6} ;
+#use Filter::Simple;
+#FILTER {}
+use Filter::Util::Call;
+sub import { filter_add(sub{}) }
+sub unimport { filter_del() }
+1;
+EOM
+
+writeFile($filename2, <<EOM);
+no ${module6} ;
+print "ok";
+EOM
+
+my $a = `$Perl "-I." $Inc -e "no ${module6}; print q{ok}"`;
+ok(29, ($? >>8) == 0);
+ok(30, $a eq 'ok');
+
+$a = `$Perl "-I." $Inc $filename2`;
+ok(31, ($? >>8) == 0);
+ok(32, $a eq 'ok');
+
+}
+
END {
1 while unlink $filename ;
+ 1 while unlink $filename2 ;
1 while unlink $filenamebin ;
1 while unlink "${module}.pm" ;
1 while unlink "${module2}.pm" ;
1 while unlink "${module3}.pm" ;
1 while unlink "${module4}.pm" ;
1 while unlink "${module5}.pm" ;
+ 1 while unlink "${module6}.pm" ;
1 while unlink $nested ;
1 while unlink "${block}.pm" ;
}
==== //depot/maint-5.8/perl/ext/POSIX/t/posix.t#3 (text) ====
Index: perl/ext/POSIX/t/posix.t
--- perl/ext/POSIX/t/posix.t#2~18080~ Sun Nov 3 21:23:04 2002
+++ perl/ext/POSIX/t/posix.t Sun Dec 8 18:41:11 2002
@@ -11,7 +11,7 @@
}
require "./test.pl";
-plan(tests => 61);
+plan(tests => 66);
use POSIX qw(fcntl_h signal_h limits_h _exit getcwd open read strftime write
@@ -182,6 +182,26 @@
try_strftime("Wed Mar 01 00:00:00 2000 061", 0,0,0, 1,2,100);
try_strftime("Fri Mar 31 00:00:00 2000 091", 0,0,0, 31,2,100);
&POSIX::setlocale(&POSIX::LC_TIME, $lc) if $Config{d_setlocale};
+
+SKIP: {
+ # XXX wait for smokers to see which OSs else to skip
+ skip("No mktime and/or tm_gmtoff", 5)
+ if !$Config{d_mktime} || !$Config{d_tm_tm_gmtoff} || !$Config{d_tm_tm_zone};
+ local $ENV{TZ} = "Europe/Berlin";
+
+ # May fail for ancient FreeBSD versions.
+ # %z is not included in POSIX, but valid on Linux and FreeBSD.
+ foreach $def ([1000,'Sun Sep 9 03:46:40 2001 +0200 CEST'],
+ [900, 'Thu Jul 9 18:00:00 1998 +0200 CEST'],
+ [800, 'Tue May 9 08:13:20 1995 +0200 CEST'],
+ [700, 'Sat Mar 7 21:26:40 1992 +0100 CET'],
+ [600, 'Thu Jan 5 11:40:00 1989 +0100 CET'],
+ ) {
+ my($t, $expected) = @$def;
+ my @tm = localtime($t*1000000);
+ is(strftime("%c %z %Z",@tm), $expected, "validating zone setting: $expected");
+ }
+}
{
for my $test (0, 1) {
==== //depot/maint-5.8/perl/hv.c#4 (text) ====
Index: perl/hv.c
--- perl/hv.c#3~18258~ Sun Dec 8 07:24:00 2002
+++ perl/hv.c Sun Dec 8 18:41:11 2002
@@ -1845,6 +1845,7 @@
Newz(506, xhv->xhv_array /* HvARRAY(hv) */,
PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max+1 /* HvMAX(hv)+1 */),
char);
+ /* At start of hash, entry is NULL. */
if (entry)
{
entry = HeNEXT(entry);
@@ -1859,8 +1860,11 @@
}
}
while (!entry) {
+ /* OK. Come to the end of the current list. Grab the next one. */
+
xhv->xhv_riter++; /* HvRITER(hv)++ */
if (xhv->xhv_riter > (I32)xhv->xhv_max /* HvRITER(hv) > HvMAX(hv) */) {
+ /* There is no next one. End of the hash. */
xhv->xhv_riter = -1; /* HvRITER(hv) = -1 */
break;
}
@@ -1868,10 +1872,14 @@
entry = ((HE**)xhv->xhv_array)[xhv->xhv_riter];
if (!(flags & HV_ITERNEXT_WANTPLACEHOLDERS)) {
- /* if we have an entry, but it's a placeholder, don't count it */
- if (entry && HeVAL(entry) == &PL_sv_undef)
- entry = 0;
- }
+ /* If we have an entry, but it's a placeholder, don't count it.
+ Try the next. */
+ while (entry && HeVAL(entry) == &PL_sv_undef)
+ entry = HeNEXT(entry);
+ }
+ /* Will loop again if this linked list starts NULL
+ (for HV_ITERNEXT_WANTPLACEHOLDERS)
+ or if we run through it and find only placeholders. */
}
if (oldentry && HvLAZYDEL(hv)) { /* was deleted earlier? */
==== //depot/maint-5.8/perl/lib/English.pm#2 (text) ====
Index: perl/lib/English.pm
--- perl/lib/English.pm#1~17645~ Fri Jul 19 12:29:57 2002
+++ perl/lib/English.pm Sun Dec 8 18:41:11 2002
@@ -57,9 +57,9 @@
*EXPORT = \@COMPLETE_EXPORT ;
$globbed_match ||= (
eval q{
- *MATCH = \$& ;
- *PREMATCH = \$` ;
- *POSTMATCH = \$' ;
+ *MATCH = *& ;
+ *PREMATCH = *` ;
+ *POSTMATCH = *' ;
1 ;
}
|| do {
@@ -144,87 +144,87 @@
# Matching.
- *LAST_PAREN_MATCH = \$+ ;
- *LAST_SUBMATCH_RESULT = \$^N ;
- *LAST_MATCH_START = \@- ;
- *LAST_MATCH_END = \@+ ;
+ *LAST_PAREN_MATCH = *+ ;
+ *LAST_SUBMATCH_RESULT = *^N ;
+ *LAST_MATCH_START = *-{ARRAY} ;
+ *LAST_MATCH_END = *+{ARRAY} ;
# Input.
- *INPUT_LINE_NUMBER = \$. ;
- *NR = \$. ;
- *INPUT_RECORD_SEPARATOR = \$/ ;
- *RS = \$/ ;
+ *INPUT_LINE_NUMBER = *. ;
+ *NR = *. ;
+ *INPUT_RECORD_SEPARATOR = */ ;
+ *RS = */ ;
# Output.
- *OUTPUT_AUTOFLUSH = \$| ;
- *OUTPUT_FIELD_SEPARATOR = \$, ;
- *OFS = \$, ;
- *OUTPUT_RECORD_SEPARATOR = \$\ ;
- *ORS = \$\ ;
+ *OUTPUT_AUTOFLUSH = *| ;
+ *OUTPUT_FIELD_SEPARATOR = *, ;
+ *OFS = *, ;
+ *OUTPUT_RECORD_SEPARATOR = *\ ;
+ *ORS = *\ ;
# Interpolation "constants".
- *LIST_SEPARATOR = \$" ;
- *SUBSCRIPT_SEPARATOR = \$; ;
- *SUBSEP = \$; ;
+ *LIST_SEPARATOR = *" ;
+ *SUBSCRIPT_SEPARATOR = *; ;
+ *SUBSEP = *; ;
# Formats
- *FORMAT_PAGE_NUMBER = \$% ;
- *FORMAT_LINES_PER_PAGE = \$= ;
- *FORMAT_LINES_LEFT = \$- ;
- *FORMAT_NAME = \$~ ;
- *FORMAT_TOP_NAME = \$^ ;
- *FORMAT_LINE_BREAK_CHARACTERS = \$: ;
- *FORMAT_FORMFEED = \$^L ;
+ *FORMAT_PAGE_NUMBER = *% ;
+ *FORMAT_LINES_PER_PAGE = *= ;
+ *FORMAT_LINES_LEFT = *- ;
+ *FORMAT_NAME = *~ ;
+ *FORMAT_TOP_NAME = *^ ;
+ *FORMAT_LINE_BREAK_CHARACTERS = *: ;
+ *FORMAT_FORMFEED = *^L ;
# Error status.
- *CHILD_ERROR = \$? ;
- *OS_ERROR = \$! ;
- *ERRNO = \$! ;
- *OS_ERROR = \%! ;
- *ERRNO = \%! ;
- *EXTENDED_OS_ERROR = \$^E ;
- *EVAL_ERROR = \$@ ;
+ *CHILD_ERROR = *? ;
+ *OS_ERROR = *! ;
+ *ERRNO = *! ;
+ *OS_ERROR = *! ;
+ *ERRNO = *! ;
+ *EXTENDED_OS_ERROR = *^E ;
+ *EVAL_ERROR = *@ ;
# Process info.
- *PROCESS_ID = \$$ ;
- *PID = \$$ ;
- *REAL_USER_ID = \$< ;
- *UID = \$< ;
- *EFFECTIVE_USER_ID = \$> ;
- *EUID = \$> ;
- *REAL_GROUP_ID = \$( ;
- *GID = \$( ;
- *EFFECTIVE_GROUP_ID = \$) ;
- *EGID = \$) ;
- *PROGRAM_NAME = \$0 ;
+ *PROCESS_ID = *$ ;
+ *PID = *$ ;
+ *REAL_USER_ID = *< ;
+ *UID = *< ;
+ *EFFECTIVE_USER_ID = *> ;
+ *EUID = *> ;
+ *REAL_GROUP_ID = *( ;
+ *GID = *( ;
+ *EFFECTIVE_GROUP_ID = *) ;
+ *EGID = *) ;
+ *PROGRAM_NAME = *0 ;
# Internals.
- *PERL_VERSION = \$^V ;
- *ACCUMULATOR = \$^A ;
- *COMPILING = \$^C ;
- *DEBUGGING = \$^D ;
- *SYSTEM_FD_MAX = \$^F ;
- *INPLACE_EDIT = \$^I ;
- *PERLDB = \$^P ;
- *LAST_REGEXP_CODE_RESULT = \$^R ;
- *EXCEPTIONS_BEING_CAUGHT = \$^S ;
- *BASETIME = \$^T ;
- *WARNING = \$^W ;
- *EXECUTABLE_NAME = \$^X ;
- *OSNAME = \$^O ;
+ *PERL_VERSION = *^V ;
+ *ACCUMULATOR = *^A ;
+ *COMPILING = *^C ;
+ *DEBUGGING = *^D ;
+ *SYSTEM_FD_MAX = *^F ;
+ *INPLACE_EDIT = *^I ;
+ *PERLDB = *^P ;
+ *LAST_REGEXP_CODE_RESULT = *^R ;
+ *EXCEPTIONS_BEING_CAUGHT = *^S ;
+ *BASETIME = *^T ;
+ *WARNING = *^W ;
+ *EXECUTABLE_NAME = *^X ;
+ *OSNAME = *^O ;
# Deprecated.
-# *ARRAY_BASE = \$[ ;
-# *OFMT = \$# ;
-# *MULTILINE_MATCHING = \$* ;
-# *OLD_PERL_VERSION = \$] ;
+# *ARRAY_BASE = *[ ;
+# *OFMT = *# ;
+# *MULTILINE_MATCHING = ** ;
+# *OLD_PERL_VERSION = *] ;
1;
==== //depot/maint-5.8/perl/lib/English.t#2 (xtext) ====
Index: perl/lib/English.t
--- perl/lib/English.t#1~17645~ Fri Jul 19 12:29:57 2002
+++ perl/lib/English.t Sun Dec 8 18:41:11 2002
@@ -6,7 +6,7 @@
@INC = '../lib';
}
-use Test::More tests => 54;
+use Test::More tests => 55;
use English qw( -no_match_vars ) ;
use Config;
@@ -141,6 +141,12 @@
main::is( $PREMATCH, 'a', '$PREMATCH defined' );
main::is( $MATCH, 'b', '$MATCH defined' );
main::is( $POSTMATCH, 'c', '$POSTMATCH defined' );
+
+{
+ my $s = "xyz";
+ $s =~ s/y/t$MATCH/;
+ main::is( $s, "xtyz", '$MATCH defined in right side of s///' );
+}
package C;
==== //depot/maint-5.8/perl/lib/Exporter/Heavy.pm#3 (text) ====
Index: perl/lib/Exporter/Heavy.pm
--- perl/lib/Exporter/Heavy.pm#2~18080~ Sun Nov 3 21:23:04 2002
+++ perl/lib/Exporter/Heavy.pm Sun Dec 8 18:41:11 2002
@@ -6,7 +6,6 @@
# On one line so MakeMaker will see it.
require Exporter; our $VERSION = $Exporter::VERSION;
$Carp::Internal{"Exporter::Heavy"} = 1;
-our $Verbose;
=head1 NAME
@@ -103,7 +102,7 @@
}
warn "Import ".($remove ? "del":"add").": @names "
- if $Verbose;
+ if $Exporter::Verbose;
if ($remove) {
foreach $sym (@names) { delete $imports{$sym} }
@@ -169,7 +168,7 @@
# barewords twice... both with and without a leading &.
# (Technique could be applied to $export_cache at cost of memory)
my @expanded = map { /^\w/ ? ($_, '&'.$_) : $_ } @$fail;
- warn "${pkg}::EXPORT_FAIL cached: @expanded" if $Verbose;
+ warn "${pkg}::EXPORT_FAIL cached: @expanded" if $Exporter::Verbose;
@{$fail_cache}{@expanded} = (1) x @expanded;
}
my @failed;
@@ -189,7 +188,7 @@
}
warn "Importing into $callpkg from $pkg: ",
- join(", ",sort @imports) if $Verbose;
+ join(", ",sort @imports) if $Exporter::Verbose;
foreach $sym (@imports) {
# shortcut for the common case of no type character
==== //depot/maint-5.8/perl/lib/ExtUtils/xsubpp#2 (xtext) ====
Index: perl/lib/ExtUtils/xsubpp
--- perl/lib/ExtUtils/xsubpp#1~17645~ Fri Jul 19 12:29:57 2002
+++ perl/lib/ExtUtils/xsubpp Sun Dec 8 18:41:11 2002
@@ -888,7 +888,19 @@
my $podstartline = $.;
do {
if (/^=cut\s*$/) {
- print("/* Skipped embedded POD. */\n");
+ # We can't just write out a /* */ comment, as our embedded
+ # POD might itself be in a comment. We can't put a /**/
+ # comment inside #if 0, as the C standard says that the source
+ # file is decomposed into preprocessing characters in the stage
+ # before preprocessing commands are executed.
+ # I don't want to leave the text as barewords, because the spec
+ # isn't clear whether macros are expanded before or after
+ # preprocessing commands are executed, and someone pathological
+ # may just have defined one of the 3 words as a macro that does
+ # something strange. Multiline strings are illegal in C, so
+ # the "" we write must be a string literal. And they aren't
+ # concatenated until 2 steps later, so we are safe.
+ print("#if 0\n \"Skipped embedded POD.\"\n#endif\n");
printf("#line %d \"$filename\"\n", $. + 1)
if $WantLineNumbers;
next firstmodule
==== //depot/maint-5.8/perl/lib/Hash/Util.t#4 (text) ====
Index: perl/lib/Hash/Util.t
--- perl/lib/Hash/Util.t#3~18258~ Sun Dec 8 07:24:00 2002
+++ perl/lib/Hash/Util.t Sun Dec 8 18:41:11 2002
@@ -6,7 +6,7 @@
chdir 't';
}
}
-use Test::More tests => 61;
+use Test::More tests => 157;
use strict;
my @Exported_Funcs;
@@ -226,4 +226,60 @@
"undef values should not be misunderstood as placeholders");
is ($hash{nowt}, undef,
"undef values should not be misunderstood as placeholders (again)");
+}
+
+{
+ # perl #18651 - [EMAIL PROTECTED] found a rather nasty data dependant
+ # bug whereby hash iterators could lose hash keys (and values, as the code
+ # is common) for restricted hashes.
+
+ my @keys = qw(small medium large);
+
+ # There should be no difference whether it is restricted or not
+ foreach my $lock (0, 1) {
+ # Try setting all combinations of the 3 keys
+ foreach my $usekeys (0..7) {
+ my @usekeys;
+ for my $bits (0,1,2) {
+ push @usekeys, $keys[$bits] if $usekeys & (1 << $bits);
+ }
+ my %clean = map {$_ => length $_} @usekeys;
+ my %target;
+ lock_keys ( %target, @keys ) if $lock;
+
+ while (my ($k, $v) = each %clean) {
+ $target{$k} = $v;
+ }
+
+ my $message
+ = ($lock ? 'locked' : 'not locked') . ' keys ' . join ',', @usekeys;
+
+ is (scalar keys %target, scalar keys %clean, "scalar keys for $message");
+ is (scalar values %target, scalar values %clean,
+ "scalar values for $message");
+ # Yes. All these sorts are necessary. Even for "identical hashes"
+ # Because the data dependency of the test involves two of the strings
+ # colliding on the same bucket, so the iterator order (output of keys,
+ # values, each) depends on the addition order in the hash. And locking
+ # the keys of the hash involves behind the scenes key additions.
+ is_deeply( [sort keys %target] , [sort keys %clean],
+ "list keys for $message");
+ is_deeply( [sort values %target] , [sort values %clean],
+ "list values for $message");
+
+ is_deeply( [sort %target] , [sort %clean],
+ "hash in list context for $message");
+
+ my (@clean, @target);
+ while (my ($k, $v) = each %clean) {
+ push @clean, $k, $v;
+ }
+ while (my ($k, $v) = each %target) {
+ push @target, $k, $v;
+ }
+
+ is_deeply( [sort @target] , [sort @clean],
+ "iterating with each for $message");
+ }
+ }
}
==== //depot/maint-5.8/perl/pod/perldiag.pod#11 (text) ====
Index: perl/pod/perldiag.pod
--- perl/pod/perldiag.pod#10~18254~ Sat Dec 7 08:26:27 2002
+++ perl/pod/perldiag.pod Sun Dec 8 18:41:11 2002
@@ -1820,9 +1820,9 @@
(F) You can't use system(), exec(), or a piped open in a setuid or
setgid script if any of C<$ENV{PATH}>, C<$ENV{IFS}>, C<$ENV{CDPATH}>,
-C<$ENV{ENV}> or C<$ENV{BASH_ENV}> are derived from data supplied (or
-potentially supplied) by the user. The script must set the path to a
-known value, using trustworthy data. See L<perlsec>.
+C<$ENV{ENV}>, C<$ENV{BASH_ENV}> or C<$ENV{TERM}> are derived from data
+supplied (or potentially supplied) by the user. The script must set
+the path to a known value, using trustworthy data. See L<perlsec>.
=item Integer overflow in %s number
==== //depot/maint-5.8/perl/pp_ctl.c#4 (text) ====
Index: perl/pp_ctl.c
--- perl/pp_ctl.c#3~18197~ Wed Nov 27 20:14:27 2002
+++ perl/pp_ctl.c Sun Dec 8 18:41:11 2002
@@ -1664,11 +1664,11 @@
cx->blk_loop.iterary = (AV*)SvREFCNT_inc(POPs);
if (SvTYPE(cx->blk_loop.iterary) != SVt_PVAV) {
dPOPss;
+ /* See comment in pp_flop() */
if (SvNIOKp(sv) || !SvPOKp(sv) ||
SvNIOKp(cx->blk_loop.iterary) || !SvPOKp(cx->blk_loop.iterary) ||
(looks_like_number(sv) && *SvPVX(sv) != '0' &&
- looks_like_number((SV*)cx->blk_loop.iterary) &&
- *SvPVX(cx->blk_loop.iterary) != '0'))
+ looks_like_number((SV*)cx->blk_loop.iterary)))
{
if (SvNV(sv) < IV_MIN ||
SvNV((SV*)cx->blk_loop.iterary) >= IV_MAX)
==== //depot/maint-5.8/perl/pp_sys.c#6 (text) ====
Index: perl/pp_sys.c
--- perl/pp_sys.c#5~18256~ Sat Dec 7 10:24:27 2002
+++ perl/pp_sys.c Sun Dec 8 18:41:11 2002
@@ -4955,6 +4955,9 @@
char *proto = POPpbytex;
unsigned short port = (unsigned short)POPu;
+ if (proto && !*proto)
+ proto = Nullch;
+
#ifdef HAS_HTONS
port = PerlSock_htons(port);
#endif
==== //depot/maint-5.8/perl/regcomp.c#7 (text) ====
Index: perl/regcomp.c
--- perl/regcomp.c#6~18258~ Sun Dec 8 07:24:00 2002
+++ perl/regcomp.c Sun Dec 8 18:41:11 2002
@@ -5072,6 +5072,23 @@
SAVEVPTR(PL_reg_curpm); /* from regexec.c */
SAVEI32(PL_regnpar); /* () count. */
SAVEI32(PL_regsize); /* from regexec.c */
+
+ {
+ /* Save $1..$n (#18107: UTF-8 s/(\w+)/uc($1)/e); AMS 20021106. */
+ int i;
+ GV *mgv;
+ REGEXP *rx;
+ char digits[16];
+
+ if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
+ for (i = 1; i <= rx->nparens; i++) {
+ sprintf(digits, "%lu", (long)i);
+ if ((mgv = gv_fetchpv(digits, FALSE, SVt_PV)))
+ save_scalar(mgv);
+ }
+ }
+ }
+
#ifdef DEBUGGING
SAVEPPTR(PL_reg_starttry); /* from regexec.c */
#endif
==== //depot/maint-5.8/perl/t/cmd/for.t#2 (xtext) ====
Index: perl/t/cmd/for.t
--- perl/t/cmd/for.t#1~17645~ Fri Jul 19 12:29:57 2002
+++ perl/t/cmd/for.t Sun Dec 8 18:41:11 2002
@@ -1,6 +1,6 @@
#!./perl
-print "1..11\n";
+print "1..12\n";
for ($i = 0; $i <= 10; $i++) {
$x[$i] = $i;
@@ -66,3 +66,8 @@
}
print $a == 7 ? "ok" : "not ok", " 11\n";
+$loop_count = 0;
+for ("-3" .. "0") {
+ $loop_count++;
+}
+print $loop_count == 4 ? "ok" : "not ok", " 12\n";
==== //depot/maint-5.8/perl/t/comp/parser.t#3 (text) ====
Index: perl/t/comp/parser.t
--- perl/t/comp/parser.t#2~18234~ Mon Dec 2 14:30:41 2002
+++ perl/t/comp/parser.t Sun Dec 8 18:41:11 2002
@@ -9,7 +9,7 @@
}
require "./test.pl";
-plan( tests => 10 );
+plan( tests => 12 );
eval '%@x=0;';
like( $@, qr/^Can't modify hash dereference in repeat \(x\)/, '%@x=0' );
@@ -51,3 +51,18 @@
# bug #18573, used to corrupt memory
eval q{ "\c" };
like( $@, qr/^Missing control char name in \\c/, q("\c" string) );
+
+# two tests for memory corruption problems in the said variables
+# (used to dump core or produce strange results)
+
+is( "\Q\Q\Q\Q\Q\Q\Q\Q\Q\Q\Q\Q\Qa", "a", "PL_lex_casestack" );
+
+eval {
+{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{
+{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{
+{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{
+}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}
+}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}
+}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}
+};
+is( $@, '', 'PL_lex_brackstack' );
==== //depot/maint-5.8/perl/t/lib/strict/subs#3 (text) ====
Index: perl/t/lib/strict/subs
--- perl/t/lib/strict/subs#2~18080~ Sun Nov 3 21:23:04 2002
+++ perl/t/lib/strict/subs Sun Dec 8 18:41:11 2002
@@ -354,3 +354,10 @@
EXPECT
Bareword "BAREWORD" not allowed while "strict subs" in use at - line 5.
Execution of - aborted due to compilation errors.
+########
+# Ticket: 18927
+use strict 'subs';
+print 1..1, bad;
+EXPECT
+Bareword "bad" not allowed while "strict subs" in use at - line 3.
+Execution of - aborted due to compilation errors.
==== //depot/maint-5.8/perl/t/op/lc.t#5 (text) ====
Index: perl/t/op/lc.t
--- perl/t/op/lc.t#4~18258~ Sun Dec 8 07:24:00 2002
+++ perl/t/op/lc.t Sun Dec 8 18:41:11 2002
@@ -6,7 +6,7 @@
require './test.pl';
}
-plan tests => 51;
+plan tests => 55;
$a = "HELLO.* world";
$b = "hello.* WORLD";
@@ -123,3 +123,18 @@
is(uc("\x{1C5}") , "\x{1C4}", "U+01C5 uc is U+01C4");
is(uc("\x{1C6}") , "\x{1C4}", "U+01C6 uc is U+01C4, too");
+# #18107: A host of bugs involving [ul]c{,first}. AMS 20021106
+$a = "\x{3c3}foo.bar"; # \x{3c3} == GREEK SMALL LETTER SIGMA.
+$b = "\x{3a3}FOO.BAR"; # \x{3a3} == GREEK CAPITAL LETTER SIGMA.
+
+($c = $b) =~ s/(\w+)/lc($1)/ge;
+ok($c eq $a, "Using s///e to change case.");
+
+($c = $a) =~ s/(\w+)/uc($1)/ge;
+ok($c eq $b, "Using s///e to change case.");
+
+($c = $b) =~ s/(\w+)/lcfirst($1)/ge;
+ok($c eq "\x{3c3}FOO.bAR", "Using s///e to change case.");
+
+($c = $a) =~ s/(\w+)/ucfirst($1)/ge;
+ok($c eq "\x{3a3}foo.Bar", "Using s///e to change case.");
==== //depot/maint-5.8/perl/taint.c#2 (text) ====
Index: perl/taint.c
--- perl/taint.c#1~17645~ Fri Jul 19 12:29:57 2002
+++ perl/taint.c Sun Dec 8 18:41:11 2002
@@ -129,7 +129,7 @@
PL_tainted = was_tainted;
if (t < e && isALNUM(*t))
t++;
- while (t < e && (isALNUM(*t) || *t == '-' || *t == ':'))
+ while (t < e && (isALNUM(*t) || strchr("-_.+", *t)))
t++;
if (t < e) {
TAINT;
==== //depot/maint-5.8/perl/toke.c#4 (text) ====
Index: perl/toke.c
--- perl/toke.c#3~18234~ Mon Dec 2 14:30:41 2002
+++ perl/toke.c Sun Dec 8 18:41:11 2002
@@ -418,8 +418,8 @@
SAVEPPTR(PL_last_uni);
SAVEPPTR(PL_linestart);
SAVESPTR(PL_linestr);
- SAVEPPTR(PL_lex_brackstack);
- SAVEPPTR(PL_lex_casestack);
+ SAVEGENERICPV(PL_lex_brackstack);
+ SAVEGENERICPV(PL_lex_casestack);
SAVEDESTRUCTOR_X(restore_rsfp, PL_rsfp);
SAVESPTR(PL_lex_stuff);
SAVEI32(PL_lex_defer);
@@ -434,8 +434,6 @@
PL_lex_brackets = 0;
New(899, PL_lex_brackstack, 120, char);
New(899, PL_lex_casestack, 12, char);
- SAVEFREEPV(PL_lex_brackstack);
- SAVEFREEPV(PL_lex_casestack);
PL_lex_casemods = 0;
*PL_lex_casestack = '\0';
PL_lex_dojoin = 0;
@@ -1043,8 +1041,8 @@
SAVEPPTR(PL_last_uni);
SAVEPPTR(PL_linestart);
SAVESPTR(PL_linestr);
- SAVEPPTR(PL_lex_brackstack);
- SAVEPPTR(PL_lex_casestack);
+ SAVEGENERICPV(PL_lex_brackstack);
+ SAVEGENERICPV(PL_lex_casestack);
PL_linestr = PL_lex_stuff;
PL_lex_stuff = Nullsv;
@@ -1059,8 +1057,6 @@
PL_lex_brackets = 0;
New(899, PL_lex_brackstack, 120, char);
New(899, PL_lex_casestack, 12, char);
- SAVEFREEPV(PL_lex_brackstack);
- SAVEFREEPV(PL_lex_casestack);
PL_lex_casemods = 0;
*PL_lex_casestack = '\0';
PL_lex_starts = 0;
@@ -2199,6 +2195,7 @@
GV *gv = Nullgv;
GV **gvp = 0;
bool bof = FALSE;
+ I32 orig_keyword = 0;
/* check if there's an identifier for us to look at */
if (PL_pending_ident)
@@ -2269,11 +2266,7 @@
return ')';
}
if (PL_lex_casemods > 10) {
- char* newlb = Renew(PL_lex_casestack, PL_lex_casemods + 2, char);
- if (newlb != PL_lex_casestack) {
- SAVEFREEPV(newlb);
- PL_lex_casestack = newlb;
- }
+ Renew(PL_lex_casestack, PL_lex_casemods + 2, char);
}
PL_lex_casestack[PL_lex_casemods++] = *s;
PL_lex_casestack[PL_lex_casemods] = '\0';
@@ -3112,11 +3105,7 @@
leftbracket:
s++;
if (PL_lex_brackets > 100) {
- char* newlb = Renew(PL_lex_brackstack, PL_lex_brackets + 1, char);
- if (newlb != PL_lex_brackstack) {
- SAVEFREEPV(newlb);
- PL_lex_brackstack = newlb;
- }
+ Renew(PL_lex_brackstack, PL_lex_brackets + 10, char);
}
switch (PL_expect) {
case XTERM:
@@ -3773,7 +3762,7 @@
case 'z': case 'Z':
keylookup: {
- I32 orig_keyword = 0;
+ orig_keyword = 0;
gv = Nullgv;
gvp = 0;
==== //depot/maint-5.8/perl/util.c#8 (text) ====
Index: perl/util.c
--- perl/util.c#7~18256~ Sat Dec 7 10:24:27 2002
+++ perl/util.c Sun Dec 8 18:41:11 2002
@@ -3674,6 +3674,20 @@
mytm.tm_yday = yday;
mytm.tm_isdst = isdst;
mini_mktime(&mytm);
+ /* use libc to get the values for tm_gmtoff and tm_zone [perl #18238] */
+#if defined(HAS_MKTIME) && (defined(HAS_TM_TM_GMTOFF) || defined(HAS_TM_TM_ZONE))
+ STMT_START {
+ struct tm mytm2;
+ mytm2 = mytm;
+ mktime(&mytm2);
+#ifdef HAS_TM_TM_GMTOFF
+ mytm.tm_gmtoff = mytm2.tm_gmtoff;
+#endif
+#ifdef HAS_TM_TM_ZONE
+ mytm.tm_zone = mytm2.tm_zone;
+#endif
+ } STMT_END;
+#endif
buflen = 64;
New(0, buf, buflen, char);
len = strftime(buf, buflen, fmt, &mytm);
End of Patch.
