This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Tests for XS lvalue functions
authorFather Chrysostomos <sprout@cpan.org>
Wed, 1 Jun 2011 21:07:04 +0000 (14:07 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Wed, 1 Jun 2011 21:08:13 +0000 (14:08 -0700)
including the ‘Useless assignment to a temporary’ warning
which is only triggered by these.

MANIFEST
ext/XS-APItest/APItest.pm
ext/XS-APItest/APItest.xs
ext/XS-APItest/t/lvalue.t [new file with mode: 0644]

index bcaa5c6..90fb130 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -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
index 5ef9ea2..c6ae302 100644 (file)
@@ -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__
 
index 4fa4e1e..b9f4a67 100644 (file)
@@ -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 (file)
index 0000000..718507a
--- /dev/null
@@ -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';
+}