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