ext/MIME-Base64/t/warn.t

   1 #!perl -w
   2
   3 BEGIN {
   4     if ($ENV{'PERL_CORE'}){
   5         chdir 't' if -d 't';
   6         @INC = '../lib';
   7     }
   8 }
   9
  10 BEGIN {
  11     eval {
  12         require warnings;
  13     };
  14     if ($@) {
  15         print "1..0\n";
  16         print $@;
  17         exit;
  18     }
  19 }
  20
  21 use strict;
  22 use MIME::Base64 qw(decode_base64);
  23
  24 print "1..1\n";
  25
  26 use warnings;
  27
  28 my @warn;
  29 $SIG{__WARN__} = sub { push(@warn, @_) };
  30
  31 warn;
  32 my $a;
  33 $a = decode_base64("aa");
  34 $a = decode_base64("a===");
  35 warn;
  36 $a = do {
  37     no warnings;
  38     decode_base64("aa");
  39 };
  40 $a = do {
  41     no warnings;
  42     decode_base64("a===");
  43 };
  44 warn;
  45 $a = do {
  46     local $^W;
  47     decode_base64("aa");
  48 };
  49 $a = do {
  50     local $^W;
  51     decode_base64("a===");
  52 };
  53 warn;
  54
  55 for (@warn) {
  56     print "# $_";
  57 }
  58
  59 print "not " unless join("", @warn) eq <<"EOT"; print "ok 1\n";
  60 Warning: something's wrong at $0 line 31.
  61 Premature end of base64 data at $0 line 33.
  62 Premature padding of base64 data at $0 line 34.
  63 Warning: something's wrong at $0 line 35.
  64 Premature end of base64 data at $0 line 38.
  65 Premature padding of base64 data at $0 line 42.
  66 Warning: something's wrong at $0 line 44.
  67 Warning: something's wrong at $0 line 53.
  68 EOT