diff options
author | Tony Cook <tony@develop-help.com> | 2014-12-17 13:54:25 +1100 |
---|---|---|
committer | Tony Cook <tony@develop-help.com> | 2014-12-18 09:31:07 +1100 |
commit | 1d050e5534ce798acb8f9cd9c56c9f557ec658e0 (patch) | |
tree | a7a8984a6362dbdacef55c925e676666d46f9361 /ext | |
parent | 63d073d27fe50d823f0e3c528ac62c9aa584704d (diff) | |
download | perl-1d050e5534ce798acb8f9cd9c56c9f557ec658e0.tar.gz |
don't allow a negative file position on a PerlIO::scalar handle
previosly seek() would produce an error, but would still make the\
file position negative.
Diffstat (limited to 'ext')
-rw-r--r-- | ext/PerlIO-scalar/scalar.xs | 13 | ||||
-rw-r--r-- | ext/PerlIO-scalar/t/scalar.t | 9 |
2 files changed, 17 insertions, 5 deletions
diff --git a/ext/PerlIO-scalar/scalar.xs b/ext/PerlIO-scalar/scalar.xs index f130c0c318..9ccded57e4 100644 --- a/ext/PerlIO-scalar/scalar.xs +++ b/ext/PerlIO-scalar/scalar.xs @@ -103,28 +103,33 @@ IV PerlIOScalar_seek(pTHX_ PerlIO * f, Off_t offset, int whence) { PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar); + Off_t new_posn; switch (whence) { case SEEK_SET: - s->posn = offset; + new_posn = offset; break; case SEEK_CUR: - s->posn = offset + s->posn; + new_posn = offset + s->posn; break; case SEEK_END: { STRLEN oldcur; (void)SvPV(s->var, oldcur); - s->posn = offset + oldcur; + new_posn = offset + oldcur; break; } + default: + SETERRNO(EINVAL, SS_IVCHAN); + return -1; } - if (s->posn < 0) { + if (new_posn < 0) { if (ckWARN(WARN_LAYER)) Perl_warner(aTHX_ packWARN(WARN_LAYER), "Offset outside string"); SETERRNO(EINVAL, SS_IVCHAN); return -1; } + s->posn = new_posn; return 0; } diff --git a/ext/PerlIO-scalar/t/scalar.t b/ext/PerlIO-scalar/t/scalar.t index 547ecea100..f1156d67ec 100644 --- a/ext/PerlIO-scalar/t/scalar.t +++ b/ext/PerlIO-scalar/t/scalar.t @@ -16,7 +16,7 @@ use Fcntl qw(SEEK_SET SEEK_CUR SEEK_END); # Not 0, 1, 2 everywhere. $| = 1; -use Test::More tests => 118; +use Test::More tests => 120; my $fh; my $var = "aaa\n"; @@ -500,3 +500,10 @@ my $byte_warning = "Strings with code points over 0xFF may not be mapped into in is($tmp, "", "should have read nothing"); ok(eof($fh), "fh should be eof"); } + +{ + my $buf0 = "hello"; + open my $fh, "<", \$buf0 or die $!; + ok(!seek($fh, -10, SEEK_CUR), "seek to negative position"); + is(tell($fh), 0, "shouldn't change the position"); +} |