ext/Compress/Zlib/t/23misc.t

   1 BEGIN {
   2     if ($ENV{PERL_CORE}) {
   3         chdir 't' if -d 't';
   4         @INC = '../lib';
   5     }
   6 }
   7
   8 use lib 't';
   9 use strict;
  10 use warnings;
  11 use bytes;
  12
  13 use Test::More ;
  14 use ZlibTestUtils;
  15
  16 BEGIN {
  17     # use Test::NoWarnings, if available
  18     my $extra = 0 ;
  19     $extra = 1
  20         if eval { require Test::NoWarnings ;  import Test::NoWarnings; 1 };
  21
  22     plan tests => 29 + $extra ;
  23
  24
  25     use_ok('Compress::Zlib::Common');
  26
  27     use_ok('Compress::Zlib::ParseParameters');
  28
  29 #    use_ok('Compress::Zlib', 2) ;
  30 #
  31 #    use_ok('IO::Compress::Gzip', qw($GzipError)) ;
  32 #    use_ok('IO::Uncompress::Gunzip', qw($GunzipError)) ;
  33 #
  34 #    use_ok('IO::Compress::Deflate', qw($DeflateError)) ;
  35 #    use_ok('IO::Uncompress::Inflate', qw($InflateError)) ;
  36 #
  37 #    use_ok('IO::Compress::RawDeflate', qw($RawDeflateError)) ;
  38 #    use_ok('IO::Uncompress::RawInflate', qw($RawInflateError)) ;
  39 }
  40
  41
  42 # Compress::Zlib::Common;
  43
  44 sub My::testParseParameters()
  45 {
  46     eval { ParseParameters(1, {}, 1) ; };
  47     like $@, mkErr(': Expected even number of parameters, got 1'),
  48             "Trap odd number of params";
  49
  50     eval { ParseParameters(1, {}, undef) ; };
  51     like $@, mkErr(': Expected even number of parameters, got 1'),
  52             "Trap odd number of params";
  53
  54     eval { ParseParameters(1, {}, []) ; };
  55     like $@, mkErr(': Expected even number of parameters, got 1'),
  56             "Trap odd number of params";
  57
  58     eval { ParseParameters(1, {'Fred' => [Parse_unsigned, 0]}, Fred => undef) ; };
  59     like $@, mkErr("Parameter 'Fred' must be an unsigned int, got undef"),
  60             "wanted unsigned, got undef";
  61
  62     eval { ParseParameters(1, {'Fred' => [Parse_signed, 0]}, Fred => undef) ; };
  63     like $@, mkErr("Parameter 'Fred' must be a signed int, got undef"),
  64             "wanted signed, got undef";
  65
  66     eval { ParseParameters(1, {'Fred' => [Parse_signed, 0]}, Fred => 'abc') ; };
  67     like $@, mkErr("Parameter 'Fred' must be a signed int, got 'abc'"),
  68             "wanted signed, got 'abc'";
  69
  70     my $got = ParseParameters(1, {'Fred' => [Parse_store_ref, 0]}, Fred => 'abc') ;
  71     is ${ $got->value('Fred') }, "abc", "Parse_store_ref" ;
  72
  73     $got = ParseParameters(1, {'Fred' => [0x1000000, 0]}, Fred => 'abc') ;
  74     is $got->value('Fred'), "abc", "other" ;
  75
  76 }
  77
  78 My::testParseParameters();
  79
  80
  81 {
  82     title "isaFilename" ;
  83     ok   isaFilename("abc"), "'abc' isaFilename";
  84
  85     ok ! isaFilename(undef), "undef ! isaFilename";
  86     ok ! isaFilename([]),    "[] ! isaFilename";
  87     $main::X = 1; $main::X = $main::X ;
  88     ok ! isaFilename(*X),    "glob ! isaFilename";
  89 }
  90
  91 {
  92     title "whatIsInput" ;
  93
  94     my $out_file = "abc";
  95     my $lex = new LexFile($out_file) ;
  96     open FH, ">$out_file" ;
  97     is whatIsInput(*FH), 'handle', "Match filehandle" ;
  98     close FH ;
  99
 100     my $stdin = '-';
 101     is whatIsInput($stdin),       'handle',   "Match '-' as stdin";
 102     #is $stdin,                    \*STDIN,    "'-' changed to *STDIN";
 103     #isa_ok $stdin,                'IO::File',    "'-' changed to IO::File";
 104     is whatIsInput("abc"),        'filename', "Match filename";
 105     is whatIsInput(\"abc"),       'buffer',   "Match buffer";
 106     is whatIsInput(sub { 1 }, 1), 'code',     "Match code";
 107     is whatIsInput(sub { 1 }),    ''   ,      "Don't match code";
 108
 109 }
 110
 111 {
 112     title "whatIsOutput" ;
 113
 114     my $out_file = "abc";
 115     my $lex = new LexFile($out_file) ;
 116     open FH, ">$out_file" ;
 117     is whatIsOutput(*FH), 'handle', "Match filehandle" ;
 118     close FH ;
 119
 120     my $stdout = '-';
 121     is whatIsOutput($stdout),     'handle',   "Match '-' as stdout";
 122     #is $stdout,                   \*STDOUT,   "'-' changed to *STDOUT";
 123     #isa_ok $stdout,               'IO::File',    "'-' changed to IO::File";
 124     is whatIsOutput("abc"),        'filename', "Match filename";
 125     is whatIsOutput(\"abc"),       'buffer',   "Match buffer";
 126     is whatIsOutput(sub { 1 }, 1), 'code',     "Match code";
 127     is whatIsOutput(sub { 1 }),    ''   ,      "Don't match code";
 128
 129 }