t/op/assignwarn.t

   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';
  11     @INC = '../lib';
  12     require './test.pl';
  13 }
  14
  15 use strict;
  16 use warnings;
  17
  18 my $warn = "";
  19 $SIG{q(__WARN__)} = sub { print $warn; $warn .= join("",@_) };
  20
  21 sub uninitialized { $warn =~ s/Use of uninitialized value[^\n]+\n//s; }
  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") {
  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
  93 is $warn, '', "no spurious warnings";