Skip to content

Commit

Permalink
[perl #62646] Maximum string length with substr
Browse files Browse the repository at this point in the history
(This is only a partial fix, since it doesn't handle lvalue substr)
  • Loading branch information
Zefram authored and rgs committed Jan 15, 2010
1 parent 75080c8 commit b6d1426
Show file tree
Hide file tree
Showing 2 changed files with 23 additions and 8 deletions.
14 changes: 7 additions & 7 deletions pp.c
Expand Up @@ -3079,12 +3079,12 @@ PP(pp_substr)
{
dVAR; dSP; dTARGET;
SV *sv;
I32 len = 0;
IV len = 0;
STRLEN curlen;
STRLEN utf8_curlen;
I32 pos;
I32 rem;
I32 fail;
IV pos;
IV rem;
IV fail;
const I32 lvalue = PL_op->op_flags & OPf_MOD || LVRET;
const char *tmps;
const I32 arybase = CopARYBASE_get(PL_curcop);
Expand Down Expand Up @@ -3147,7 +3147,7 @@ PP(pp_substr)
rem = curlen;
else if (len >= 0) {
rem = pos+len;
if (rem > (I32)curlen)
if (rem > (IV)curlen)
rem = curlen;
}
else {
Expand All @@ -3167,8 +3167,8 @@ PP(pp_substr)
RETPUSHUNDEF;
}
else {
const I32 upos = pos;
const I32 urem = rem;
const IV upos = pos;
const IV urem = rem;
if (utf8_curlen)
sv_pos_u2b(sv, &pos, &rem);
tmps += pos;
Expand Down
17 changes: 16 additions & 1 deletion t/re/substr.t
Expand Up @@ -24,7 +24,7 @@ $SIG{__WARN__} = sub {

require './test.pl';

plan(334);
plan(338);

run_tests() unless caller;

Expand Down Expand Up @@ -682,4 +682,19 @@ is($x, "\x{100}\x{200}\xFFb");
is(substr($a,1,1), 'b');
}

# [perl #62646] offsets exceeding 32 bits on 64-bit system
SKIP: {
skip("32-bit system", 4) unless ~0 > 0xffffffff;
my $a = "abc";
my $r;
$w = 0;
$r = substr($a, 0xffffffff, 1);
is($r, undef);
is($w, 1);
$w = 0;
$r = substr($a, 0xffffffff+1, 1);
is($r, undef);
is($w, 1);
}

}

0 comments on commit b6d1426

Please sign in to comment.