t/op/warn.t

   1 #!./perl
   2 #line 3 warn.t
   3
   4 BEGIN {
   5     chdir 't' if -d 't';
   6     @INC = '../lib';
   7     require './test.pl';
   8 }
   9
  10 plan 22;
  11
  12 my @warnings;
  13 my $wa = []; my $ea = [];
  14 $SIG{__WARN__} = sub { push @warnings, $_[0] };
  15
  16 @warnings = ();
  17 $@ = "";
  18 warn "foo\n";
  19 ok @warnings==1 && $warnings[0] eq "foo\n";
  20
  21 @warnings = ();
  22 $@ = "";
  23 warn "foo", "bar\n";
  24 ok @warnings==1 && $warnings[0] eq "foobar\n";
  25
  26 @warnings = ();
  27 $@ = "";
  28 warn "foo";
  29 ok @warnings==1 && $warnings[0] eq "foo at warn.t line 28.\n";
  30
  31 @warnings = ();
  32 $@ = "";
  33 warn $wa;
  34 ok @warnings==1 && ref($warnings[0]) eq "ARRAY" && $warnings[0] == $wa;
  35
  36 @warnings = ();
  37 $@ = "";
  38 warn "";
  39 ok @warnings==1 &&
  40     $warnings[0] eq "Warning: something's wrong at warn.t line 38.\n";
  41
  42 @warnings = ();
  43 $@ = "";
  44 warn;
  45 ok @warnings==1 &&
  46     $warnings[0] eq "Warning: something's wrong at warn.t line 44.\n";
  47
  48 @warnings = ();
  49 $@ = "ERR\n";
  50 warn "foo\n";
  51 ok @warnings==1 && $warnings[0] eq "foo\n";
  52
  53 @warnings = ();
  54 $@ = "ERR\n";
  55 warn "foo", "bar\n";
  56 ok @warnings==1 && $warnings[0] eq "foobar\n";
  57
  58 @warnings = ();
  59 $@ = "ERR\n";
  60 warn "foo";
  61 ok @warnings==1 && $warnings[0] eq "foo at warn.t line 60.\n";
  62
  63 @warnings = ();
  64 $@ = "ERR\n";
  65 warn $wa;
  66 ok @warnings==1 && ref($warnings[0]) eq "ARRAY" && $warnings[0] == $wa;
  67
  68 @warnings = ();
  69 $@ = "ERR\n";
  70 warn "";
  71 ok @warnings==1 &&
  72     $warnings[0] eq "ERR\n\t...caught at warn.t line 70.\n";
  73
  74 @warnings = ();
  75 $@ = "ERR\n";
  76 warn;
  77 ok @warnings==1 &&
  78     $warnings[0] eq "ERR\n\t...caught at warn.t line 76.\n";
  79
  80 @warnings = ();
  81 $@ = $ea;
  82 warn "foo\n";
  83 ok @warnings==1 && $warnings[0] eq "foo\n";
  84
  85 @warnings = ();
  86 $@ = $ea;
  87 warn "foo", "bar\n";
  88 ok @warnings==1 && $warnings[0] eq "foobar\n";
  89
  90 @warnings = ();
  91 $@ = $ea;
  92 warn "foo";
  93 ok @warnings==1 && $warnings[0] eq "foo at warn.t line 92.\n";
  94
  95 @warnings = ();
  96 $@ = $ea;
  97 warn $wa;
  98 ok @warnings==1 && ref($warnings[0]) eq "ARRAY" && $warnings[0] == $wa;
  99
 100 @warnings = ();
 101 $@ = $ea;
 102 warn "";
 103 ok @warnings==1 && ref($warnings[0]) eq "ARRAY" && $warnings[0] == $ea;
 104
 105 @warnings = ();
 106 $@ = $ea;
 107 warn;
 108 ok @warnings==1 && ref($warnings[0]) eq "ARRAY" && $warnings[0] == $ea;
 109
 110 fresh_perl_like(
 111  '
 112    $a = "\xee\n";
 113    print STDERR $a; warn $a;
 114    utf8::upgrade($a);
 115    print STDERR $a; warn $a;
 116  ',
 117   qr/^\xee(?:\r?\n\xee){3}/,
 118   { switches => [ "-C0" ] },
 119  'warn emits logical characters, not internal bytes [perl #45549]'
 120 );
 121
 122 SKIP: {
 123     skip_if_miniperl('miniperl ignores -C', 1);
 124 fresh_perl_like(
 125  '
 126    $a = "\xee\n";
 127    print STDERR $a; warn $a;
 128    utf8::upgrade($a);
 129    print STDERR $a; warn $a;
 130  ',
 131   qr/^\xc3\xae(?:\r?\n\xc3\xae){3}/,
 132   { switches => ['-CE'] },
 133  'warn respects :utf8 layer'
 134 );
 135 }
 136
 137 fresh_perl_like(
 138  'warn chr 300',
 139   qr/^Wide character in warn .*\n\xc4\xac at /,
 140   { switches => [ "-C0" ] },
 141  'Wide character in warn (not print)'
 142 );
 143
 144 fresh_perl_like(
 145  'warn []',
 146   qr/^ARRAY\(0x[\da-f]+\) at /a,
 147   { },
 148  'warn stringifies in the absence of $SIG{__WARN__}'
 149 );
 150
 151 1;