Commit | Line | Data |
8ebc5c01 |
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 | |
9 | BEGIN { |
10 | chdir 't' if -d 't'; |
20822f61 |
11 | @INC = '../lib'; |
198cd045 |
12 | require './test.pl'; |
8ebc5c01 |
13 | } |
14 | |
15 | use strict; |
9f1b1f2d |
16 | use warnings; |
8ebc5c01 |
17 | |
8ebc5c01 |
18 | my $warn = ""; |
19 | $SIG{q(__WARN__)} = sub { print $warn; $warn .= join("",@_) }; |
20 | |
8ebc5c01 |
21 | sub uninitialized { $warn =~ s/Use of uninitialized value[^\n]+\n//s; } |
198cd045 |
22 | sub tiex { tie $_[0], 'main' } |
23 | sub TIESCALAR { my $x; bless \$x } |
24 | sub FETCH { ${$_[0]} } |
25 | sub STORE { ${$_[0]} = $_[1] } |
26 | our $TODO; |
27 | |
28 | print "1..63\n"; |
29 | |
30 | # go through all tests once normally and once with tied $x |
31 | for my $tie ("", ", tied") { |
8ebc5c01 |
32 | |
198cd045 |
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"; } |
8ebc5c01 |
37 | |
198cd045 |
38 | { my $x; tiex $x if $tie; $x **= 1; ok uninitialized, "**=$tie"; } |
8ebc5c01 |
39 | |
198cd045 |
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"; } |
8ebc5c01 |
46 | |
198cd045 |
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"; } |
8ebc5c01 |
50 | |
198cd045 |
51 | { my $x; tiex $x if $tie; $x x= 1; ok uninitialized, "x=$tie"; } |
8ebc5c01 |
52 | |
198cd045 |
53 | { my $x; tiex $x if $tie; $x &= 1; ok uninitialized, "&=$tie"; } |
8ebc5c01 |
54 | |
198cd045 |
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 | } |
8ebc5c01 |
59 | |
198cd045 |
60 | { my $x; tiex $x if $tie; $x &&= 1; ok ! uninitialized, "&&=$tie"; } |
61 | { my $x; tiex $x if $tie; $x ||= 1; ok ! uninitialized, "||=$tie"; } |
8ebc5c01 |
62 | |
198cd045 |
63 | { my $x; tiex $x if $tie; $x <<= 1; ok uninitialized, "<<=$tie"; } |
64 | { my $x; tiex $x if $tie; $x >>= 1; ok uninitialized, ">>=$tie"; } |
8ebc5c01 |
65 | |
198cd045 |
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 | } |
8ebc5c01 |
79 | |
198cd045 |
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"; } |
5e66d4f1 |
83 | |
198cd045 |
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"; } |
5e66d4f1 |
88 | |
198cd045 |
89 | } # end of use integer; |
5e66d4f1 |
90 | |
198cd045 |
91 | } # end of for $tie |
8ebc5c01 |
92 | |
198cd045 |
93 | is $warn, '', "no spurious warnings"; |