X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fop%2Fassignwarn.t;h=0841bd4e2073484b130dad57e20d6ca425d7e630;hb=3ab3c9b49fb213f2b1d4cda8797de17be82b2b15;hp=e69de29bb2d1d6434b8b29ae775ad8c2e48c5391;hpb=2223696182def99cda82e756db80d13949fc882e;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/t/op/assignwarn.t b/t/op/assignwarn.t
index e69de29..0841bd4 100755
--- a/t/op/assignwarn.t
+++ b/t/op/assignwarn.t
@@ -0,0 +1,93 @@
+#!./perl
+
+#
+# Verify which OP= operators warn if their targets are undefined.
+# Based on redef.t, contributed by Graham Barr <Graham.Barr@tiuk.ti.com>
+#	-- Robin Barker <rmb@cise.npl.co.uk>
+#
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require './test.pl';
+}
+
+use strict;
+use warnings;
+
+my $warn = "";
+$SIG{q(__WARN__)} = sub { print $warn; $warn .= join("",@_) };
+
+sub uninitialized { $warn =~ s/Use of uninitialized value[^\n]+\n//s; }
+sub tiex { tie $_[0], 'main' }
+sub TIESCALAR { my $x; bless \$x }
+sub FETCH { ${$_[0]} }
+sub STORE { ${$_[0]} = $_[1] }
+our $TODO;
+
+print "1..63\n";
+
+# go through all tests once normally and once with tied $x
+for my $tie ("", ", tied") {
+
+{ my $x; tiex $x if $tie; $x ++;     ok ! uninitialized, "postinc$tie"; }
+{ my $x; tiex $x if $tie; $x --;     ok ! uninitialized, "postdec$tie"; }
+{ my $x; tiex $x if $tie; ++ $x;     ok ! uninitialized, "preinc$tie"; }
+{ my $x; tiex $x if $tie; -- $x;     ok ! uninitialized, "predec$tie"; }
+
+{ my $x; tiex $x if $tie; $x **= 1;  ok uninitialized,   "**=$tie"; }
+
+{ local $TODO = $tie && '[perl #17809] pp_add & pp_subtract';
+    { my $x; tiex $x if $tie; $x += 1;   ok ! uninitialized, "+=$tie"; }
+    { my $x; tiex $x if $tie; $x -= 1;   ok ! uninitialized, "-=$tie"; }
+}
+
+{ my $x; tiex $x if $tie; $x .= 1;   ok ! uninitialized, ".=$tie"; }
+
+{ my $x; tiex $x if $tie; $x *= 1;   ok uninitialized,   "*=$tie"; }
+{ my $x; tiex $x if $tie; $x /= 1;   ok uninitialized,   "/=$tie"; }
+{ my $x; tiex $x if $tie; $x %= 1;   ok uninitialized,   "\%=$tie"; }
+
+{ my $x; tiex $x if $tie; $x x= 1;   ok uninitialized, "x=$tie"; }
+
+{ my $x; tiex $x if $tie; $x &= 1;   ok uninitialized, "&=$tie"; }
+
+{ local $TODO = $tie && '[perl #17809] pp_bit_or & pp_bit_xor';
+    { my $x; tiex $x if $tie; $x |= 1;   ok ! uninitialized, "|=$tie"; }
+    { my $x; tiex $x if $tie; $x ^= 1;   ok ! uninitialized, "^=$tie"; }
+}
+
+{ my $x; tiex $x if $tie; $x &&= 1;  ok ! uninitialized, "&&=$tie"; }
+{ my $x; tiex $x if $tie; $x ||= 1;  ok ! uninitialized, "||=$tie"; }
+
+{ my $x; tiex $x if $tie; $x <<= 1;  ok uninitialized, "<<=$tie"; }
+{ my $x; tiex $x if $tie; $x >>= 1;  ok uninitialized, ">>=$tie"; }
+
+{ my $x; tiex $x if $tie; $x &= "x"; ok uninitialized, "&=$tie, string"; }
+
+{ local $TODO = $tie && '[perl #17809] pp_bit_or & pp_bit_xor';
+    { my $x; tiex $x if $tie; $x |= "x"; ok ! uninitialized, "|=$tie, string"; }
+    { my $x; tiex $x if $tie; $x ^= "x"; ok ! uninitialized, "^=$tie, string"; }
+}
+
+{ use integer;
+
+{ local $TODO = $tie && '[perl #17809] pp_i_add & pp_i_subtract';
+    { my $x; tiex $x if $tie; $x += 1; ok ! uninitialized, "+=$tie, int"; }
+    { my $x; tiex $x if $tie; $x -= 1; ok ! uninitialized, "-=$tie, int"; }
+}
+
+{ my $x; tiex $x if $tie; $x *= 1; ok uninitialized, "*=$tie, int"; }
+{ my $x; tiex $x if $tie; $x /= 1; ok uninitialized, "/=$tie, int"; }
+{ my $x; tiex $x if $tie; $x %= 1; ok uninitialized, "\%=$tie, int"; }
+
+{ my $x; tiex $x if $tie; $x ++;   ok ! uninitialized, "postinc$tie, int"; }
+{ my $x; tiex $x if $tie; $x --;   ok ! uninitialized, "postdec$tie, int"; }
+{ my $x; tiex $x if $tie; ++ $x;   ok ! uninitialized, "preinc$tie, int"; }
+{ my $x; tiex $x if $tie; -- $x;   ok ! uninitialized, "predec$tie, int"; }
+
+} # end of use integer;
+
+} # end of for $tie
+
+is $warn, '', "no spurious warnings";