1*b8851fccSafresh1use strict;
2*b8851fccSafresh1use warnings;
3*b8851fccSafresh1BEGIN {
4*b8851fccSafresh1    if ($] < 5.014){
5*b8851fccSafresh1        print "1..0 # Skip: Perl 5.14.0 or later required\n";
6*b8851fccSafresh1        exit 0;
7*b8851fccSafresh1    }
8*b8851fccSafresh1}
9*b8851fccSafresh1
10*b8851fccSafresh1use Encode;
11*b8851fccSafresh1use Test::More tests => 7;
12*b8851fccSafresh1
13*b8851fccSafresh1my $valid   = "\x61\x00\x00\x00";
14*b8851fccSafresh1my $invalid = "\x78\x56\x34\x12";
15*b8851fccSafresh1
16*b8851fccSafresh1my @warnings;
17*b8851fccSafresh1$SIG{__WARN__} = sub {push @warnings, "@_"};
18*b8851fccSafresh1
19*b8851fccSafresh1my $enc = find_encoding("UTF32-LE");
20*b8851fccSafresh1
21*b8851fccSafresh1{
22*b8851fccSafresh1    @warnings = ();
23*b8851fccSafresh1    my $ret = Encode::Unicode::decode( $enc, $valid );
24*b8851fccSafresh1    is("@warnings", "", "Calling decode in Encode::Unicode on valid string produces no warnings");
25*b8851fccSafresh1}
26*b8851fccSafresh1
27*b8851fccSafresh1{
28*b8851fccSafresh1    @warnings = ();
29*b8851fccSafresh1    my $ret = Encode::Unicode::decode( $enc, $invalid );
30*b8851fccSafresh1    like("@warnings", qr/is not Unicode/, "Calling decode in Encode::Unicode on invalid string warns");
31*b8851fccSafresh1}
32*b8851fccSafresh1
33*b8851fccSafresh1{
34*b8851fccSafresh1    no warnings 'utf8';
35*b8851fccSafresh1    @warnings = ();
36*b8851fccSafresh1    my $ret = Encode::Unicode::decode( $enc, $invalid );
37*b8851fccSafresh1    is("@warnings", "", "Warning from decode in Encode::Unicode can be silenced via no warnings 'utf8'");
38*b8851fccSafresh1}
39*b8851fccSafresh1
40*b8851fccSafresh1{
41*b8851fccSafresh1    no warnings;
42*b8851fccSafresh1    @warnings = ();
43*b8851fccSafresh1    my $ret = Encode::Unicode::decode( $enc, $invalid );
44*b8851fccSafresh1    is("@warnings", "", "Warning from decode in Encode::Unicode can be silenced via no warnings");
45*b8851fccSafresh1}
46*b8851fccSafresh1
47*b8851fccSafresh1{
48*b8851fccSafresh1    @warnings = ();
49*b8851fccSafresh1    my $ret = Encode::decode( $enc, $invalid );
50*b8851fccSafresh1    like("@warnings", qr/is not Unicode/, "Calling decode in Encode on invalid string warns");
51*b8851fccSafresh1}
52*b8851fccSafresh1
53*b8851fccSafresh1{
54*b8851fccSafresh1    no warnings 'utf8';
55*b8851fccSafresh1    @warnings = ();
56*b8851fccSafresh1    my $ret = Encode::decode( $enc, $invalid );
57*b8851fccSafresh1    is("@warnings", "", "Warning from decode in Encode can be silenced via no warnings 'utf8'");
58*b8851fccSafresh1};
59*b8851fccSafresh1
60*b8851fccSafresh1{
61*b8851fccSafresh1    no warnings;
62*b8851fccSafresh1    @warnings = ();
63*b8851fccSafresh1    my $ret = Encode::decode( $enc, $invalid );
64*b8851fccSafresh1    is("@warnings", "", "Warning from decode in Encode can be silenced via no warnings 'utf8'");
65*b8851fccSafresh1};
66*b8851fccSafresh1
67