1#!./perl
2
3#
4# Verify which OP= operators warn if their targets are undefined.
5# Based on redef.t, contributed by Graham Barr <Graham.Barr@tiuk.ti.com>
6#	-- Robin Barker <rmb@cise.npl.co.uk>
7#
8
9BEGIN {
10    chdir 't' if -d 't';
11    @INC = '../lib';
12    require './test.pl';
13}
14
15use strict;
16use warnings;
17
18my $warn = "";
19$SIG{q(__WARN__)} = sub { print $warn; $warn .= join("",@_) };
20
21sub uninitialized { $warn =~ s/Use of uninitialized value[^\n]+\n//s; }
22sub tiex { tie $_[0], 'main' }
23sub TIESCALAR { my $x; bless \$x }
24sub FETCH { ${$_[0]} }
25sub STORE { ${$_[0]} = $_[1] }
26our $TODO;
27
28print "1..63\n";
29
30# go through all tests once normally and once with tied $x
31for my $tie ("", ", tied") {
32
33{ my $x; tiex $x if $tie; $x ++;     ok ! uninitialized, "postinc$tie"; }
34{ my $x; tiex $x if $tie; $x --;     ok ! uninitialized, "postdec$tie"; }
35{ my $x; tiex $x if $tie; ++ $x;     ok ! uninitialized, "preinc$tie"; }
36{ my $x; tiex $x if $tie; -- $x;     ok ! uninitialized, "predec$tie"; }
37
38{ my $x; tiex $x if $tie; $x **= 1;  ok uninitialized,   "**=$tie"; }
39
40{ local $TODO = $tie && '[perl #17809] pp_add & pp_subtract';
41    { my $x; tiex $x if $tie; $x += 1;   ok ! uninitialized, "+=$tie"; }
42    { my $x; tiex $x if $tie; $x -= 1;   ok ! uninitialized, "-=$tie"; }
43}
44
45{ my $x; tiex $x if $tie; $x .= 1;   ok ! uninitialized, ".=$tie"; }
46
47{ my $x; tiex $x if $tie; $x *= 1;   ok uninitialized,   "*=$tie"; }
48{ my $x; tiex $x if $tie; $x /= 1;   ok uninitialized,   "/=$tie"; }
49{ my $x; tiex $x if $tie; $x %= 1;   ok uninitialized,   "\%=$tie"; }
50
51{ my $x; tiex $x if $tie; $x x= 1;   ok uninitialized, "x=$tie"; }
52
53{ my $x; tiex $x if $tie; $x &= 1;   ok uninitialized, "&=$tie"; }
54
55{ local $TODO = $tie && '[perl #17809] pp_bit_or & pp_bit_xor';
56    { my $x; tiex $x if $tie; $x |= 1;   ok ! uninitialized, "|=$tie"; }
57    { my $x; tiex $x if $tie; $x ^= 1;   ok ! uninitialized, "^=$tie"; }
58}
59
60{ my $x; tiex $x if $tie; $x &&= 1;  ok ! uninitialized, "&&=$tie"; }
61{ my $x; tiex $x if $tie; $x ||= 1;  ok ! uninitialized, "||=$tie"; }
62
63{ my $x; tiex $x if $tie; $x <<= 1;  ok uninitialized, "<<=$tie"; }
64{ my $x; tiex $x if $tie; $x >>= 1;  ok uninitialized, ">>=$tie"; }
65
66{ my $x; tiex $x if $tie; $x &= "x"; ok uninitialized, "&=$tie, string"; }
67
68{ local $TODO = $tie && '[perl #17809] pp_bit_or & pp_bit_xor';
69    { my $x; tiex $x if $tie; $x |= "x"; ok ! uninitialized, "|=$tie, string"; }
70    { my $x; tiex $x if $tie; $x ^= "x"; ok ! uninitialized, "^=$tie, string"; }
71}
72
73{ use integer;
74
75{ local $TODO = $tie && '[perl #17809] pp_i_add & pp_i_subtract';
76    { my $x; tiex $x if $tie; $x += 1; ok ! uninitialized, "+=$tie, int"; }
77    { my $x; tiex $x if $tie; $x -= 1; ok ! uninitialized, "-=$tie, int"; }
78}
79
80{ my $x; tiex $x if $tie; $x *= 1; ok uninitialized, "*=$tie, int"; }
81{ my $x; tiex $x if $tie; $x /= 1; ok uninitialized, "/=$tie, int"; }
82{ my $x; tiex $x if $tie; $x %= 1; ok uninitialized, "\%=$tie, int"; }
83
84{ my $x; tiex $x if $tie; $x ++;   ok ! uninitialized, "postinc$tie, int"; }
85{ my $x; tiex $x if $tie; $x --;   ok ! uninitialized, "postdec$tie, int"; }
86{ my $x; tiex $x if $tie; ++ $x;   ok ! uninitialized, "preinc$tie, int"; }
87{ my $x; tiex $x if $tie; -- $x;   ok ! uninitialized, "predec$tie, int"; }
88
89} # end of use integer;
90
91} # end of for $tie
92
93is $warn, '', "no spurious warnings";
94