diff options
| -rw-r--r-- | MANIFEST | 1 | ||||
| -rw-r--r-- | ext/XS-APItest/APItest.pm | 5 | ||||
| -rw-r--r-- | ext/XS-APItest/APItest.xs | 11 | ||||
| -rw-r--r-- | ext/XS-APItest/t/lvalue.t | 28 |
4 files changed, 44 insertions, 1 deletions
@@ -3646,6 +3646,7 @@ ext/XS-APItest/t/labelconst.aux auxiliary file for label test ext/XS-APItest/t/labelconst.t test recursive descent label parsing ext/XS-APItest/t/loopblock.t test recursive descent block parsing ext/XS-APItest/t/looprest.t test recursive descent statement-sequence parsing +ext/XS-APItest/t/lvalue.t Test XS lvalue functions ext/XS-APItest/t/magic_chain.t test low-level MAGIC chain handling ext/XS-APItest/t/magic.t test attaching, finding, and removing magic ext/XS-APItest/t/Markers.pm Helper for ./blockhooks.t diff --git a/ext/XS-APItest/APItest.pm b/ext/XS-APItest/APItest.pm index 5ef9ea2771..c6ae3023e7 100644 --- a/ext/XS-APItest/APItest.pm +++ b/ext/XS-APItest/APItest.pm @@ -50,7 +50,7 @@ sub import { } } -our $VERSION = '0.28'; +our $VERSION = '0.29'; use vars '$WARNINGS_ON_BOOTSTRAP'; use vars map "\$${_}_called_PP", qw(BEGIN UNITCHECK CHECK INIT END); @@ -94,6 +94,9 @@ if ($WARNINGS_ON_BOOTSTRAP) { XSLoader::load(); } +# This XS function needs the lvalue attr applied. +eval 'use attributes __PACKAGE__, \\&lv_temp_object, "lvalue"; 1' or die; + 1; __END__ diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs index 4fa4e1ec63..b9f4a67909 100644 --- a/ext/XS-APItest/APItest.xs +++ b/ext/XS-APItest/APItest.xs @@ -2781,6 +2781,17 @@ BOOT: cv_set_call_checker(asscv, THX_ck_entersub_postinc, (SV*)asscv); } +SV * +lv_temp_object() +CODE: + RETVAL = + sv_bless( + newRV_noinc(newSV(0)), + gv_stashpvs("XS::APItest::TempObj",GV_ADD) + ); /* Package defined in test script */ +OUTPUT: + RETVAL + MODULE = XS::APItest PACKAGE = XS::APItest::Magic PROTOTYPES: DISABLE diff --git a/ext/XS-APItest/t/lvalue.t b/ext/XS-APItest/t/lvalue.t new file mode 100644 index 0000000000..718507a402 --- /dev/null +++ b/ext/XS-APItest/t/lvalue.t @@ -0,0 +1,28 @@ +# Miscellaneous tests for XS lvalue functions + +use warnings; +use strict; + +use Test::More tests => 3; + +use XS::APItest 'lv_temp_object'; + + +{ + my $w; + local $SIG{__WARN__} = sub { $w = shift }; + + # [perl #31946] + lv_temp_object() = 75; + like $w, qr/Useless assignment to a temporary at/, + 'warning when assigning to temp returned from XS lv sub'; + + $w = undef; + { + package XS::APItest::TempObj; + use overload '.=' => sub { $::assigned = $_[1] }; + } + lv_temp_object() .= 63; + is $::assigned, 63, 'overloaded .= on temp obj returned from lv sub'; + is $w, undef, 'no warning from overloaded .= on temp obj'; +} |