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