OP_SUBSTR_LEFT - a specialised OP_SUBSTR variant

MANIFEST

@@ -6439,6 +6439,7 @@ t/op/studytied.t			See if study works with tied scalars
 t/op/sub.t				See if subroutines work
 t/op/sub_lval.t				See if lvalue subroutines work
 t/op/substr.t				See if substr works
+t/op/substr_left.t			See if substr($x, 0, $l, '') optimisation works
 t/op/substr_thr.t			See if substr works in another thread
 t/op/svflags.t				See if POK is set as expected.
 t/op/svleak.pl				Test file for svleak.t

ext/Opcode/Opcode.pm

@@ -322,7 +322,8 @@ invert_opset function.
     slt sgt sle sge seq sne scmp
     isa
 
-    substr vec stringify study pos length index rindex ord chr
+    substr substr_left vec stringify study pos length index
+    rindex ord chr
 
     ucfirst lcfirst uc lc fc quotemeta trans transr chop schop
     chomp schomp

lib/B/Deparse.pm

@@ -3436,6 +3436,25 @@ sub pp_substr {
     maybe_local(@_, listop(@_, "substr"))
 }
 
+sub pp_substr_left {
+    my ($self,$op,$cx) = @_;
+
+   my $lex  = ($op->private & OPpTARGET_MY);
+
+   my $val = 'substr(' . $self->deparse($op->first->sibling, $cx)
+             . ', 0, ' . $self->deparse($op->first->sibling->sibling->sibling, $cx)
+             . ( (($op->private & 7) == 3) ? '' : ", '')" );
+
+    if ($lex) {
+        my $targ = $op->targ;
+        my $var = $self->maybe_my($op, $cx, $self->padname($op->targ),
+            $self->padname_sv($targ),
+            0);
+        $val = $self->maybe_parens("$var = $val", $cx, 7);
+    }
+    $val;
+}
+
 sub pp_index {
     # Also handles pp_rindex.
     #

lib/B/Deparse.t

@@ -1770,6 +1770,14 @@ print sort(foo('bar'));
 substr(my $a, 0, 0) = (foo(), bar());
 $a++;
 ####
+# 4-arg substr (non-chop)
+my $str = 'ABCD';
+my $bbb = substr($str, 1, 1, '');
+####
+# 4-arg substr (chop)
+my $str = 'ABCD';
+my $aaa = substr($str, 0, 1, '');
+####
 # This following line works around an unfixed bug that we are not trying to 
 # test for here:
 # CONTEXT BEGIN { $^H{a} = "b"; delete $^H{a} } # make %^H localised