Change 18581 by ams@lustre on 2003/01/26 05:29:40
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/perl/pp_sys.c#330 edit
... //depot/perl/t/io/fs.t#51 edit
Differences ...
==== //depot/perl/pp_sys.c#330 (text) ====
Index: perl/pp_sys.c
--- perl/pp_sys.c#329~18504~ Fri Jan 17 05:21:51 2003
+++ perl/pp_sys.c Sat Jan 25 21:29:40 2003
@@ -2031,22 +2031,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 {
@@ -2055,11 +2064,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/perl/t/io/fs.t#51 (xtext) ====
Index: perl/t/io/fs.t
--- perl/t/io/fs.t#50~16399~ Sat May 4 10:00:58 2002
+++ perl/t/io/fs.t Sat Jan 25 21:29:40 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.
