t/comp/redef.t

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