This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix "Wide character in warn" warning
[perl5.git] / 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 21;
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   {},
119  'warn emits logical characters, not internal bytes [perl #45549]'  
120 );
121
122 fresh_perl_like(
123  '
124    $a = "\xee\n";
125    print STDERR $a; warn $a;
126    utf8::upgrade($a);
127    print STDERR $a; warn $a;
128  ',
129   qr/^\xc3\xae(?:\r?\n\xc3\xae){3}/,
130   { switches => ['-CE'] },
131  'warn respects :utf8 layer'
132 );
133
134 fresh_perl_like(
135  'warn chr 300',
136   qr/^Wide character in warn .*\n\xc4\xac at /,
137   {},
138  'Wide character in warn (not print)'
139 );
140
141 1;