Change 19653 by [EMAIL PROTECTED] on 2003/06/01 07:35:55
Integrate:
[ 19638]
Comment tweakage.
[ 19639]
Add the test case for the already fixed
[perl #22351] perl bug with 'e' substitution modifier
[ 19640]
Fix for "#22375 'split'/'index' problem for utf8".
[ 19641]
A bit of networking notworking negativity.
(Inspiration from Jos.)
[ 19642]
test.pl-isation.
[ 19643]
Upgrade to Tie::File 0.96.
[ 19644]
Subject: [PATCH] ext/Encode/t/perlio.t filename tweak
From: "Craig A. Berry" <[EMAIL PROTECTED]>
Date: Fri, 30 May 2003 13:08:01 -0500
Message-ID: <[EMAIL PROTECTED]>
[ 19645]
Subject: Re: [perl #22372] [PATCH] sv_chop() broken
From: Enache Adrian <[EMAIL PROTECTED]>
Date: Fri, 30 May 2003 18:52:28 +0300
Message-ID: <[EMAIL PROTECTED]>
[ 19646]
Interesting patch(1) glitch.
[ 19647]
Subject: Re: [perl #22372] [PATCH] sv_chop() broken
From: Enache Adrian <[EMAIL PROTECTED]>
Date: Sat, 31 May 2003 14:18:11 +0300
Message-ID: <[EMAIL PROTECTED]>
[ 19648]
Better patch from Inaba Hiroto for
[perl #22375] 'split'/'index' problem for utf8
[ 19650]
Regenerate internals pods.
[ 19651]
Don't install test.pl files.
[ 19652]
Fix a case of segfault in gv_check(), by making
it ignore non-GV values in stashes.
Affected files ...
... //depot/maint-5.8/perl/ext/Encode/t/perlio.t#3 integrate
... //depot/maint-5.8/perl/gv.c#11 integrate
... //depot/maint-5.8/perl/installperl#7 integrate
... //depot/maint-5.8/perl/intrpvar.h#16 integrate
... //depot/maint-5.8/perl/lib/Tie/File.pm#3 integrate
... //depot/maint-5.8/perl/lib/Tie/File/t/00_version.t#3 integrate
... //depot/maint-5.8/perl/lib/Tie/File/t/09_gen_rs.t#3 integrate
... //depot/maint-5.8/perl/pod/perlapi.pod#13 integrate
... //depot/maint-5.8/perl/pod/perlintern.pod#5 integrate
... //depot/maint-5.8/perl/pod/perlport.pod#8 integrate
... //depot/maint-5.8/perl/sv.c#49 integrate
... //depot/maint-5.8/perl/t/op/index.t#2 integrate
... //depot/maint-5.8/perl/t/op/stash.t#2 integrate
... //depot/maint-5.8/perl/t/op/subst.t#9 integrate
... //depot/maint-5.8/perl/t/op/write.t#2 integrate
Differences ...
==== //depot/maint-5.8/perl/ext/Encode/t/perlio.t#3 (text) ====
Index: perl/ext/Encode/t/perlio.t
--- perl/ext/Encode/t/perlio.t#2~19611~ Sat May 24 00:50:43 2003
+++ perl/ext/Encode/t/perlio.t Sun Jun 1 00:35:55 2003
@@ -146,7 +146,7 @@
# reading
for my $utf (sort keys %bom){
my $bomed = $bom{$utf} . encode($utf, $str);
- my $sfile = File::Spec->catfile($dir,".$utf.$seq.$$");
+ my $sfile = File::Spec->catfile($dir,".${utf}_${seq}_$$");
dump2file($sfile, $bomed);
my $utf_nobom = $utf; $utf_nobom =~ s/(LE|BE)$//o;
# reading
@@ -159,7 +159,7 @@
# writing
for my $utf_nobom (qw/UTF-16 UTF-32/){
my $utf = $utf_nobom . 'BE';
- my $sfile = File::Spec->catfile($dir,".$utf_nobom.$seq.$$");
+ my $sfile = File::Spec->catfile($dir,".${utf_nobom}_${seq}_$$");
my $bomed = $bom{$utf} . encode($utf, $str);
open $fh, ">:encoding($utf_nobom)", $sfile or die "$sfile : $!";
print $fh $str;
==== //depot/maint-5.8/perl/gv.c#11 (text) ====
Index: perl/gv.c
--- perl/gv.c#10~19400~ Sun May 4 01:29:43 2003
+++ perl/gv.c Sun Jun 1 00:35:55 2003
@@ -1161,7 +1161,7 @@
for (i = 0; i <= (I32) HvMAX(stash); i++) {
for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) {
if (HeKEY(entry)[HeKLEN(entry)-1] == ':' &&
- (gv = (GV*)HeVAL(entry)) && (hv = GvHV(gv)))
+ (gv = (GV*)HeVAL(entry)) && isGV(gv) && (hv = GvHV(gv)))
{
if (hv != PL_defstash && hv != stash)
gv_check(hv); /* nested package */
==== //depot/maint-5.8/perl/installperl#7 (xtext) ====
Index: perl/installperl
--- perl/installperl#6~19073~ Wed Mar 26 20:25:46 2003
+++ perl/installperl Sun Jun 1 00:35:55 2003
@@ -765,8 +765,8 @@
}
# ignore patch backups, RCS files, emacs backup & temp files and the
- # .exists files, .PL files, and .t files.
- return if $name =~ m{\.orig$|\.rej$|~$|^#.+#$|,v$|^\.exists|\.PL$|\.t$} ||
+ # .exists files, .PL files, and test files.
+ return if $name =~
m{\.orig$|\.rej$|~$|^#.+#$|,v$|^\.exists|\.PL$|\.t$|^test\.pl$} ||
$dir =~ m{/t(?:/|$)};
# ignore the cpan script in lib/CPAN/bin (installed later with other utils)
return if $name eq 'cpan';
==== //depot/maint-5.8/perl/intrpvar.h#16 (text) ====
Index: perl/intrpvar.h
--- perl/intrpvar.h#15~19515~ Tue May 13 10:51:05 2003
+++ perl/intrpvar.h Sun Jun 1 00:35:55 2003
@@ -556,10 +556,10 @@
PERLVARI(Ippid, IV, 0)
#endif
-/* Don't forget to add your variable also to perl_clone()! */
-
/* New variables must be added to the very end, before this comment,
* for binary compatibility (the offsets of the old members must not change).
+ * (Don't forget to add your variable also to perl_clone()!)
* XSUB.h provides wrapper functions via perlapi.h that make this
- * irrelevant, but not all code may be expected to #include XSUB.h. */
+ * irrelevant, but not all code may be expected to #include XSUB.h.
+ */
==== //depot/maint-5.8/perl/lib/Tie/File.pm#3 (text) ====
Index: perl/lib/Tie/File.pm
--- perl/lib/Tie/File.pm#2~19515~ Tue May 13 10:51:05 2003
+++ perl/lib/Tie/File.pm Sun Jun 1 00:35:55 2003
@@ -7,7 +7,7 @@
sub O_ACCMODE () { O_RDONLY | O_RDWR | O_WRONLY }
-$VERSION = "0.95";
+$VERSION = "0.96";
my $DEFAULT_MEMORY_SIZE = 1<<21; # 2 megabytes
my $DEFAULT_AUTODEFER_THRESHHOLD = 3; # 3 records
my $DEFAULT_AUTODEFER_FILELEN_THRESHHOLD = 65536; # 16 disk blocksful
@@ -901,8 +901,7 @@
$rec = <$fh>;
}
return unless defined $rec;
- if (! $self->{sawlastrec} &&
- substr($rec, -$self->{recseplen}) ne $self->{recsep}) {
+ if (substr($rec, -$self->{recseplen}) ne $self->{recsep}) {
# improperly terminated final record --- quietly fix it.
# my $ac = substr($rec, -$self->{recseplen});
# $ac =~ s/\n/\\n/g;
@@ -1994,7 +1993,7 @@
=head1 SYNOPSIS
- # This file documents Tie::File version 0.95
+ # This file documents Tie::File version 0.96
use Tie::File;
tie @array, 'Tie::File', filename or die ...;
@@ -2517,7 +2516,7 @@
=head1 LICENSE
-C<Tie::File> version 0.95 is copyright (C) 2002 Mark Jason Dominus.
+C<Tie::File> version 0.96 is copyright (C) 2002 Mark Jason Dominus.
This library is free software; you may redistribute it and/or modify
it under the same terms as Perl itself.
@@ -2545,7 +2544,7 @@
=head1 WARRANTY
-C<Tie::File> version 0.95 comes with ABSOLUTELY NO WARRANTY.
+C<Tie::File> version 0.96 comes with ABSOLUTELY NO WARRANTY.
For details, see the license.
=head1 THANKS
@@ -2567,7 +2566,9 @@
Additional thanks to:
Edward Avis /
Mattia Barbon /
+Tom Christiansen /
Gerrit Haase /
+Gurusamy Sarathy /
Jarkko Hietaniemi (again) /
Nikola Knezevic /
John Kominetz /
==== //depot/maint-5.8/perl/lib/Tie/File/t/00_version.t#3 (text) ====
Index: perl/lib/Tie/File/t/00_version.t
--- perl/lib/Tie/File/t/00_version.t#2~19515~ Tue May 13 10:51:05 2003
+++ perl/lib/Tie/File/t/00_version.t Sun Jun 1 00:35:55 2003
@@ -2,7 +2,7 @@
print "1..1\n";
-my $testversion = "0.95";
+my $testversion = "0.96";
use Tie::File;
if ($Tie::File::VERSION != $testversion) {
==== //depot/maint-5.8/perl/lib/Tie/File/t/09_gen_rs.t#3 (text) ====
Index: perl/lib/Tie/File/t/09_gen_rs.t
--- perl/lib/Tie/File/t/09_gen_rs.t#2~19515~ Tue May 13 10:51:05 2003
+++ perl/lib/Tie/File/t/09_gen_rs.t Sun Jun 1 00:35:55 2003
@@ -1,8 +1,9 @@
#!/usr/bin/perl
+use lib '/home/mjd/src/perl/Tie-File2/lib';
my $file = "tf$$.txt";
-print "1..58\n";
+print "1..59\n";
my $N = 1;
use Tie::File;
@@ -128,7 +129,7 @@
check_contents("x", "y");
}
-# (57-58) 20020402 The modifiaction would have failed if $\ were set wrong.
+# (57-58) 20020402 The modification would have failed if $\ were set wrong.
# I hate $\.
if (setup_badly_terminated_file(2)) {
$o = tie @a, 'Tie::File', $file,
@@ -138,6 +139,23 @@
my $z = $a[0];
}
check_contents($badrec);
+}
+
+# (59) 20030527 Tom Christiansen pointed out that FETCH returns the wrong
+# data on the final record of an unterminated file if the file is opened
+# in read-only mode. Note that the $#a is necessary here.
+# There's special-case code to fix the final record when it is read normally.
+# But the $#a forces it to be read from the cache, which skips the
+# termination.
+$badrec = "world\nhello";
+if (setup_badly_terminated_file(1)) {
+ tie(@a, "Tie::File", $file, mode => 0, recsep => $RECSEP)
+ or die "Couldn't tie file: $!";
+ my $z = $#a;
+ $z = $a[1];
+ print $z eq "hello" ? "ok $N\n" :
+ "not ok $N \# got $z, expected hello\n";
+ $N++;
}
sub setup_badly_terminated_file {
==== //depot/maint-5.8/perl/pod/perlapi.pod#13 (text+w) ====
Index: perl/pod/perlapi.pod
--- perl/pod/perlapi.pod#12~19439~ Wed May 7 10:11:48 2003
+++ perl/pod/perlapi.pod Sun Jun 1 00:35:55 2003
@@ -3637,6 +3637,8 @@
SvPOK(sv) must be true and the C<ptr> must be a pointer to somewhere inside
the string buffer. The C<ptr> becomes the first character of the adjusted
string. Uses the "OOK hack".
+Beware: after this function returns, C<ptr> and SvPVX(sv) may no longer
+refer to the same chunk of data.
void sv_chop(SV* sv, char* ptr)
==== //depot/maint-5.8/perl/pod/perlintern.pod#5 (text+w) ====
Index: perl/pod/perlintern.pod
--- perl/pod/perlintern.pod#4~19321~ Wed Apr 23 22:10:36 2003
+++ perl/pod/perlintern.pod Sun Jun 1 00:35:55 2003
@@ -484,6 +484,9 @@
(SvFAKE and name of '&' is not a meaningful combination currently but could
become so if C<my sub foo {}> is implemented.)
+Note that formats are treated as anon subs, and are cloned each time
+write is called (if necessary).
+
AV * CvPADLIST(CV *cv)
=for hackers
==== //depot/maint-5.8/perl/pod/perlport.pod#8 (text) ====
Index: perl/pod/perlport.pod
--- perl/pod/perlport.pod#7~19515~ Tue May 13 10:51:05 2003
+++ perl/pod/perlport.pod Sun Jun 1 00:35:55 2003
@@ -487,6 +487,20 @@
if ($^O ne 'VMS')
{$thisperl .= $Config{_exe} unless $thisperl =~ m/$Config{_exe}$/i;}
+=head2 Networking
+
+Don't assume that you can reach the public Internet.
+
+Don't assume that there is only one way to get through firewalls
+to the public Internet.
+
+Don't assume that you can reach yourself or any node by the name
+'localhost'. The same goes for '127.0.0.1'.
+
+Don't assume that any particular port (service) will respond.
+
+Don't assume that you can ping hosts and get replies.
+
=head2 Interprocess Communication (IPC)
In general, don't directly access the system in code meant to be
==== //depot/maint-5.8/perl/sv.c#49 (text) ====
Index: perl/sv.c
--- perl/sv.c#48~19515~ Tue May 13 10:51:05 2003
+++ perl/sv.c Sun Jun 1 00:35:55 2003
@@ -4261,6 +4261,8 @@
SvPOK(sv) must be true and the C<ptr> must be a pointer to somewhere inside
the string buffer. The C<ptr> becomes the first character of the adjusted
string. Uses the "OOK hack".
+Beware: after this function returns, C<ptr> and SvPVX(sv) may no longer
+refer to the same chunk of data.
=cut
*/
@@ -4269,9 +4271,9 @@
Perl_sv_chop(pTHX_ register SV *sv, register char *ptr)
{
register STRLEN delta;
-
if (!ptr || !SvPOKp(sv))
return;
+ delta = ptr - SvPVX(sv);
SV_CHECK_THINKFIRST(sv);
if (SvTYPE(sv) < SVt_PVIV)
sv_upgrade(sv,SVt_PVIV);
@@ -4291,7 +4293,6 @@
SvFLAGS(sv) |= SVf_OOK;
}
SvNIOK_off(sv);
- delta = ptr - SvPVX(sv);
SvLEN(sv) -= delta;
SvCUR(sv) -= delta;
SvPVX(sv) += delta;
@@ -5663,18 +5664,20 @@
cache[1] -= backw;
while (backw--) {
- p--;
- while (UTF8_IS_CONTINUATION(*p))
- p--;
- ubackw++;
- }
-
- cache[0] -= ubackw;
-
- return;
+ p--;
+ while (UTF8_IS_CONTINUATION(*p)) {
+ p--;
+ backw--;
+ }
+ ubackw++;
}
- }
- }
+
+ cache[0] -= ubackw;
+ *offsetp = cache[0];
+ return;
+ }
+ }
+ }
}
while (s < send) {
==== //depot/maint-5.8/perl/t/op/index.t#2 (xtext) ====
Index: perl/t/op/index.t
--- perl/t/op/index.t#1~17645~ Fri Jul 19 12:29:57 2002
+++ perl/t/op/index.t Sun Jun 1 00:35:55 2003
@@ -1,49 +1,71 @@
#!./perl
-# $RCSfile: index.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:59 $
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+}
-print "1..24\n";
+require './test.pl';
+plan( tests => 28 );
$foo = 'Now is the time for all good men to come to the aid of their country.';
$first = substr($foo,0,index($foo,'the'));
-print ($first eq "Now is " ? "ok 1\n" : "not ok 1\n");
+is($first, "Now is ");
$last = substr($foo,rindex($foo,'the'),100);
-print ($last eq "their country." ? "ok 2\n" : "not ok 2\n");
+is($last, "their country.");
$last = substr($foo,index($foo,'Now'),2);
-print ($last eq "No" ? "ok 3\n" : "not ok 3\n");
+is($last, "No");
$last = substr($foo,rindex($foo,'Now'),2);
-print ($last eq "No" ? "ok 4\n" : "not ok 4\n");
+is($last, "No");
$last = substr($foo,index($foo,'.'),100);
-print ($last eq "." ? "ok 5\n" : "not ok 5\n");
+is($last, ".");
$last = substr($foo,rindex($foo,'.'),100);
-print ($last eq "." ? "ok 6\n" : "not ok 6\n");
+is($last, ".");
-print index("ababa","a",-1) == 0 ? "ok 7\n" : "not ok 7\n";
-print index("ababa","a",0) == 0 ? "ok 8\n" : "not ok 8\n";
-print index("ababa","a",1) == 2 ? "ok 9\n" : "not ok 9\n";
-print index("ababa","a",2) == 2 ? "ok 10\n" : "not ok 10\n";
-print index("ababa","a",3) == 4 ? "ok 11\n" : "not ok 11\n";
-print index("ababa","a",4) == 4 ? "ok 12\n" : "not ok 12\n";
-print index("ababa","a",5) == -1 ? "ok 13\n" : "not ok 13\n";
-
-print rindex("ababa","a",-1) == -1 ? "ok 14\n" : "not ok 14\n";
-print rindex("ababa","a",0) == 0 ? "ok 15\n" : "not ok 15\n";
-print rindex("ababa","a",1) == 0 ? "ok 16\n" : "not ok 16\n";
-print rindex("ababa","a",2) == 2 ? "ok 17\n" : "not ok 17\n";
-print rindex("ababa","a",3) == 2 ? "ok 18\n" : "not ok 18\n";
-print rindex("ababa","a",4) == 4 ? "ok 19\n" : "not ok 19\n";
-print rindex("ababa","a",5) == 4 ? "ok 20\n" : "not ok 20\n";
+is(index("ababa","a",-1), 0);
+is(index("ababa","a",0), 0);
+is(index("ababa","a",1), 2);
+is(index("ababa","a",2), 2);
+is(index("ababa","a",3), 4);
+is(index("ababa","a",4), 4);
+is(index("ababa","a",5), -1);
+
+is(rindex("ababa","a",-1), -1);
+is(rindex("ababa","a",0), 0);
+is(rindex("ababa","a",1), 0);
+is(rindex("ababa","a",2), 2);
+is(rindex("ababa","a",3), 2);
+is(rindex("ababa","a",4), 4);
+is(rindex("ababa","a",5), 4);
$a = "foo \x{1234}bar";
-print index($a, "\x{1234}") == 4 ? "ok 21\n" : "not ok 21\n";
-print index($a, "bar", ) == 5 ? "ok 22\n" : "not ok 22\n";
+is(index($a, "\x{1234}"), 4);
+is(index($a, "bar", ), 5);
-print rindex($a, "\x{1234}") == 4 ? "ok 23\n" : "not ok 23\n";
-print rindex($a, "foo", ) == 0 ? "ok 24\n" : "not ok 24\n";
+is(rindex($a, "\x{1234}"), 4);
+is(rindex($a, "foo", ), 0);
+
+{
+ my $needle = "\x{1230}\x{1270}";
+ my @needles = split ( //, $needle );
+ my $haystack = "\x{1228}\x{1228}\x{1230}\x{1270}";
+ foreach ( @needles ) {
+ my $a = index ( "\x{1228}\x{1228}\x{1230}\x{1270}", $_ );
+ my $b = index ( $haystack, $_ );
+ is($a, $b, q{[perl #22375] 'split'/'index' problem for utf8});
+ }
+ $needle = "\x{1270}\x{1230}"; # Transpose them.
+ @needles = split ( //, $needle );
+ foreach ( @needles ) {
+ my $a = index ( "\x{1228}\x{1228}\x{1230}\x{1270}", $_ );
+ my $b = index ( $haystack, $_ );
+ is($a, $b, q{[perl #22375] 'split'/'index' problem for utf8});
+ }
+}
==== //depot/maint-5.8/perl/t/op/stash.t#2 (text) ====
Index: perl/t/op/stash.t
--- perl/t/op/stash.t#1~18080~ Sun Nov 3 21:23:04 2002
+++ perl/t/op/stash.t Sun Jun 1 00:35:55 2003
@@ -7,7 +7,7 @@
require "./test.pl";
-plan( tests => 1 );
+plan( tests => 2 );
# Used to segfault (bug #15479)
fresh_perl_is(
@@ -15,4 +15,12 @@
'Odd number of elements in hash assignment at - line 1.',
{ switches => [ '-w' ] },
'delete $::{STDERR} and print a warning',
+);
+
+# Used to segfault
+fresh_perl_is(
+ 'BEGIN { $::{"X::"} = 2 }',
+ '',
+ { switches => [ '-w' ] },
+ q(Insert a non-GV in a stash, under warnings 'once'),
);
==== //depot/maint-5.8/perl/t/op/subst.t#9 (xtext) ====
Index: perl/t/op/subst.t
--- perl/t/op/subst.t#8~19216~ Tue Apr 15 06:47:16 2003
+++ perl/t/op/subst.t Sun Jun 1 00:35:55 2003
@@ -7,7 +7,7 @@
}
require './test.pl';
-plan( tests => 129 );
+plan( tests => 130 );
$x = 'foo';
$_ = "x";
@@ -531,3 +531,11 @@
$_ = "abc";
/(a)/; s/(b)|(c)/-$^N/g;
is($_,'a-b-c','#20682 $^N not visible in replacement');
+
+# [perl #22351] perl bug with 'e' substitution modifier
+my $name = "chris";
+{
+ no warnings 'uninitialized';
+ $name =~ s/hr//e;
+}
+is($name, "cis", q[#22351 bug with 'e' substitution modifier]);
==== //depot/maint-5.8/perl/t/op/write.t#2 (xtext) ====
Index: perl/t/op/write.t
--- perl/t/op/write.t#1~17645~ Fri Jul 19 12:29:57 2002
+++ perl/t/op/write.t Sun Jun 1 00:35:55 2003
@@ -5,7 +5,7 @@
@INC = '../lib';
}
-print "1..47\n";
+print "1..48\n";
my $CAT = ($^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'VMS') ? 'type'
: ($^O eq 'MacOS') ? 'catenate'
@@ -271,17 +271,29 @@
else
{ print "not ok 11\n"; }
-# 12..47: scary format testing from Merijn H. Brand
+{
+ our $el;
+ format STDOUT =
+ok ^<<<<<<<<<<<<<<~~ # sv_chop() naze
+$el
+.
+ my %hash = (12 => 3);
+ for $el (keys %hash) {
+ write;
+ }
+}
+
+# 13..48: scary format testing from Merijn H. Brand
if ($^O eq 'VMS' || $^O eq 'MSWin32' || $^O eq 'dos' || $^O eq 'MacOS' ||
($^O eq 'os2' and not eval '$OS2::can_fork')) {
- foreach (12..47) { print "ok $_ # skipped: '|-' and '-|' not supported\n"; }
+ foreach (13..48) { print "ok $_ # skipped: '|-' and '-|' not supported\n"; }
exit(0);
}
use strict; # Amazed that this hackery can be made strict ...
-my $test = 12;
+my $test = 13;
# Just a complete test for format, including top-, left- and bottom marging
# and format detection through glob entries
End of Patch.
