This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
sv.c, rs.t, perlvar.pod (Coverity finding: did you know what happens with $/=\0?)
authorJarkko Hietaniemi <jhi@iki.fi>
Sat, 8 Apr 2006 18:25:33 +0000 (21:25 +0300)
committerNicholas Clark <nick@ccl4.org>
Sat, 8 Apr 2006 22:23:26 +0000 (22:23 +0000)
Message-Id: <20060408152533.C4D5F6D08C@ugli.hut.fi>

(although I should add that this version of Coverity is actually
raising a false positive here, albeit something still interesting)

p4raw-id: //depot/perl@27744

pod/perlvar.pod
sv.c
t/base/rs.t

index 24db295..e8a38cb 100644 (file)
@@ -374,7 +374,8 @@ will read a record of no more than 32768 bytes from FILE.  If you're
 not reading from a record-oriented file (or your OS doesn't have
 record-oriented files), then you'll likely get a full chunk of data
 with every read.  If a record is larger than the record size you've
-set, you'll get the record back in pieces.
+set, you'll get the record back in pieces.  Trying to set the record
+size to zero or less will cause reading in the (rest of the) whole file.
 
 On VMS, record reads are done with the equivalent of C<sysread>,
 so it's best not to mix record and non-record reads on the same
diff --git a/sv.c b/sv.c
index d52b985..797777b 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -6188,7 +6188,6 @@ Perl_sv_gets(pTHX_ register SV *sv, register PerlIO *fp, I32 append)
     register I32 cnt;
     I32 i = 0;
     I32 rspara = 0;
-    I32 recsize;
 
     if (SvTHINKFIRST(sv))
        sv_force_normal_flags(sv, append ? 0 : SV_COW_DROP_PV);
@@ -6229,9 +6228,9 @@ Perl_sv_gets(pTHX_ register SV *sv, register PerlIO *fp, I32 append)
     }
     else if (RsSNARF(PL_rs)) {
        /* If it is a regular disk file use size from stat() as estimate
-          of amount we are going to read - may result in malloc-ing
-          more memory than we realy need if layers bellow reduce
-          size we read (e.g. CRLF or a gzip layer)
+          of amount we are going to read -- may result in mallocing
+          more memory than we really need if the layers below reduce
+          the size we read (e.g. CRLF or a gzip layer).
         */
        Stat_t st;
        if (!PerlLIO_fstat(PerlIO_fileno(fp), &st) && S_ISREG(st.st_mode))  {
@@ -6246,9 +6245,10 @@ Perl_sv_gets(pTHX_ register SV *sv, register PerlIO *fp, I32 append)
     else if (RsRECORD(PL_rs)) {
       I32 bytesread;
       char *buffer;
+      U32 recsize;
 
       /* Grab the size of the record we're getting */
-      recsize = SvIV(SvRV(PL_rs));
+      recsize = SvUV(SvRV(PL_rs)); /* RsRECORD() guarantees > 0. */
       buffer = SvGROW(sv, (STRLEN)(recsize + append + 1)) + append;
       /* Go yank in */
 #ifdef VMS
index f89c84e..d06fa73 100755 (executable)
@@ -1,7 +1,7 @@
 #!./perl
 # Test $!
 
-print "1..16\n";
+print "1..17\n";
 
 $teststring = "1\n12\n123\n1234\n1234\n12345\n\n123456\n1234567\n";
 
@@ -86,6 +86,11 @@ $/ = \$foo;
 $bar = <TESTFILE>;
 if ($bar eq "78") {print "ok 10\n";} else {print "not ok 10\n";}
 
+# Naughty straight number - should get the rest of the file
+$/ = \0;
+$bar = <TESTFILE>;
+if ($bar eq "90123456789012345678901234567890") {print "ok 11\n";} else {print "not ok 11\n";}
+
 close TESTFILE;
 
 # Now for the tricky bit--full record reading
@@ -110,23 +115,23 @@ if ($^O eq 'VMS') {
   open TESTFILE, "<./foo.bar";
   $/ = \10;
   $bar = <TESTFILE>;
-  if ($bar eq "foo\n") {print "ok 11\n";} else {print "not ok 11\n";}
+  if ($bar eq "foo\n") {print "ok 12\n";} else {print "not ok 12\n";}
   $bar = <TESTFILE>;
-  if ($bar eq "foobar\n") {print "ok 12\n";} else {print "not ok 12\n";}
+  if ($bar eq "foobar\n") {print "ok 13\n";} else {print "not ok 13\n";}
   # can we do a short read?
   $/ = \2;
   $bar = <TESTFILE>;
-  if ($bar eq "ba") {print "ok 13\n";} else {print "not ok 13\n";}
+  if ($bar eq "ba") {print "ok 14\n";} else {print "not ok 14\n";}
   # do we get the rest of the record?
   $bar = <TESTFILE>;
-  if ($bar eq "z\n") {print "ok 14\n";} else {print "not ok 14\n";}
+  if ($bar eq "z\n") {print "ok 15\n";} else {print "not ok 15\n";}
 
   close TESTFILE;
   1 while unlink qw(foo.bar foo.com foo.fdl);
 } else {
   # Nobody else does this at the moment (well, maybe OS/390, but they can
   # put their own tests in) so we just punt
-  foreach $test (11..14) {print "ok $test # skipped on non-VMS system\n"};
+  foreach $test (12..15) {print "ok $test # skipped on non-VMS system\n"};
 }
 
 $/ = "\n";
@@ -142,7 +147,7 @@ $/ = "\n";
     else {
        print "not ";
     }
-    print "ok 15\n";
+    print "ok 16\n";
 }
 
 {
@@ -155,7 +160,7 @@ $/ = "\n";
     else {
        print "not ";
     }
-    print "ok 16\n";
+    print "ok 17\n";
 }
 
 # Get rid of the temp file