t/op/protowarn.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = qw(. ../lib);
   6 }
   7
   8 use strict;
   9 use warnings;
  10
  11 BEGIN {
  12     require 'test.pl';
  13     plan( tests => 12 );
  14 }
  15
  16 use vars qw{ @warnings $sub $warn };
  17
  18 BEGIN {
  19     $warn = 'Illegal character in prototype';
  20 }
  21
  22 sub one_warning_ok {
  23     cmp_ok(scalar(@warnings), '==', 1, 'One warning');
  24     cmp_ok(substr($warnings[0],0,length($warn)),'eq',$warn,'warning message');
  25     @warnings = ();
  26 }
  27
  28 sub no_warnings_ok {
  29     cmp_ok(scalar(@warnings), '==', 0, 'No warnings');
  30     @warnings = ();
  31 }
  32
  33 BEGIN {
  34     $SIG{'__WARN__'} = sub { push @warnings, @_ };
  35     $| = 1;
  36 }
  37
  38 BEGIN { @warnings = () }
  39
  40 $sub = sub (x) { };
  41
  42 BEGIN {
  43     one_warning_ok;
  44 }
  45
  46 {
  47     no warnings 'syntax';
  48     $sub = sub (x) { };
  49 }
  50
  51 BEGIN {
  52     no_warnings_ok;
  53 }
  54
  55 {
  56     no warnings 'illegalproto';
  57     $sub = sub (x) { };
  58 }
  59
  60 BEGIN {
  61     no_warnings_ok;
  62 }
  63
  64 {
  65     no warnings 'syntax';
  66     use warnings 'illegalproto';
  67     $sub = sub (x) { };
  68 }
  69
  70 BEGIN {
  71     one_warning_ok;
  72 }
  73
  74 BEGIN {
  75     $warn = q{Prototype after '@' for};
  76 }
  77
  78 $sub = sub (@$) { };
  79
  80 BEGIN {
  81     one_warning_ok;
  82 }
  83
  84 {
  85     no warnings 'syntax';
  86     $sub = sub (@$) { };
  87 }
  88
  89 BEGIN {
  90     no_warnings_ok;
  91 }
  92
  93 {
  94     no warnings 'illegalproto';
  95     $sub = sub (@$) { };
  96 }
  97
  98 BEGIN {
  99     no_warnings_ok;
 100 }
 101
 102 {
 103     no warnings 'syntax';
 104     use warnings 'illegalproto';
 105     $sub = sub (@$) { };
 106 }
 107
 108 BEGIN {
 109     one_warning_ok;
 110 }