Change 19817 by [EMAIL PROTECTED] on 2003/06/19 05:24:45
Integrate:
[ 19804]
Subject: DOCPATCH Re: $1 remains uncleared for failed matches
From: david nicol <[EMAIL PROTECTED]>
Date: 16 Jun 2003 20:35:24 -0500
Message-Id: <[EMAIL PROTECTED]>
Subject: Re: DOCPATCH Re: $1 remains uncleared for failed matches
From: Ronald J Kimball <[EMAIL PROTECTED]>
Date: Tue, 17 Jun 2003 00:12:04 -0400
Message-ID: <[EMAIL PROTECTED]>
[ 19805]
Subject: /ext/DynaLoader/dl_dyld.xs
From: "Peter O'Gorman" <[EMAIL PROTECTED]>
Date: Tue, 17 Jun 2003 23:45:47 +0900
Message-Id: <[EMAIL PROTECTED]>
No need to see dlclose() and dlsym() outside the dl_dyld.xs
(Mac OS X, NeXT), and seeing them is harmful for libdlcompat
of OpenDarwin.
[ 19806]
io_dir.t tweak from Craig Berry.
[ 19809]
If the first argument of sigaction() was a string, not a number
(or a SIGXXX 'constant') one got first (if using -w) 'Argument "FOO"
isn't numeric in subroutine entry ...' but after that one got
(depending on the OS) either a coredump (because of trying to
assign to *0 in mg_get) or a hang (because of the sigprocmask()
blocking signals inside POSIX::sigaction, a nasty hang since
one obviously cannot interrupt it...only SIGKILL works).
In older Perls (tried with 5.6.1) one got 'No such signal: SIGZERO ...'
because of the string becoming zero due to the XS typemap magic.
Resolved by making the POSIX::sigaction to try harder to figure
out a valid signal number (one still gets the warning, though),
and returning undef if no sense can be made.
[ 19810]
Oops in change #19809.
[ 19811]
Subject: Encode] 1.96 Released
From: Dan Kogai <[EMAIL PROTECTED]>
Date: Wed, 18 Jun 2003 19:09:11 +0900
Message-Id: <[EMAIL PROTECTED]>
[ 19812]
Sync with libnet 1.16
[ 19813]
Upgrade to Tie::File 0.97.
[ 19814]
Subject: Re: [perl #22727] split() with re_eval segfaults/panics
From: Enache Adrian <[EMAIL PROTECTED]>
Date: Wed, 18 Jun 2003 23:00:43 +0300
Message-ID: <[EMAIL PROTECTED]>
[ 19815]
A bunch of minor changes to perlguts.pod.
[ 19816]
MPE/iX gets serious indigestion on w-packed infinities.
Affected files ...
... //depot/maint-5.8/perl/ext/DynaLoader/dl_dyld.xs#2 integrate
... //depot/maint-5.8/perl/ext/Encode/Changes#16 integrate
... //depot/maint-5.8/perl/ext/Encode/Encode.pm#15 integrate
... //depot/maint-5.8/perl/ext/Encode/Encode.xs#11 integrate
... //depot/maint-5.8/perl/ext/Encode/META.yml#3 integrate
... //depot/maint-5.8/perl/ext/Encode/Unicode/Unicode.pm#7 integrate
... //depot/maint-5.8/perl/ext/Encode/Unicode/Unicode.xs#8 integrate
... //depot/maint-5.8/perl/ext/Encode/bin/piconv#5 integrate
... //depot/maint-5.8/perl/ext/Encode/encoding.pm#10 integrate
... //depot/maint-5.8/perl/ext/Encode/lib/Encode/Encoding.pm#6 integrate
... //depot/maint-5.8/perl/ext/Encode/lib/Encode/JP/JIS7.pm#4 integrate
... //depot/maint-5.8/perl/ext/Encode/t/Unicode.t#7 integrate
... //depot/maint-5.8/perl/ext/Encode/t/guess.t#3 integrate
... //depot/maint-5.8/perl/ext/IO/lib/IO/t/io_dir.t#2 integrate
... //depot/maint-5.8/perl/ext/POSIX/POSIX.pod#9 integrate
... //depot/maint-5.8/perl/ext/POSIX/POSIX.xs#8 integrate
... //depot/maint-5.8/perl/ext/POSIX/t/sigaction.t#3 integrate
... //depot/maint-5.8/perl/lib/Net/ChangeLog.libnet#5 integrate
... //depot/maint-5.8/perl/lib/Net/FTP.pm#6 integrate
... //depot/maint-5.8/perl/lib/Tie/File.pm#4 integrate
... //depot/maint-5.8/perl/lib/Tie/File/t/00_version.t#4 integrate
... //depot/maint-5.8/perl/lib/Tie/File/t/09_gen_rs.t#5 integrate
... //depot/maint-5.8/perl/lib/Tie/File/t/28_mtwrite.t#2 integrate
... //depot/maint-5.8/perl/lib/Tie/File/t/29_downcopy.t#2 integrate
... //depot/maint-5.8/perl/pod/perlguts.pod#8 integrate
... //depot/maint-5.8/perl/pod/perlre.pod#6 integrate
... //depot/maint-5.8/perl/pod/perltrap.pod#4 integrate
... //depot/maint-5.8/perl/pp.c#22 integrate
... //depot/maint-5.8/perl/regexec.c#20 integrate
... //depot/maint-5.8/perl/t/op/pack.t#9 integrate
... //depot/maint-5.8/perl/t/op/pat.t#17 integrate
Differences ...
==== //depot/maint-5.8/perl/ext/DynaLoader/dl_dyld.xs#2 (text) ====
Index: perl/ext/DynaLoader/dl_dyld.xs
--- perl/ext/DynaLoader/dl_dyld.xs#1~17645~ Fri Jul 19 12:29:57 2002
+++ perl/ext/DynaLoader/dl_dyld.xs Wed Jun 18 22:24:45 2003
@@ -54,7 +54,7 @@
return dl_last_error;
}
-int dlclose(handle) /* stub only */
+static int dlclose(handle) /* stub only */
void *handle;
{
return 0;
@@ -122,7 +122,7 @@
return handle;
}
-void *
+static void *
dlsym(handle, symbol)
void *handle;
char *symbol;
==== //depot/maint-5.8/perl/ext/Encode/Changes#16 (text) ====
Index: perl/ext/Encode/Changes
--- perl/ext/Encode/Changes#15~19611~ Sat May 24 00:50:43 2003
+++ perl/ext/Encode/Changes Wed Jun 18 22:24:45 2003
@@ -1,8 +1,30 @@
# Revision history for Perl extension Encode.
#
-# $Id: Changes,v 1.95 2003/05/21 08:41:11 dankogai Exp $
+# $Id: Changes,v 1.96 2003/06/18 09:29:02 dankogai Exp $
#
-$Revision: 1.95 $ $Date: 2003/05/21 08:41:11 $
+$Revision: 1.96 $ $Date: 2003/06/18 09:29:02 $
+! lib/Encode/JP/JP.pm t/guess.t
+ m/(...)/ in void context then $1 is considered a Bad Thing
+ Message-Id: <[EMAIL PROTECTED]>
+! Encode.pm
+ Mentions in POD that as of perl 5.8.1 utf8::is_utf8() is
+ also available.
+! encengine.c
+ More typecast from [EMAIL PROTECTED]
+ Message-Id: <[EMAIL PROTECTED]>
+! t/perlio.t
+ Tests 37 & 38 failed on Win32 -- yet another CRLF issue
+ Message-Id: <[EMAIL PROTECTED]>
+! t/Encode.t
+ Now skips for EBCDIC platform.
+ Message-Id: <[EMAIL PROTECTED]>
+! t/perlio.t
+ Craig's patch applied that addresses "Many systems (DOS, VMS) cannot
+ have more than one C<.> in their filenames." -- perlport.
+ Message-Id: <[EMAIL PROTECTED]>
+! bin/piconv
+ Found and fixed the back that -p,--perlqq does not work.
+ Induced by the change from Getopt::Std to Getopt::Long.
! encoding.pm
Addressed [cpan #2629] Wrong assumption in numeric comparison
Message-Id: <[EMAIL PROTECTED]>
==== //depot/maint-5.8/perl/ext/Encode/Encode.pm#15 (text) ====
Index: perl/ext/Encode/Encode.pm
--- perl/ext/Encode/Encode.pm#14~19611~ Sat May 24 00:50:43 2003
+++ perl/ext/Encode/Encode.pm Wed Jun 18 22:24:45 2003
@@ -1,9 +1,9 @@
#
-# $Id: Encode.pm,v 1.95 2003/05/21 08:40:59 dankogai Exp $
+# $Id: Encode.pm,v 1.96 2003/06/18 09:29:02 dankogai Exp $
#
package Encode;
use strict;
-our $VERSION = do { my @r = (q$Revision: 1.95 $ =~ /\d+/g); sprintf "%d."."%02d" x
$#r, @r };
+our $VERSION = do { my @r = (q$Revision: 1.96 $ =~ /\d+/g); sprintf "%d."."%02d" x
$#r, @r };
our $DEBUG = 0;
use XSLoader ();
XSLoader::load(__PACKAGE__, $VERSION);
@@ -738,6 +738,8 @@
[INTERNAL] Tests whether the UTF-8 flag is turned on in the STRING.
If CHECK is true, also checks the data in STRING for being well-formed
UTF-8. Returns true if successful, false otherwise.
+
+As of perl 5.8.1, L<utf8> also has utf8::is_utif8().
=item _utf8_on(STRING)
==== //depot/maint-5.8/perl/ext/Encode/Encode.xs#11 (text) ====
Index: perl/ext/Encode/Encode.xs
--- perl/ext/Encode/Encode.xs#10~19611~ Sat May 24 00:50:43 2003
+++ perl/ext/Encode/Encode.xs Wed Jun 18 22:24:45 2003
@@ -1,5 +1,5 @@
/*
- $Id: Encode.xs,v 1.55 2003/02/28 01:40:27 dankogai Exp dankogai $
+ $Id: Encode.xs,v 1.56 2003/06/18 09:29:02 dankogai Exp $
*/
#define PERL_NO_GET_CONTEXT
==== //depot/maint-5.8/perl/ext/Encode/META.yml#3 (text) ====
Index: perl/ext/Encode/META.yml
--- perl/ext/Encode/META.yml#2~19591~ Thu May 22 04:59:21 2003
+++ perl/ext/Encode/META.yml Wed Jun 18 22:24:45 2003
@@ -1,9 +1,9 @@
#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
name: Encode
-version: 1.95
+version: 1.96
version_from: Encode.pm
installdirs: perl
requires:
distribution_type: module
-generated_by: ExtUtils::MakeMaker version 6.10_03
+generated_by: ExtUtils::MakeMaker version 6.10_05
==== //depot/maint-5.8/perl/ext/Encode/Unicode/Unicode.pm#7 (text) ====
Index: perl/ext/Encode/Unicode/Unicode.pm
--- perl/ext/Encode/Unicode/Unicode.pm#6~19611~ Sat May 24 00:50:43 2003
+++ perl/ext/Encode/Unicode/Unicode.pm Wed Jun 18 22:24:45 2003
@@ -4,7 +4,7 @@
use warnings;
no warnings 'redefine';
-our $VERSION = do { my @r = (q$Revision: 1.39 $ =~ /\d+/g); sprintf "%d."."%02d" x
$#r, @r };
+our $VERSION = do { my @r = (q$Revision: 1.40 $ =~ /\d+/g); sprintf "%d."."%02d" x
$#r, @r };
use XSLoader;
XSLoader::load(__PACKAGE__,$VERSION);
==== //depot/maint-5.8/perl/ext/Encode/Unicode/Unicode.xs#8 (text) ====
Index: perl/ext/Encode/Unicode/Unicode.xs
--- perl/ext/Encode/Unicode/Unicode.xs#7~19611~ Sat May 24 00:50:43 2003
+++ perl/ext/Encode/Unicode/Unicode.xs Wed Jun 18 22:24:45 2003
@@ -1,5 +1,5 @@
/*
- $Id: Unicode.xs,v 1.7 2003/02/20 14:42:34 dankogai Exp dankogai $
+ $Id: Unicode.xs,v 1.8 2003/06/18 09:29:02 dankogai Exp $
*/
#define PERL_NO_GET_CONTEXT
==== //depot/maint-5.8/perl/ext/Encode/bin/piconv#5 (text) ====
Index: perl/ext/Encode/bin/piconv
--- perl/ext/Encode/bin/piconv#4~19636~ Thu May 29 07:19:35 2003
+++ perl/ext/Encode/bin/piconv Wed Jun 18 22:24:45 2003
@@ -1,5 +1,5 @@
#!./perl
-# $Id: piconv,v 1.26 2003/05/10 18:13:59 dankogai Exp $
+# $Id: piconv,v 1.27 2003/06/18 09:29:02 dankogai Exp $
#
use 5.8.0;
use strict;
==== //depot/maint-5.8/perl/ext/Encode/encoding.pm#10 (text) ====
Index: perl/ext/Encode/encoding.pm
--- perl/ext/Encode/encoding.pm#9~19591~ Thu May 22 04:59:21 2003
+++ perl/ext/Encode/encoding.pm Wed Jun 18 22:24:45 2003
@@ -1,6 +1,6 @@
-# $Id: encoding.pm,v 1.44 2003/03/09 20:07:37 dankogai Exp $
+# $Id: encoding.pm,v 1.45 2003/06/18 09:29:02 dankogai Exp $
package encoding;
-our $VERSION = do { my @r = (q$Revision: 1.44 $ =~ /\d+/g); sprintf "%d."."%02d" x
$#r, @r };
+our $VERSION = do { my @r = (q$Revision: 1.45 $ =~ /\d+/g); sprintf "%d."."%02d" x
$#r, @r };
use Encode;
use strict;
@@ -21,11 +21,11 @@
sub _exception{
my $name = shift;
- $] > 5.008 and return 0; # 5.8.1 then no
+ $] > 5.008 and return 0; # 5.8.1 or higher then no
my %utfs = map {$_=>1}
qw(utf8 UCS-2BE UCS-2LE UTF-16 UTF-16BE UTF-16LE
UTF-32 UTF-32BE UTF-32LE);
- $utfs{$name} or return 0; # UTFs or no
+ $utfs{$name} or return 0; # UTFs or no
require Config; Config->import(); our %Config;
return $Config{perl_patchlevel} ? 0 : 1 # maintperl then no
}
==== //depot/maint-5.8/perl/ext/Encode/lib/Encode/Encoding.pm#6 (text) ====
Index: perl/ext/Encode/lib/Encode/Encoding.pm
--- perl/ext/Encode/lib/Encode/Encoding.pm#5~19611~ Sat May 24 00:50:43 2003
+++ perl/ext/Encode/lib/Encode/Encoding.pm Wed Jun 18 22:24:45 2003
@@ -1,7 +1,7 @@
package Encode::Encoding;
# Base class for classes which implement encodings
use strict;
-our $VERSION = do { my @r = (q$Revision: 1.32 $ =~ /\d+/g); sprintf "%d."."%02d" x
$#r, @r };
+our $VERSION = do { my @r = (q$Revision: 1.33 $ =~ /\d+/g); sprintf "%d."."%02d" x
$#r, @r };
require Encode;
==== //depot/maint-5.8/perl/ext/Encode/lib/Encode/JP/JIS7.pm#4 (text) ====
Index: perl/ext/Encode/lib/Encode/JP/JIS7.pm
--- perl/ext/Encode/lib/Encode/JP/JIS7.pm#3~18665~ Thu Feb 6 01:34:12 2003
+++ perl/ext/Encode/lib/Encode/JP/JIS7.pm Wed Jun 18 22:24:45 2003
@@ -1,7 +1,7 @@
package Encode::JP::JIS7;
use strict;
-our $VERSION = do { my @r = (q$Revision: 1.10 $ =~ /\d+/g); sprintf "%d."."%02d" x
$#r, @r };
+our $VERSION = do { my @r = (q$Revision: 1.11 $ =~ /\d+/g); sprintf "%d."."%02d" x
$#r, @r };
use Encode qw(:fallbacks);
@@ -35,8 +35,7 @@
my ($obj, $str, $chk) = @_;
my $residue = '';
if ($chk){
- $str =~ s/([^\x00-\x7f].*)$//so;
- $1 and $residue = $1;
+ $str =~ s/([^\x00-\x7f].*)$//so and $residue = $1;
}
$residue .= jis_euc(\$str);
$_[1] = $residue if $chk;
==== //depot/maint-5.8/perl/ext/Encode/t/Unicode.t#7 (text) ====
Index: perl/ext/Encode/t/Unicode.t
--- perl/ext/Encode/t/Unicode.t#6~19771~ Fri Jun 13 21:40:49 2003
+++ perl/ext/Encode/t/Unicode.t Wed Jun 18 22:24:45 2003
@@ -1,5 +1,5 @@
#
-# $Id: Unicode.t,v 1.12 2003/05/21 08:41:11 dankogai Exp $
+# $Id: Unicode.t,v 1.13 2003/06/18 09:29:02 dankogai Exp $
#
# This script is written entirely in ASCII, even though quoted literals
# do include non-BMP unicode characters -- Are you happy, jhi?
==== //depot/maint-5.8/perl/ext/Encode/t/guess.t#3 (text) ====
Index: perl/ext/Encode/t/guess.t
--- perl/ext/Encode/t/guess.t#2~19331~ Fri Apr 25 07:51:16 2003
+++ perl/ext/Encode/t/guess.t Wed Jun 18 22:24:45 2003
@@ -21,7 +21,7 @@
use Encode qw(decode encode find_encoding _utf8_off);
#use Test::More qw(no_plan);
-use Test::More tests => 23;
+use Test::More tests => 29;
use_ok("Encode::Guess");
{
no warnings;
@@ -99,4 +99,19 @@
my $result = guess_encoding($test);
ok(! ref($result), "UTF-16$bl:$result");
}
+
+
+
+Encode::Guess->set_suspects();
+for my $jp (@jp){
+ # intentionally set $1 a priori -- see Changes
+ my $test = "English";
+ '$1' =~ m/^(.*)/o;
+ is(guess_encoding($test, ($jp))->name, 'ascii',
+ "ascii vs $jp (\$1 messed)");
+ $test = encode($jp, $test . "\n\x{65e5}\x{672c}\x{8a9e}");
+ is(guess_encoding($test, ($jp))->name,
+ $jp, "$jp vs ascii (\$1 messed)");
+}
+
__END__;
==== //depot/maint-5.8/perl/ext/IO/lib/IO/t/io_dir.t#2 (xtext) ====
Index: perl/ext/IO/lib/IO/t/io_dir.t
--- perl/ext/IO/lib/IO/t/io_dir.t#1~17645~ Fri Jul 19 12:29:57 2002
+++ perl/ext/IO/lib/IO/t/io_dir.t Wed Jun 18 22:24:45 2003
@@ -17,27 +17,35 @@
use IO::Dir qw(DIR_UNLINK);
+my $tcount = 0;
+
+sub ok {
+ $tcount++;
+ my $not = $_[0] ? '' : 'not ';
+ print "${not}ok $tcount\n";
+}
+
print "1..10\n";
my $DIR = $^O eq 'MacOS' ? ":" : ".";
$dot = new IO::Dir $DIR;
-print defined($dot) ? "ok" : "not ok", " 1\n";
+ok(defined($dot));
@a = sort <*>;
do { $first = $dot->read } while defined($first) && $first =~ /^\./;
-print +(grep { $_ eq $first } @a) ? "ok" : "not ok", " 2\n";
+ok(+(grep { $_ eq $first } @a));
@b = sort($first, (grep {/^[^.]/} $dot->read));
-print +(join("\0", @a) eq join("\0", @b)) ? "ok" : "not ok", " 3\n";
+ok(+(join("\0", @a) eq join("\0", @b)));
$dot->rewind;
@c = sort grep {/^[^.]/} $dot->read;
-print +(join("\0", @b) eq join("\0", @c)) ? "ok" : "not ok", " 4\n";
+ok(+(join("\0", @b) eq join("\0", @c)));
$dot->close;
$dot->rewind;
-print defined($dot->read) ? "not ok" : "ok", " 5\n";
+ok(!defined($dot->read));
open(FH,'>X') || die "Can't create x";
print FH "X";
@@ -47,22 +55,20 @@
my @files = keys %dir;
# I hope we do not have an empty dir :-)
-print @files ? "ok" : "not ok", " 6\n";
+ok(scalar @files);
my $stat = $dir{'X'};
-print defined($stat) && UNIVERSAL::isa($stat,'File::stat') && $stat->size == 1
- ? "ok" : "not ok", " 7\n";
+ok(defined($stat) && UNIVERSAL::isa($stat,'File::stat') && $stat->size == 1);
delete $dir{'X'};
-print -f 'X' ? "ok" : "not ok", " 8\n";
+ok(-f 'X');
tie %dirx, IO::Dir, $DIR, DIR_UNLINK;
my $statx = $dirx{'X'};
-print defined($statx) && UNIVERSAL::isa($statx,'File::stat') && $statx->size == 1
- ? "ok" : "not ok", " 9\n";
+ok(defined($statx) && UNIVERSAL::isa($statx,'File::stat') && $statx->size == 1);
delete $dirx{'X'};
-print -f 'X' ? "not ok" : "ok", " 10\n";
+ok(!(-f 'X'));
==== //depot/maint-5.8/perl/ext/POSIX/POSIX.pod#9 (text) ====
Index: perl/ext/POSIX/POSIX.pod
--- perl/ext/POSIX/POSIX.pod#8~19515~ Tue May 13 10:51:05 2003
+++ perl/ext/POSIX/POSIX.pod Wed Jun 18 22:24:45 2003
@@ -1123,9 +1123,11 @@
Synopsis:
- sigaction(sig, action, oldaction = 0)
+ sigaction(signal, action, oldaction = 0)
-Returns C<undef> on failure.
+Returns C<undef> on failure. The C<signal> must be a number (like
+SIGHUP), not a string (like "SIGHUP"), though Perl does try hard
+to understand you.
=item siglongjmp
==== //depot/maint-5.8/perl/ext/POSIX/POSIX.xs#8 (text) ====
Index: perl/ext/POSIX/POSIX.xs
--- perl/ext/POSIX/POSIX.xs#7~19738~ Tue Jun 10 22:13:38 2003
+++ perl/ext/POSIX/POSIX.xs Wed Jun 18 22:24:45 2003
@@ -1212,10 +1212,26 @@
sigset_t osset;
POSIX__SigSet sigset;
SV** svp;
- SV** sigsvp = hv_fetch(GvHVn(siggv),
- PL_sig_name[sig],
- strlen(PL_sig_name[sig]),
- TRUE);
+ SV** sigsvp;
+ if (sig == 0 && SvPOK(ST(0))) {
+ char *s = SvPVX(ST(0));
+ int i = whichsig(s);
+
+ if (i < 0 && memEQ(s, "SIG", 3))
+ i = whichsig(s + 3);
+ if (i < 0) {
+ if (ckWARN(WARN_SIGNAL))
+ Perl_warner(aTHX_ packWARN(WARN_SIGNAL),
+ "No such signal: SIG%s", s);
+ XSRETURN_UNDEF;
+ }
+ else
+ sig = i;
+ }
+ sigsvp = hv_fetch(GvHVn(siggv),
+ PL_sig_name[sig],
+ strlen(PL_sig_name[sig]),
+ TRUE);
/* Check optaction and set action */
if(SvTRUE(optaction)) {
==== //depot/maint-5.8/perl/ext/POSIX/t/sigaction.t#3 (text) ====
Index: perl/ext/POSIX/t/sigaction.t
--- perl/ext/POSIX/t/sigaction.t#2~18850~ Fri Mar 7 12:38:51 2003
+++ perl/ext/POSIX/t/sigaction.t Wed Jun 18 22:24:45 2003
@@ -21,7 +21,7 @@
$^W=1;
-print "1..18\n";
+print "1..21\n";
sub IGNORE {
$bad7=1;
@@ -133,3 +133,25 @@
print $bad18 ? "not ok 18\n" : "ok 18\n";
}
+{
+ local $SIG{__WARN__} = sub { }; # Just suffer silently.
+
+ my $hup20;
+ my $hup21;
+
+ sub hup20 { $hup20++ }
+ sub hup21 { $hup21++ }
+
+ sigaction("FOOBAR", $newaction);
+ print "ok 19\n"; # no coredump, still alive
+
+ $newaction = POSIX::SigAction->new("hup20");
+ sigaction("SIGHUP", $newaction);
+ kill "HUP", $$;
+ print $hup20 == 1 ? "ok 20\n" : "not ok 20\n";
+
+ $newaction = POSIX::SigAction->new("hup21");
+ sigaction("HUP", $newaction);
+ kill "HUP", $$;
+ print $hup21 == 1 ? "ok 21\n" : "not ok 21\n";
+}
==== //depot/maint-5.8/perl/lib/Net/ChangeLog.libnet#5 (text) ====
Index: perl/lib/Net/ChangeLog.libnet
--- perl/lib/Net/ChangeLog.libnet#4~19759~ Fri Jun 13 00:22:57 2003
+++ perl/lib/Net/ChangeLog.libnet Wed Jun 18 22:24:45 2003
@@ -1,3 +1,12 @@
+Change 820 on 2003/06/17 by <[EMAIL PROTECTED]> (Graham Barr)
+
+ Net::FTP
+ - Fix uninit warning when sending the ALLO command inside put
+
+Change 819 on 2003/06/13 by <[EMAIL PROTECTED]> (Graham Barr)
+
+ Release 1.15
+
Change 818 on 2003/06/13 by <[EMAIL PROTECTED]> (Graham Barr)
Net::FTP
==== //depot/maint-5.8/perl/lib/Net/FTP.pm#6 (text) ====
Index: perl/lib/Net/FTP.pm
--- perl/lib/Net/FTP.pm#5~19759~ Fri Jun 13 00:22:57 2003
+++ perl/lib/Net/FTP.pm Wed Jun 18 22:24:45 2003
@@ -22,7 +22,7 @@
use Fcntl qw(O_WRONLY O_RDONLY O_APPEND O_CREAT O_TRUNC);
# use AutoLoader qw(AUTOLOAD);
-$VERSION = "2.70"; # $Id: //depot/libnet/Net/FTP.pm#76 $
+$VERSION = "2.71"; # $Id: //depot/libnet/Net/FTP.pm#78 $
@ISA = qw(Exporter Net::Cmd IO::Socket::INET);
# Someday I will "use constant", when I am not bothered to much about
@@ -713,7 +713,8 @@
# _store_cmd call, figure out if the local file is a regular file(not
# a pipe, or device) and if so get the file size from stat, and send
# an ALLO command before sending the STOR, STOU, or APPE command.
- $ftp->_ALLO(-s _) if -f $loc; # no ALLO if sending data from a pipe
+ my $size = -f $local && -s _; # no ALLO if sending data from a pipe
+ $ftp->_ALLO($size) if $size;
}
croak("Bad remote filename '$remote'\n")
if $remote =~ /[\r\n]/s;
@@ -1766,6 +1767,6 @@
=for html <hr>
-I<$Id: //depot/libnet/Net/FTP.pm#76 $>
+I<$Id: //depot/libnet/Net/FTP.pm#78 $>
=cut
==== //depot/maint-5.8/perl/lib/Tie/File.pm#4 (text) ====
Index: perl/lib/Tie/File.pm
--- perl/lib/Tie/File.pm#3~19653~ Sun Jun 1 00:35:55 2003
+++ perl/lib/Tie/File.pm Wed Jun 18 22:24:45 2003
@@ -7,14 +7,14 @@
sub O_ACCMODE () { O_RDONLY | O_RDWR | O_WRONLY }
-$VERSION = "0.96";
+$VERSION = "0.97";
my $DEFAULT_MEMORY_SIZE = 1<<21; # 2 megabytes
my $DEFAULT_AUTODEFER_THRESHHOLD = 3; # 3 records
my $DEFAULT_AUTODEFER_FILELEN_THRESHHOLD = 65536; # 16 disk blocksful
my %good_opt = map {$_ => 1, "-$_" => 1}
qw(memory dw_size mode recsep discipline
- autodefer autochomp autodefer_threshhold);
+ autodefer autochomp autodefer_threshhold concurrent);
sub TIEARRAY {
if (@_ % 2 != 0) {
@@ -33,6 +33,10 @@
}
}
+ if ($opts{concurrent}) {
+ croak("$pack: concurrent access not supported yet\n");
+ }
+
unless (defined $opts{memory}) {
# default is the larger of the default cache size and the
# deferred-write buffer size (if specified)
@@ -697,6 +701,8 @@
# moving everything in the block forwards to make room.
# Instead of writing the last length($data) bytes from the block
# (because there isn't room for them any longer) return them.
+#
+# Undefined $len means 'until the end of the file'
sub _downcopy {
my $blocksize = 8192;
my ($self, $data, $pos, $len) = @_;
@@ -707,10 +713,19 @@
: $len > $blocksize? $blocksize : $len;
$self->_seekb($pos);
read $fh, my($old), $readsize;
+ my $last_read_was_short = length($old) < $readsize;
$data .= $old;
- $self->_seekb($pos);
- my $writable = substr($data, 0, $readsize, "");
+ my $writable;
+ if ($last_read_was_short) {
+ # If last read was short, then $data now contains the entire rest
+ # of the file, so there's no need to write only one block of it
+ $writable = $data;
+ $data = "";
+ } else {
+ $writable = substr($data, 0, $readsize, "");
+ }
last if $writable eq "";
+ $self->_seekb($pos);
$self->_write_record($writable);
$len -= $readsize if defined $len;
$pos += $readsize;
@@ -1993,7 +2008,7 @@
=head1 SYNOPSIS
- # This file documents Tie::File version 0.96
+ # This file documents Tie::File version 0.97
use Tie::File;
tie @array, 'Tie::File', filename or die ...;
@@ -2411,14 +2426,14 @@
=head1 CONCURRENT ACCESS TO FILES
Caching and deferred writing are inappropriate if you want the same
-file to be accessed simultaneously from more than one process. You
-will want to disable these features. You should do that by including
-the C<memory =E<gt> 0> option in your C<tie> calls; this will inhibit
-caching and deferred writing.
-
-You will also want to lock the file while reading or writing it. You
-can use the C<-E<gt>flock> method for this. A future version of this
-module may provide an 'autolocking' mode.
+file to be accessed simultaneously from more than one process. Other
+optimizations performed internally by this module are also
+incompatible with concurrent access. A future version of this module will
+support a C<concurrent =E<gt> 1> option that enables safe concurrent access.
+
+Previous versions of this documentation suggested using C<memory
+=E<gt> 0> for safe concurrent access. This was mistaken. Tie::File
+will not support safe concurrent access before version 0.98.
=head1 CAVEATS
@@ -2516,7 +2531,7 @@
=head1 LICENSE
-C<Tie::File> version 0.96 is copyright (C) 2002 Mark Jason Dominus.
+C<Tie::File> version 0.97 is copyright (C) 2003 Mark Jason Dominus.
This library is free software; you may redistribute it and/or modify
it under the same terms as Perl itself.
@@ -2544,7 +2559,7 @@
=head1 WARRANTY
-C<Tie::File> version 0.96 comes with ABSOLUTELY NO WARRANTY.
+C<Tie::File> version 0.97 comes with ABSOLUTELY NO WARRANTY.
For details, see the license.
=head1 THANKS
==== //depot/maint-5.8/perl/lib/Tie/File/t/00_version.t#4 (text) ====
Index: perl/lib/Tie/File/t/00_version.t
--- perl/lib/Tie/File/t/00_version.t#3~19653~ Sun Jun 1 00:35:55 2003
+++ perl/lib/Tie/File/t/00_version.t Wed Jun 18 22:24:45 2003
@@ -2,7 +2,7 @@
print "1..1\n";
-my $testversion = "0.96";
+my $testversion = "0.97";
use Tie::File;
if ($Tie::File::VERSION != $testversion) {
==== //depot/maint-5.8/perl/lib/Tie/File/t/09_gen_rs.t#5 (text) ====
Index: perl/lib/Tie/File/t/09_gen_rs.t
--- perl/lib/Tie/File/t/09_gen_rs.t#4~19682~ Tue Jun 3 22:22:46 2003
+++ perl/lib/Tie/File/t/09_gen_rs.t Wed Jun 18 22:24:45 2003
@@ -1,6 +1,5 @@
#!/usr/bin/perl
-use lib '/home/mjd/src/perl/Tie-File2/lib';
my $file = "tf$$.txt";
print "1..59\n";
==== //depot/maint-5.8/perl/lib/Tie/File/t/28_mtwrite.t#2 (text) ====
Index: perl/lib/Tie/File/t/28_mtwrite.t
--- perl/lib/Tie/File/t/28_mtwrite.t#1~19515~ Tue May 13 10:51:05 2003
+++ perl/lib/Tie/File/t/28_mtwrite.t Wed Jun 18 22:24:45 2003
@@ -282,62 +282,6 @@
}
}
-# Each element of @TRIES has [start, oldlen, newlen]
-# Try them pairwise
-sub xxtry_all_doubles {
- print "# Trying double regions.\n";
- my %reg; # regions
- for my $i (0 .. $#TRIES) {
- $a = $TRIES[$i];
- ($reg{a}{st}, $reg{a}{ol}, $reg{a}{nl}) = @{$TRIES[$i]};
- next if $reg{a}{st} + $reg{a}{ol} >= $FLEN;
- next if $reg{a}{st} + $reg{a}{nl} >= $FLEN;
- for my $j (0 .. $#TRIES){
- $b = $TRIES[$j];
- ($reg{b}{st}, $reg{b}{ol}, $reg{b}{nl}) = @{$TRIES[$j]};
- next if $reg{b}{st} + $reg{b}{ol} >= $FLEN;
- next if $reg{b}{st} + $reg{b}{nl} >= $FLEN;
-
- next if $reg{b}{st} < $reg{a}{st} + $reg{a}{ol}; # Overlapping regions
-# $reg{b}{st} -= $reg{a}{ol} - $reg{a}{nl};
-
- open F, "> $file" or die "Couldn't open file $file: $!";
- binmode F;
- print F $oldfile;
- close F;
- die "wrong length!" unless -s $file == $FLEN;
-
- my $expected = $oldfile;
- for ('b', 'a') {
- $reg{$_}{nd} = $_ x $reg{$_}{nl};
- substr($expected, $reg{$_}{st}, $reg{$_}{ol}, $reg{$_}{nd});
- }
-
- my $o = tie my @lines, 'Tie::File', $file or die $!;
- $o->_mtwrite($reg{a}{nd}, $reg{a}{st}, $reg{a}{ol},
- $reg{b}{nd}, $reg{b}{st}, $reg{b}{ol},
- );
- undef $o; untie @lines;
-
- open F, "< $file" or die "Couldn't open file $file: $!";
- binmode F;
- my $actual;
- { local $/;
- $actual = <F>;
- }
- close F;
-
- my ($alen, $xlen) = (length $actual, length $expected);
- print "# try_all_doubles(@$a, @$b)\n";
- unless ($alen == $xlen) {
- print "# expected file length $xlen, actual $alen!\n";
- }
- print $actual eq $expected ? "ok $N\n" : "not ok $N\n";
- $N++;
- }
- }
-}
-
sub ctrlfix {
for (@_) {
s/\n/\\n/g;
==== //depot/maint-5.8/perl/lib/Tie/File/t/29_downcopy.t#2 (text) ====
Index: perl/lib/Tie/File/t/29_downcopy.t
--- perl/lib/Tie/File/t/29_downcopy.t#1~19515~ Tue May 13 10:51:05 2003
+++ perl/lib/Tie/File/t/29_downcopy.t Wed Jun 18 22:24:45 2003
@@ -1,6 +1,6 @@
#!/usr/bin/perl
#
-# Unit tests of _twrite function
+# Unit tests of _downcopy function
#
# _downcopy($self, $data, $pos, $len)
# Write $data into a block of length $len at position $pos,
@@ -235,8 +235,6 @@
try(32768, 9232, 0); # old=<x><x , new=0 ; old > new
try(42000, 0, 0); # old=0 , new=0 ; old = new
-
-
sub try {
my ($pos, $len, $newlen) = @_;
open F, "> $file" or die "Couldn't open file $file: $!";
@@ -363,4 +361,3 @@
untie @a;
1 while unlink $file;
}
-
==== //depot/maint-5.8/perl/pod/perlguts.pod#8 (text) ====
Index: perl/pod/perlguts.pod
--- perl/pod/perlguts.pod#7~19704~ Fri Jun 6 22:24:27 2003
+++ perl/pod/perlguts.pod Wed Jun 18 22:24:45 2003
@@ -5,7 +5,7 @@
=head1 DESCRIPTION
This document attempts to describe how to use the Perl API, as well as
-containing some info on the basic workings of the Perl core. It is far
+to provide some info on the basic workings of the Perl core. It is far
from complete and probably contains many errors. Please refer any
questions or comments to the author below.
@@ -43,26 +43,31 @@
SV* newSViv(IV);
SV* newSVuv(UV);
SV* newSVnv(double);
- SV* newSVpv(const char*, int);
- SV* newSVpvn(const char*, int);
+ SV* newSVpv(const char*, STRLEN);
+ SV* newSVpvn(const char*, STRLEN);
SV* newSVpvf(const char*, ...);
SV* newSVsv(SV*);
-If you require more complex initialisation you can create an empty SV with
-newSV(len). If C<len> is 0 an empty SV of type NULL is returned, else an
-SV of type PV is returned with len + 1 (for the NUL) bytes of storage
-allocated, accessible via SvPVX. In both cases the SV has value undef.
+C<STRLEN> is an integer type (Size_t, usually defined as size_t in
+F<config.h>) guaranteed to be large enough to represent the size of
+any string that perl can handle.
+
+In the unlikely case of a SV requiring more complex initialisation, you
+can create an empty SV with newSV(len). If C<len> is 0 an empty SV of
+type NULL is returned, else an SV of type PV is returned with len + 1 (for
+the NUL) bytes of storage allocated, accessible via SvPVX. In both cases
+the SV has value undef.
- SV* newSV(0); /* no storage allocated */
- SV* newSV(10); /* 10 (+1) bytes of uninitialised storage allocated */
+ SV *sv = newSV(0); /* no storage allocated */
+ SV *sv = newSV(10); /* 10 (+1) bytes of uninitialised storage allocated */
-To change the value of an *already-existing* SV, there are eight routines:
+To change the value of an I<already-existing> SV, there are eight routines:
void sv_setiv(SV*, IV);
void sv_setuv(SV*, UV);
void sv_setnv(SV*, double);
void sv_setpv(SV*, const char*);
- void sv_setpvn(SV*, const char*, int)
+ void sv_setpvn(SV*, const char*, STRLEN)
void sv_setpvf(SV*, const char*, ...);
void sv_vsetpvfn(SV*, const char*, STRLEN, va_list *, SV **, I32, bool *);
void sv_setsv(SV*, SV*);
@@ -86,10 +91,6 @@
important. Note that this function requires you to specify the length of
the format.
-STRLEN is an integer type (Size_t, usually defined as size_t in
-config.h) guaranteed to be large enough to represent the size of
-any string that perl can handle.
-
The C<sv_set*()> functions are not generic enough to operate on values
that have "magic". See L<Magic Virtual Tables> later in this document.
@@ -199,12 +200,12 @@
SvOK(SV*)
-The scalar C<undef> value is stored in an SV instance called C<PL_sv_undef>. Its
-address can be used whenever an C<SV*> is needed.
+The scalar C<undef> value is stored in an SV instance called C<PL_sv_undef>.
+Its address can be used whenever an C<SV*> is needed.
-There are also the two values C<PL_sv_yes> and C<PL_sv_no>, which contain Boolean
-TRUE and FALSE values, respectively. Like C<PL_sv_undef>, their addresses can
-be used whenever an C<SV*> is needed.
+There are also the two values C<PL_sv_yes> and C<PL_sv_no>, which contain
+boolean TRUE and FALSE values, respectively. Like C<PL_sv_undef>, their
+addresses can be used whenever an C<SV*> is needed.
Do not be fooled into thinking that C<(SV *) 0> is the same as C<&PL_sv_undef>.
Take this code:
@@ -218,8 +219,8 @@
This code tries to return a new SV (which contains the value 42) if it should
return a real value, or undef otherwise. Instead it has returned a NULL
pointer which, somewhere down the line, will cause a segmentation violation,
-bus error, or just weird results. Change the zero to C<&PL_sv_undef> in the first
-line and all will be well.
+bus error, or just weird results. Change the zero to C<&PL_sv_undef> in the
+first line and all will be well.
To free an SV that you've created, call C<SvREFCNT_dec(SV*)>. Normally this
call is not necessary (see L<Reference Counts and Mortality>).
@@ -536,7 +537,7 @@
=head2 Blessed References and Class Objects
-References are also used to support object-oriented programming. In the
+References are also used to support object-oriented programming. In perl's
OO lexicon, an object is simply a reference that has been blessed into a
package (or class). Once blessed, the programmer may now use the reference
to access the various methods in the class.
@@ -545,8 +546,8 @@
SV* sv_bless(SV* sv, HV* stash);
-The C<sv> argument must be a reference. The C<stash> argument specifies
-which class the reference will belong to. See
+The C<sv> argument must be a reference value. The C<stash> argument
+specifies which class the reference will belong to. See
L<Stashes and Globs> for information on converting class names into stashes.
/* Still under construction */
@@ -685,9 +686,9 @@
"Mortal" SVs are mainly used for SVs that are placed on perl's stack.
For example an SV which is created just to pass a number to a called sub
-is made mortal to have it cleaned up automatically when stack is popped.
-Similarly results returned by XSUBs (which go in the stack) are often
-made mortal.
+is made mortal to have it cleaned up automatically when it's popped off
+the stack. Similarly, results returned by XSUBs (which are pushed on the
+stack) are often made mortal.
To create a mortal variable, use the functions:
@@ -724,8 +725,8 @@
=head2 Stashes and Globs
-A "stash" is a hash that contains all of the different objects that
-are contained within a package. Each key of the stash is a symbol
+A B<stash> is a hash that contains all variables that are defined
+within a package. Each key of the stash is a symbol
name (shared by all the different types of objects that have the same
name), and each value in the hash table is a GV (Glob Value). This GV
in turn contains references to the various objects of that name,
@@ -738,11 +739,11 @@
Format
Subroutine
-There is a single stash called "PL_defstash" that holds the items that exist
-in the "main" package. To get at the items in other packages, append the
-string "::" to the package name. The items in the "Foo" package are in
-the stash "Foo::" in PL_defstash. The items in the "Bar::Baz" package are
-in the stash "Baz::" in "Bar::"'s stash.
+There is a single stash called C<PL_defstash> that holds the items that exist
+in the C<main> package. To get at the items in other packages, append the
+string "::" to the package name. The items in the C<Foo> package are in
+the stash C<Foo::> in PL_defstash. The items in the C<Bar::Baz> package are
+in the stash C<Baz::> in C<Bar::>'s stash.
To get the stash pointer for a particular package, use the function:
@@ -863,9 +864,9 @@
The sv_magic function uses C<how> to determine which, if any, predefined
"Magic Virtual Table" should be assigned to the C<mg_virtual> field.
-See the "Magic Virtual Table" section below. The C<how> argument is also
+See the L<Magic Virtual Tables> section below. The C<how> argument is also
stored in the C<mg_type> field. The value of C<how> should be chosen
-from the set of macros C<PERL_MAGIC_foo> found perl.h. Note that before
+from the set of macros C<PERL_MAGIC_foo> found in F<perl.h>. Note that before
these macros were added, Perl internals used to directly use character
literals, so you may occasionally come across old code or documentation
referring to 'U' magic rather than C<PERL_MAGIC_uvar> for example.
@@ -904,7 +905,7 @@
int (*svt_clear)(SV* sv, MAGIC* mg);
int (*svt_free)(SV* sv, MAGIC* mg);
-This MGVTBL structure is set at compile-time in C<perl.h> and there are
+This MGVTBL structure is set at compile-time in F<perl.h> and there are
currently 19 types (or 21 with overloading turned on). These different
structures contain pointers to various routines that perform additional
actions depending on which function is being called.
@@ -1324,7 +1325,8 @@
and C<num> is the number of elements the stack should be extended by.
Now that there is room on the stack, values can be pushed on it using C<PUSHs>
-macro. The values pushed will often need to be "mortal" (See L</Reference Counts and
Mortality>).
+macro. The pushed values will often need to be "mortal" (See
+L</Reference Counts and Mortality>).
PUSHs(sv_2mortal(newSViv(an_integer)))
PUSHs(sv_2mortal(newSVpv("Some String",0)))
@@ -1394,6 +1396,8 @@
=head2 Memory Allocation
+=head3 Allocation
+
All memory meant to be used with the Perl API functions should be manipulated
using the macros described in this section. The macros provide the necessary
transparency between differences in the actual malloc implementation that is
@@ -1404,12 +1408,12 @@
order to satisfy allocation requests more quickly. However, on some
platforms, it may cause spurious malloc or free errors.
+The following three macros are used to initially allocate memory :
+
New(x, pointer, number, type);
Newc(x, pointer, number, type, cast);
Newz(x, pointer, number, type);
-These three macros are used to initially allocate memory.
-
The first argument C<x> was a "magic cookie" that was used to keep track
of who called the macro, to help when debugging memory problems. However,
the current code makes no use of this feature (most Perl developers now
@@ -1427,6 +1431,8 @@
Unlike the C<New> and C<Newc> macros, the C<Newz> macro calls C<memzero>
to zero out all the newly allocated memory.
+=head3 Reallocation
+
Renew(pointer, number, type);
Renewc(pointer, number, type, cast);
Safefree(pointer)
@@ -1436,6 +1442,8 @@
match those of C<New> and C<Newc> with the exception of not needing the
"magic cookie" argument.
+=head3 Moving
+
Move(source, dest, number, type);
Copy(source, dest, number, type);
Zero(dest, number, type);
@@ -1564,8 +1572,8 @@
=head2 Examining the tree
-If you have your perl compiled for debugging (usually done with C<-D
-optimize=-g> on C<Configure> command line), you may examine the
+If you have your perl compiled for debugging (usually done with
+C<-DDEBUGGING> on the C<Configure> command line), you may examine the
compiled tree by specifying C<-Dx> on the Perl command line. The
output takes several lines per node, and for C<$b+$c> it looks like
this:
@@ -1634,6 +1642,9 @@
optimization (see L</Compile pass 2: context propagation>) it will still
have children in accordance with its former type.
+Another way to examine the tree is to use a compiler back-end module, such
+as L<B::Concise>.
+
=head2 Compile pass 1: check routines
The tree is created by the compiler while I<yacc> code feeds it
@@ -2012,10 +2023,10 @@
=head1 Internal Functions
All of Perl's internal functions which will be exposed to the outside
-world are be prefixed by C<Perl_> so that they will not conflict with XS
+world are prefixed by C<Perl_> so that they will not conflict with XS
functions or functions used in a program in which Perl is embedded.
Similarly, all global variables begin with C<PL_>. (By convention,
-static functions start with C<S_>)
+static functions start with C<S_>.)
Inside the Perl core, you can get at the functions either with or
without the C<Perl_> prefix, thanks to a bunch of defines that live in
==== //depot/maint-5.8/perl/pod/perlre.pod#6 (text) ====
Index: perl/pod/perlre.pod
--- perl/pod/perlre.pod#5~18458~ Wed Jan 8 11:43:26 2003
+++ perl/pod/perlre.pod Wed Jun 18 22:24:45 2003
@@ -400,10 +400,14 @@
extended patterns (see below), for example to assign a submatch to a
variable.
-The numbered variables ($1, $2, $3, etc.) and the related punctuation
+The numbered match variables ($1, $2, $3, etc.) and the related punctuation
set (C<$+>, C<$&>, C<$`>, C<$'>, and C<$^N>) are all dynamically scoped
until the end of the enclosing block or until the next successful
match, whichever comes first. (See L<perlsyn/"Compound Statements">.)
+
+B<NOTE>: failed matches in Perl do not reset the match variables,
+which makes easier to write code that tests for a series of more
+specific cases and remembers the best match.
B<WARNING>: Once Perl sees that you need one of C<$&>, C<$`>, or
C<$'> anywhere in the program, it has to provide them for every
==== //depot/maint-5.8/perl/pod/perltrap.pod#4 (text) ====
Index: perl/pod/perltrap.pod
--- perl/pod/perltrap.pod#3~19567~ Sun May 18 22:01:26 2003
+++ perl/pod/perltrap.pod Wed Jun 18 22:24:45 2003
@@ -1224,6 +1224,10 @@
# perl4 prints: perl4
# perl5 prints: perl5
+=item * Regular Expression
+
+Unlike in Ruby, failed matches in Perl do not reset the match variables
+($1, $2, ..., C<$`>, ...).
=back
==== //depot/maint-5.8/perl/pp.c#22 (text) ====
Index: perl/pp.c
--- perl/pp.c#21~19515~ Tue May 13 10:51:05 2003
+++ perl/pp.c Wed Jun 18 22:24:45 2003
@@ -4679,13 +4679,13 @@
}
else {
maxiters += slen * rx->nparens;
- while (s < strend && --limit
-/* && (!rx->check_substr
- || ((s = CALLREG_INTUIT_START(aTHX_ rx, sv, s, strend,
- 0, NULL))))
-*/ && CALLREGEXEC(aTHX_ rx, s, strend, orig,
- 1 /* minend */, sv, NULL, 0))
+ while (s < strend && --limit)
{
+ PUTBACK;
+ i = CALLREGEXEC(aTHX_ rx, s, strend, orig, 1 , sv, NULL, 0);
+ SPAGAIN;
+ if (i == 0)
+ break;
TAINT_IF(RX_MATCH_TAINTED(rx));
if (RX_MATCH_COPIED(rx) && rx->subbeg != orig) {
m = s;
@@ -4724,7 +4724,6 @@
}
}
s = rx->endp[0] + orig;
- PUTBACK;
}
}
==== //depot/maint-5.8/perl/regexec.c#20 (text) ====
Index: perl/regexec.c
--- perl/regexec.c#19~19439~ Wed May 7 10:11:48 2003
+++ perl/regexec.c Wed Jun 18 22:24:45 2003
@@ -2821,6 +2821,7 @@
COP *ocurcop = PL_curcop;
PAD *old_comppad;
SV *ret;
+ struct regexp *oreg = PL_reg_re;
n = ARG(scan);
PL_op = (OP_4tree*)PL_regdata->data[n];
@@ -2953,8 +2954,10 @@
sw = SvTRUE(ret);
logical = 0;
}
- else
+ else {
sv_setsv(save_scalar(PL_replgv), ret);
+ cache_re(oreg);
+ }
break;
}
case OPEN:
==== //depot/maint-5.8/perl/t/op/pack.t#9 (xtext) ====
Index: perl/t/op/pack.t
--- perl/t/op/pack.t#8~19722~ Mon Jun 9 10:52:25 2003
+++ perl/t/op/pack.t Wed Jun 18 22:24:45 2003
@@ -183,6 +183,9 @@
skip "-- the IEEE infinity model is unavailable in this configuration."
if (($^O eq 'VMS') && !defined($Config{useieee}));
+ skip "-- MPE/iX has serious fp indigestionf on w-packed infinities"
+ if (($^O eq 'mpeix'));
+
my $inf = eval '2**10000';
skip "Couldn't generate infinity - got error '$@'"
==== //depot/maint-5.8/perl/t/op/pat.t#17 (xtext) ====
Index: perl/t/op/pat.t
--- perl/t/op/pat.t#16~19292~ Mon Apr 21 08:27:36 2003
+++ perl/t/op/pat.t Wed Jun 18 22:24:45 2003
@@ -6,7 +6,7 @@
$| = 1;
-print "1..998\n";
+print "1..1000\n";
BEGIN {
chdir 't' if -d 't';
@@ -3142,7 +3142,15 @@
{
my $i;
ok('-1-3-5-' eq join('', split /((??{$i++}))/, '-1-3-5-'),
- "[perl #21411] (??{ .. }) corrupts split's stack")
+ "[perl #21411] (??{ .. }) corrupts split's stack");
+ split /(?{'WOW'})/, 'abc';
+ ok('a|b|c' eq join ('|', @_),
+ "[perl #21411] (?{ .. }) version of the above");
+}
+
+{
+ split /(?{ split "" })/, "abc";
+ ok(1,'cache_re & "(?{": it dumps core in 5.6.1 & 5.8.0');
}
{
End of Patch.
