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 }
  13
  14 use strict;
  15 use warnings;
  16
  17 my $warn = "";
  18 $SIG{q(__WARN__)} = sub { print $warn; $warn .= join("",@_) };
  19
  20 sub ok { print $_[1] ? "ok " : "not ok ", $_[0], "\n"; }
  21
  22 sub uninitialized { $warn =~ s/Use of uninitialized value[^\n]+\n//s; }
  23
  24 print "1..32\n";
  25
  26 { my $x; $x ++;     ok  1, ! uninitialized; }
  27 { my $x; $x --;     ok  2, ! uninitialized; }
  28 { my $x; ++ $x;     ok  3, ! uninitialized; }
  29 { my $x; -- $x;     ok  4, ! uninitialized; }
  30
  31 { my $x; $x **= 1;  ok  5,  uninitialized; }
  32
  33 { my $x; $x += 1;   ok  6, ! uninitialized; }
  34 { my $x; $x -= 1;   ok  7, ! uninitialized; }
  35
  36 { my $x; $x .= 1;   ok  8, ! uninitialized; }
  37
  38 { my $x; $x *= 1;   ok  9,  uninitialized; }
  39 { my $x; $x /= 1;   ok 10,  uninitialized; }
  40 { my $x; $x %= 1;   ok 11,  uninitialized; }
  41
  42 { my $x; $x x= 1;   ok 12,  uninitialized; }
  43
  44 { my $x; $x &= 1;   ok 13,  uninitialized; }
  45 { my $x; $x |= 1;   ok 14, ! uninitialized; }
  46 { my $x; $x ^= 1;   ok 15, ! uninitialized; }
  47
  48 { my $x; $x &&= 1;  ok 16, ! uninitialized; }
  49 { my $x; $x ||= 1;  ok 17, ! uninitialized; }
  50
  51 { my $x; $x <<= 1;  ok 18,  uninitialized; }
  52 { my $x; $x >>= 1;  ok 19,  uninitialized; }
  53
  54 { my $x; $x &= "x"; ok 20,  uninitialized; }
  55 { my $x; $x |= "x"; ok 21, ! uninitialized; }
  56 { my $x; $x ^= "x"; ok 22, ! uninitialized; }
  57
  58 { use integer; my $x; $x += 1; ok 23, ! uninitialized; }
  59 { use integer; my $x; $x -= 1; ok 24, ! uninitialized; }
  60
  61 { use integer; my $x; $x *= 1; ok 25,  uninitialized; }
  62 { use integer; my $x; $x /= 1; ok 26,  uninitialized; }
  63 { use integer; my $x; $x %= 1; ok 27,  uninitialized; }
  64
  65 { use integer; my $x; $x ++;   ok 28, ! uninitialized; }
  66 { use integer; my $x; $x --;   ok 29, ! uninitialized; }
  67 { use integer; my $x; ++ $x;   ok 30, ! uninitialized; }
  68 { use integer; my $x; -- $x;   ok 31, ! uninitialized; }
  69
  70 ok 32, $warn eq '';
  71
  72 # If we got any errors that we were not expecting, then print them
  73 print map "#$_\n", split /\n/, $warn if length $warn;