From: Perl 5 Porters <perl5-porters@africa.nicoh.com>
Date: Wed, 28 Aug 1996 02:51:28 +0000 (+0000)
Subject: Re: truncate with file name does not work (with patch)
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f783569bc3d9005f69b42948872f9ac61fdd46fb;p=p5sagit%2Fp5-mst-13.2.git

Re: truncate with file name does not work (with patch)

The prototype for truncate was changed so that perl won't die
with C<use strict;> when the first arg is a bareword (filehandle).
I think it was Tom (as in "tchrist") who brought this up.

Here's a patch that undoes the damage, makes it work with
C<use strict;>, and adds to the testsuite.

The "not implemented" branch is missing a "\n".
---

diff --git a/t/io/fs.t b/t/io/fs.t
index a219b81..87a3d2f 100755
--- a/t/io/fs.t
+++ b/t/io/fs.t
@@ -2,7 +2,7 @@
 
 # $RCSfile: fs.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:28 $
 
-print "1..22\n";
+print "1..26\n";
 
 $wd = `pwd`;
 chop($wd);
@@ -83,3 +83,27 @@ if (`ls -l perl 2>/dev/null` =~ /^l.*->/) {  # we have symbolic links
 else {
     print "ok 21\nok 22\n";
 }
+
+# truncate (may not be implemented everywhere)
+unlink "Iofs.tmp";
+`echo helloworld > Iofs.tmp`;
+eval { truncate "Iofs.tmp", 5; };
+if ($@ =~ /not implemented/) {
+  print "# truncate not implemented -- skipping tests 23 through 26\n";
+  for (23 .. 26) {
+    print "ok $_\n";
+  }
+}
+else {
+  if (-s "Iofs.tmp" == 5) {print "ok 23\n"} else {print "not ok 23\n"}
+  truncate "Iofs.tmp", 0;
+  if (-z "Iofs.tmp") {print "ok 24\n"} else {print "not ok 24\n"}
+  `echo helloworld > Iofs.tmp`;
+  open(FH, ">Iofs.tmp") or die "Can't create Iofs.tmp";
+  truncate FH, 5;
+  if (-s "Iofs.tmp" == 5) {print "ok 25\n"} else {print "not ok 25\n"}
+  truncate FH, 0;
+  if (-z "Iofs.tmp") {print "ok 26\n"} else {print "not ok 26\n"}
+  close FH;
+}
+unlink "Iofs.tmp";