Change 18582 by jhi@kosh on 2003/01/26 08:30:37
Integrate:
[ 18579]
Subject: Re: [perl #20408] SV's SvPVX get freed even when its SvLEN is zero
From: Enache Adrian <[EMAIL PROTECTED]>
Date: Sun, 26 Jan 2003 04:55:48 +0200
Message-Id: <[EMAIL PROTECTED]>
[ 18580]
Subject: patch to speed up Perl's slurp mode
From: Enache Adrian <[EMAIL PROTECTED]>
Date: Fri, 24 Jan 2003 06:23:54 +0200
Message-Id: <[EMAIL PROTECTED]>
[ 18581]
Subject: Re: truncate using a globref
From: Slaven Rezic <[EMAIL PROTECTED]>
Date: Thu, 23 Jan 2003 15:48:52 +0100 (CET)
Message-Id: <[EMAIL PROTECTED]>
Affected files ...
... //depot/maint-5.8/perl/ext/Storable/Storable.xs#6 integrate
... //depot/maint-5.8/perl/pp_ctl.c#7 integrate
... //depot/maint-5.8/perl/pp_sys.c#11 integrate
... //depot/maint-5.8/perl/sv.c#21 edit
... //depot/maint-5.8/perl/t/io/fs.t#2 integrate
Differences ...
==== //depot/maint-5.8/perl/ext/Storable/Storable.xs#6 (text) ====
Index: perl/ext/Storable/Storable.xs
--- perl/ext/Storable/Storable.xs#5~18563~ Wed Jan 22 10:03:40 2003
+++ perl/ext/Storable/Storable.xs Sun Jan 26 00:30:37 2003
@@ -3369,7 +3369,7 @@
length -= sizeof (magicstr) - 1;
}
- WRITE(header, length);
+ WRITE( (unsigned char*) header, length);
if (!cxt->netorder) {
TRACEME(("ok (magic_write byteorder = 0x%lx [%d], I%d L%d P%d D%d)",
==== //depot/maint-5.8/perl/pp_ctl.c#7 (text) ====
Index: perl/pp_ctl.c
--- perl/pp_ctl.c#6~18414~ Fri Jan 3 08:39:33 2003
+++ perl/pp_ctl.c Sun Jan 26 00:30:37 2003
@@ -182,7 +182,8 @@
cx->sb_rxtainted |= RX_MATCH_TAINTED(rx);
(void)SvOOK_off(targ);
- Safefree(SvPVX(targ));
+ if (SvLEN(targ))
+ Safefree(SvPVX(targ));
SvPVX(targ) = SvPVX(dstr);
SvCUR_set(targ, SvCUR(dstr));
SvLEN_set(targ, SvLEN(dstr));
==== //depot/maint-5.8/perl/pp_sys.c#11 (text) ====
Index: perl/pp_sys.c
--- perl/pp_sys.c#10~18505~ Fri Jan 17 05:36:55 2003
+++ perl/pp_sys.c Sun Jan 26 00:30:37 2003
@@ -2035,22 +2035,31 @@
STRLEN n_a;
int result = 1;
GV *tmpgv;
-
+ IO *io;
+
if (PL_op->op_flags & OPf_SPECIAL) {
tmpgv = gv_fetchpv(POPpx, FALSE, SVt_PVIO);
- do_ftruncate:
- TAINT_PROPER("truncate");
- if (!GvIO(tmpgv) || !IoIFP(GvIOp(tmpgv)))
- result = 0;
+ do_ftruncate_gv:
+ if (!GvIO(tmpgv))
+ result = 0;
else {
- PerlIO_flush(IoIFP(GvIOp(tmpgv)));
+ PerlIO *fp;
+ io = GvIOp(tmpgv);
+ do_ftruncate_io:
+ TAINT_PROPER("truncate");
+ if (!(fp = IoIFP(io))) {
+ result = 0;
+ }
+ else {
+ PerlIO_flush(fp);
#ifdef HAS_TRUNCATE
- if (ftruncate(PerlIO_fileno(IoIFP(GvIOn(tmpgv))), len) < 0)
+ if (ftruncate(PerlIO_fileno(fp), len) < 0)
#else
- if (my_chsize(PerlIO_fileno(IoIFP(GvIOn(tmpgv))), len) < 0)
+ if (my_chsize(PerlIO_fileno(fp), len) < 0)
#endif
- result = 0;
+ result = 0;
+ }
}
}
else {
@@ -2059,11 +2068,15 @@
if (SvTYPE(sv) == SVt_PVGV) {
tmpgv = (GV*)sv; /* *main::FRED for example */
- goto do_ftruncate;
+ goto do_ftruncate_gv;
}
else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV) {
tmpgv = (GV*) SvRV(sv); /* \*main::FRED for example */
- goto do_ftruncate;
+ goto do_ftruncate_gv;
+ }
+ else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVIO) {
+ io = (IO*) SvRV(sv); /* *main::FRED{IO} for example */
+ goto do_ftruncate_io;
}
name = SvPV(sv, n_a);
==== //depot/maint-5.8/perl/sv.c#21 (text) ====
Index: perl/sv.c
--- perl/sv.c#20~18564~ Wed Jan 22 10:07:19 2003
+++ perl/sv.c Sun Jan 26 00:30:37 2003
@@ -5951,11 +5951,13 @@
register I32 cnt;
I32 i = 0;
I32 rspara = 0;
+ I32 recsize;
SV_CHECK_THINKFIRST(sv);
(void)SvUPGRADE(sv, SVt_PV);
SvSCREAM_off(sv);
+ SvPOK_only(sv); /* Validate pointer */
if (PL_curcop == &PL_compiling) {
/* we always read code in line mode */
@@ -5963,17 +5965,22 @@
rslen = 1;
}
else if (RsSNARF(PL_rs)) {
+ Stat_t st;
+ if (!PerlLIO_fstat(PerlIO_fileno(fp), &st) && st.st_size
+ && (recsize = st.st_size - PerlIO_tell(fp)))
+ goto read_record;
rsptr = NULL;
rslen = 0;
}
else if (RsRECORD(PL_rs)) {
- I32 recsize, bytesread;
+ I32 bytesread;
char *buffer;
/* Grab the size of the record we're getting */
recsize = SvIV(SvRV(PL_rs));
- (void)SvPOK_only(sv); /* Validate pointer */
- buffer = SvGROW(sv, (STRLEN)(recsize + 1));
+
+ read_record:
+ buffer = SvGROW(sv, (STRLEN)(recsize + append + 1)) + append;
/* Go yank in */
#ifdef VMS
/* VMS wants read instead of fread, because fread doesn't respect */
@@ -5983,13 +5990,9 @@
#else
bytesread = PerlIO_read(fp, buffer, recsize);
#endif
- SvCUR_set(sv, bytesread);
+ SvCUR_set(sv, bytesread += append);
buffer[bytesread] = '\0';
- if (PerlIO_isutf8(fp))
- SvUTF8_on(sv);
- else
- SvUTF8_off(sv);
- return(SvCUR(sv) ? SvPVX(sv) : Nullch);
+ goto check_utf8_and_return;
}
else if (RsPARA(PL_rs)) {
rsptr = "\n\n";
@@ -6058,7 +6061,6 @@
/* Here is some breathtakingly efficient cheating */
cnt = PerlIO_get_cnt(fp); /* get count into register */
- (void)SvPOK_only(sv); /* validate pointer */
if ((I32)(SvLEN(sv) - append) <= cnt + 1) { /* make sure we have the room */
if (cnt > 80 && (I32)SvLEN(sv) > append) {
shortbuffered = cnt - SvLEN(sv) + append + 1;
@@ -6238,6 +6240,7 @@
}
}
+check_utf8_and_return:
if (PerlIO_isutf8(fp))
SvUTF8_on(sv);
else
==== //depot/maint-5.8/perl/t/io/fs.t#2 (xtext) ====
Index: perl/t/io/fs.t
--- perl/t/io/fs.t#1~17645~ Fri Jul 19 12:29:57 2002
+++ perl/t/io/fs.t Sun Jan 26 00:30:37 2003
@@ -47,7 +47,7 @@
my $skip_mode_checks =
$^O eq 'cygwin' && $ENV{CYGWIN} !~ /ntsec/;
-plan tests => 32;
+plan tests => 34;
if (($^O eq 'MSWin32') || ($^O eq 'NetWare')) {
@@ -271,7 +271,7 @@
# Check truncating a closed file.
eval { truncate "Iofs.tmp", 5; };
- skip("no truncate - $@", 6) if $@;
+ skip("no truncate - $@", 8) if $@;
is(-s "Iofs.tmp", 5, "truncation to five bytes");
@@ -303,21 +303,44 @@
close (FH); open (FH, ">>Iofs.tmp") or die "Can't reopen Iofs.tmp";
}
- if ($^O eq 'vos') {
- skip ("# TODO - hit VOS bug posix-973 - cannot resize an open file below the
current file pos.", 3);
- }
+ SKIP: {
+ if ($^O eq 'vos') {
+ skip ("# TODO - hit VOS bug posix-973 - cannot resize an open file below
+the current file pos.", 5);
+ }
- is(-s "Iofs.tmp", 200, "fh resize to 200 working (filename check)");
+ is(-s "Iofs.tmp", 200, "fh resize to 200 working (filename check)");
- ok(truncate(FH, 0), "fh resize to zero");
+ ok(truncate(FH, 0), "fh resize to zero");
- if ($needs_fh_reopen) {
- close (FH); open (FH, ">>Iofs.tmp") or die "Can't reopen Iofs.tmp";
- }
+ if ($needs_fh_reopen) {
+ close (FH); open (FH, ">>Iofs.tmp") or die "Can't reopen Iofs.tmp";
+ }
- ok(-z "Iofs.tmp", "fh resize to zero working (filename check)");
+ ok(-z "Iofs.tmp", "fh resize to zero working (filename check)");
- close FH;
+ close FH;
+
+ open(FH, ">>Iofs.tmp") or die "Can't open Iofs.tmp for appending";
+
+ binmode FH;
+ select FH;
+ $| = 1;
+ select STDOUT;
+
+ {
+ use strict;
+ print FH "x\n" x 200;
+ ok(truncate(*FH{IO}, 100), "fh resize by IO slot");
+ }
+
+ if ($needs_fh_reopen) {
+ close (FH); open (FH, ">>Iofs.tmp") or die "Can't reopen Iofs.tmp";
+ }
+
+ is(-s "Iofs.tmp", 100, "fh resize by IO slot working");
+
+ close FH;
+ }
}
# check if rename() can be used to just change case of filename
End of Patch.
