t/comp/redef.t

   1 #!./perl
   2 #
   3 # Contributed by Graham Barr <Graham.Barr@tiuk.ti.com>
   4
   5 BEGIN {
   6     $^W = 1;
   7     $warn = "";
   8     $SIG{__WARN__} = sub { $warn .= join("",@_) }
   9 }
  10
  11 sub ok ($$) {
  12     print $_[1] ? "ok " : "not ok ", $_[0], "\n";
  13 }
  14
  15 print "1..18\n";
  16
  17 sub sub0 { 1 }
  18 sub sub0 { 2 }
  19
  20 ok 1, $warn =~ s/Subroutine sub0 redefined[^\n]+\n//s;
  21
  22 sub sub1    { 1 }
  23 sub sub1 () { 2 }
  24
  25 ok 2, $warn =~ s/Prototype mismatch: \Q(none) vs ()\E[^\n]+\n//s;
  26 ok 3, $warn =~ s/Subroutine sub1 redefined[^\n]+\n//s;
  27
  28 sub sub2     { 1 }
  29 sub sub2 ($) { 2 }
  30
  31 ok 4, $warn =~ s/Prototype mismatch: \Q(none) vs ($)\E[^\n]+\n//s;
  32 ok 5, $warn =~ s/Subroutine sub2 redefined[^\n]+\n//s;
  33
  34 sub sub3 () { 1 }
  35 sub sub3    { 2 }
  36
  37 ok 6, $warn =~ s/Prototype mismatch: \Q() vs (none)\E[^\n]+\n//s;
  38 ok 7, $warn =~ s/Constant subroutine sub3 redefined[^\n]+\n//s;
  39
  40 sub sub4 () { 1 }
  41 sub sub4 () { 2 }
  42
  43 ok 8, $warn =~ s/Constant subroutine sub4 redefined[^\n]+\n//s;
  44
  45 sub sub5 ()  { 1 }
  46 sub sub5 ($) { 2 }
  47
  48 ok  9, $warn =~ s/Prototype mismatch: \Q() vs ($)\E[^\n]+\n//s;
  49 ok 10, $warn =~ s/Constant subroutine sub5 redefined[^\n]+\n//s;
  50
  51 sub sub6 ($) { 1 }
  52 sub sub6     { 2 }
  53
  54 ok 11, $warn =~ s/Prototype mismatch: \Q($) vs (none)\E[^\n]+\n//s;
  55 ok 12, $warn =~ s/Subroutine sub6 redefined[^\n]+\n//s;
  56
  57 sub sub7 ($) { 1 }
  58 sub sub7 ()  { 2 }
  59
  60 ok 13, $warn =~ s/Prototype mismatch: \Q($) vs ()\E[^\n]+\n//s;
  61 ok 14, $warn =~ s/Subroutine sub7 redefined[^\n]+\n//s;
  62
  63 sub sub8 ($) { 1 }
  64 sub sub8 ($) { 2 }
  65
  66 ok 15, $warn =~ s/Subroutine sub8 redefined[^\n]+\n//s;
  67
  68 sub sub9 ($@) { 1 }
  69 sub sub9 ($)  { 2 }
  70
  71 ok 16, $warn =~ s/Prototype mismatch: \(\$\Q@) vs ($)\E[^\n]+\n//s;
  72 ok 17, $warn =~ s/Subroutine sub9 redefined[^\n]+\n//s;
  73
  74 ok 18, $_ eq '';
  75
  76 # If we got any errors that we were not expecting, then print them
  77 print $_ if length $_;
  78
  79