Include the name of the non-lvalue sub in error message

This makes the cause of the error more obvious if you accidentally call
a non-lvalue sub in the final position of an lvalue one.

4 files changed, 24 insertions, 14 deletions

diff --git a/op.c b/op.c
index 0d04858b5d..0c2af88c64 100644
--- a/op.c
+++ b/op.c
@@ -2792,6 +2792,7 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
 		OP *kid = cUNOPo->op_first;
 		CV *cv;
 		GV *gv;
+                SV *namesv;
 
 		if (kid->op_type != OP_PUSHMARK) {
 		    if (kid->op_type != OP_NULL || kid->op_targ != OP_LIST)
@@ -2829,6 +2830,15 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
 		    break;
 		if (CvLVALUE(cv))
 		    break;
+                if (flags & OP_LVALUE_NO_CROAK)
+                    return NULL;
+
+                namesv = cv_name(cv, NULL, 0);
+                yyerror_pv(Perl_form(aTHX_ "Can't modify non-lvalue "
+                                     "subroutine call of &%"SVf" in %s",
+                                     SVfARG(namesv), PL_op_desc[type]),
+                           SvUTF8(namesv));
+                return o;
 	    }
 	}
 	/* FALLTHROUGH */
@@ -2842,9 +2852,7 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
 	yyerror(Perl_form(aTHX_ "Can't modify %s in %s",
 		     (o->op_type == OP_NULL && (o->op_flags & OPf_SPECIAL)
 		      ? "do block"
-		      : (o->op_type == OP_ENTERSUB
-			? "non-lvalue subroutine call"
-			: OP_DESC(o))),
+		      : OP_DESC(o)),
 		     type ? PL_op_desc[type] : "local"));
 	return o;
 
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index db218610fa..d40b09351f 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -1108,7 +1108,7 @@ to change it, such as with an auto-increment.
 (P) The internal routine that does assignment to a substr() was handed
 a NULL.
 
-=item Can't modify non-lvalue subroutine call
+=item Can't modify non-lvalue subroutine call of &%s
 
 (F) Subroutines meant to be used in lvalue context should be declared as
 such.  See L<perlsub/"Lvalue subroutines">.
diff --git a/pp_hot.c b/pp_hot.c
index d05e03fd13..9ac606665f 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -3427,7 +3427,8 @@ PP(pp_entersub)
 	SAVETMPS;
 	if (UNLIKELY((cx->blk_u16 & OPpENTERSUB_LVAL_MASK) == OPpLVAL_INTRO &&
 	    !CvLVALUE(cv)))
-	    DIE(aTHX_ "Can't modify non-lvalue subroutine call");
+            DIE(aTHX_ "Can't modify non-lvalue subroutine call of &%"SVf,
+                SVfARG(cv_name(cv, NULL, 0)));
 	/* warning must come *after* we fully set up the context
 	 * stuff so that __WARN__ handlers can safely dounwind()
 	 * if they want to
@@ -3448,7 +3449,8 @@ PP(pp_entersub)
 	       & PUSHSUB_GET_LVALUE_MASK(Perl_is_lvalue_sub)
              ) & OPpENTERSUB_LVAL_MASK) == OPpLVAL_INTRO &&
 	    !CvLVALUE(cv)))
-	    DIE(aTHX_ "Can't modify non-lvalue subroutine call");
+            DIE(aTHX_ "Can't modify non-lvalue subroutine call of &%"SVf,
+                SVfARG(cv_name(cv, NULL, 0)));
 
 	if (UNLIKELY(!hasargs && GvAV(PL_defgv))) {
 	    /* Need to copy @_ to stack. Alternative may be to
diff --git a/t/op/sub_lval.t b/t/op/sub_lval.t
index ab9faac1cd..f70e6fe373 100644
--- a/t/op/sub_lval.t
+++ b/t/op/sub_lval.t
@@ -169,7 +169,7 @@ eval <<'EOE' or $_ = $@;
   1;
 EOE
 
-like($_, qr/Can\'t modify non-lvalue subroutine call in scalar assignment/);
+like($_, qr/Can\'t modify non-lvalue subroutine call of &main::nolv in scalar assignment/);
 
 $_ = '';
 
@@ -178,7 +178,7 @@ eval <<'EOE' or $_ = $@;
   1;
 EOE
 
-like($_, qr/Can\'t modify non-lvalue subroutine call in scalar assignment/);
+like($_, qr/Can\'t modify non-lvalue subroutine call of &main::nolv in scalar assignment/);
 
 $_ = '';
 
@@ -187,7 +187,7 @@ eval <<'EOE' or $_ = $@;
   1;
 EOE
 
-like($_, qr/Can\'t modify non-lvalue subroutine call in scalar assignment/);
+like($_, qr/Can\'t modify non-lvalue subroutine call of &main::nolv in scalar assignment/);
 
 $x0 = $x1 = $_ = undef;
 $nolv = \&nolv;
@@ -358,7 +358,7 @@ eval <<'EOE' or $_ = $@;
   1;
 EOE
 
-like($_, qr/Can\'t modify non-lvalue subroutine call at /);
+like($_, qr/Can\'t modify non-lvalue subroutine call of &main::xxx at /);
 
 $_ = undef;
 eval <<'EOE' or $_ = $@;
@@ -366,7 +366,7 @@ eval <<'EOE' or $_ = $@;
   1;
 EOE
 
-like($_, qr/Can\'t modify non-lvalue subroutine call at /);
+like($_, qr/Can\'t modify non-lvalue subroutine call of &main::xxx at /);
 
 sub yyy () { 'yyy' } # Const, not lvalue
 
@@ -823,7 +823,7 @@ foo = 3;
 ----
 lvalue attribute ignored after the subroutine has been defined at - line 4.
 lvalue attribute ignored after the subroutine has been defined at - line 6.
-Can't modify non-lvalue subroutine call in scalar assignment at - line 7, near "3;"
+Can't modify non-lvalue subroutine call of &main::foo in scalar assignment at - line 7, near "3;"
 Execution of - aborted due to compilation errors.
 ====
 }
@@ -979,7 +979,7 @@ package _102486 {
       'sub:lvalue{&$x}->() does not die for non-lvalue inner sub call';
   ::is $called, 1, 'The &$x actually called the sub';
   eval { +sub :lvalue { &$x }->() = 3 };
-  ::like $@, qr/^Can't modify non-lvalue subroutine call at /,
+  ::like $@, qr/^Can't modify non-lvalue subroutine call of &_102486::nonlv at /,
         'sub:lvalue{&$x}->() dies in true lvalue context';
 }
 
@@ -1008,7 +1008,7 @@ for (sub : lvalue { "$x" }->()) {
 
 # [perl #117947] XSUBs should not be treated as lvalues at run time
 eval { &{\&utf8::is_utf8}("") = 3 };
-like $@, qr/^Can't modify non-lvalue subroutine call at /,
+like $@, qr/^Can't modify non-lvalue subroutine call of &utf8::is_utf8 at /,
         'XSUB not seen at compile time dies in lvalue context';
 
 # [perl #119797] else implicitly returning value