Pure Perl lvalue subs can't return temps, even if they are magical. This holds back a fix for RT#67838. Adds TODO tests.

3 files changed, 75 insertions, 1 deletions

diff --git a/ext/XS-APItest/APItest.pm b/ext/XS-APItest/APItest.pm
index 73db4a518e..05546ff41c 100644
--- a/ext/XS-APItest/APItest.pm
+++ b/ext/XS-APItest/APItest.pm
@@ -27,7 +27,7 @@ our @EXPORT = qw( print_double print_int print_long
 		  sv_count
 );
 
-our $VERSION = '0.19';
+our $VERSION = '0.20';
 
 use vars '$WARNINGS_ON_BOOTSTRAP';
 use vars map "\$${_}_called_PP", qw(BEGIN UNITCHECK CHECK INIT END);
diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs
index 9e5ebe8ec4..8dce9db805 100644
--- a/ext/XS-APItest/APItest.xs
+++ b/ext/XS-APItest/APItest.xs
@@ -653,6 +653,29 @@ sub CLEAR    { %{$_[0]} = () }
 
 =cut
 
+
+MODULE = XS::APItest:TempLv		PACKAGE = XS::APItest::TempLv
+
+void
+make_temp_mg_lv(sv)
+SV* sv
+    PREINIT:
+	SV * const lv = newSV_type(SVt_PVLV);
+	STRLEN len;
+    PPCODE:
+        SvPV(sv, len);
+
+	sv_magic(lv, NULL, PERL_MAGIC_substr, NULL, 0);
+	LvTYPE(lv) = 'x';
+	LvTARG(lv) = SvREFCNT_inc_simple(sv);
+	LvTARGOFF(lv) = len == 0 ? 0 : 1;
+	LvTARGLEN(lv) = len < 2 ? 0 : len-2;
+
+	EXTEND(SP, 1);
+	ST(0) = sv_2mortal(lv);
+	XSRETURN(1);
+
+
 MODULE = XS::APItest::PtrTable	PACKAGE = XS::APItest::PtrTable PREFIX = ptr_table_
 
 void
@@ -1137,3 +1160,17 @@ peep_record_clear ()
         dMY_CXT;
     CODE:
         av_clear(MY_CXT.peep_record);
+
+BOOT:
+	{
+	HV* stash;
+	SV** meth = NULL;
+	CV* cv;
+	stash = gv_stashpv("XS::APItest::TempLv", 0);
+	if (stash)
+	    meth = hv_fetchs(stash, "make_temp_mg_lv", 0);
+	if (!meth)
+	    croak("lost method 'make_temp_mg_lv'");
+	cv = GvCV(*meth);
+	CvLVALUE_on(cv);
+	}
diff --git a/ext/XS-APItest/t/temp_lv_sub.t b/ext/XS-APItest/t/temp_lv_sub.t
new file mode 100644
index 0000000000..bfcacd60df
--- /dev/null
+++ b/ext/XS-APItest/t/temp_lv_sub.t
@@ -0,0 +1,37 @@
+#!perl -w
+
+BEGIN {
+  push @INC, "::lib:$MacPerl::Architecture:" if $^O eq 'MacOS';
+  require Config; import Config;
+  if ($Config{'extensions'} !~ /\bXS\/APItest\b/) {
+    # Look, I'm using this fully-qualified variable more than once!
+    my $arch = $MacPerl::Architecture;
+    print "1..0 # Skip: XS::APItest was not built\n";
+    exit 0;
+  }
+}
+
+use strict;
+use utf8;
+use Test::More tests => 5;
+
+BEGIN {use_ok('XS::APItest')};
+
+sub make_temp_mg_lv :lvalue {  XS::APItest::TempLv::make_temp_mg_lv($_[0]); }
+
+{
+    my $x = "[]";
+    eval { XS::APItest::TempLv::make_temp_mg_lv($x) = "a"; };
+    is($@, '',    'temp mg lv from xs exception check');
+    is($x, '[a]', 'temp mg lv from xs success');
+}
+
+{
+    local $TODO = "PP lvalue sub can't return magical temp";
+    my $x = "{}";
+    eval { make_temp_mg_lv($x) = "b"; };
+    is($@, '',    'temp mg lv from pp exception check');
+    is($x, '{b}', 'temp mg lv from pp success');
+}
+
+1;