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

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