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 YST |
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 YST |
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 YST |
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 YST |
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 YST |
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 YST |
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 YST |
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 YST |
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 YST |
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 YST |
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"; |