t/op/protowarn.t

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