ext/Compress/IO/Base/t/01misc.t

   1 BEGIN {
   2     if ($ENV{PERL_CORE}) {
   3         chdir 't' if -d 't';
   4         @INC = ("../lib", "lib/compress");
   5     }
   6 }
   7
   8 use lib qw(t t/compress);
   9 use strict;
  10 use warnings;
  11 use bytes;
  12
  13 use Test::More ;
  14 use CompTestUtils;
  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 => 33 + $extra ;
  23
  24
  25     use_ok('IO::Compress::Base::Common');
  26
  27     #use_ok('Compress::Zlib::ParseParameters');
  28
  29 }
  30
  31
  32 # Compress::Zlib::Common;
  33
  34 sub My::testParseParameters()
  35 {
  36     eval { ParseParameters(1, {}, 1) ; };
  37     like $@, mkErr(': Expected even number of parameters, got 1'),
  38             "Trap odd number of params";
  39
  40     eval { ParseParameters(1, {}, undef) ; };
  41     like $@, mkErr(': Expected even number of parameters, got 1'),
  42             "Trap odd number of params";
  43
  44     eval { ParseParameters(1, {}, []) ; };
  45     like $@, mkErr(': Expected even number of parameters, got 1'),
  46             "Trap odd number of params";
  47
  48     eval { ParseParameters(1, {'Fred' => [1, 1, Parse_boolean, 0]}, Fred => 'joe') ; };
  49     like $@, mkErr("Parameter 'Fred' must be an int, got 'joe'"),
  50             "wanted unsigned, got undef";
  51
  52     eval { ParseParameters(1, {'Fred' => [1, 1, 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' => [1, 1, 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' => [1, 1, 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' => [1, 1, Parse_store_ref, 0]}, Fred => 'abc') ;
  65     is ${ $got->value('Fred') }, "abc", "Parse_store_ref" ;
  66
  67     $got = ParseParameters(1, {'Fred' => [1, 1, 0x1000000, 0]}, Fred => 'abc') ;
  68     is $got->value('Fred'), "abc", "other" ;
  69
  70     $got = ParseParameters(1, {'Fred' => [0, 1, Parse_any, undef]}, Fred =>
  71 undef) ;
  72     ok $got->parsed('Fred'), "undef" ;
  73     ok ! defined $got->value('Fred'), "undef" ;
  74
  75     $got = ParseParameters(1, {'Fred' => [0, 1, Parse_string, undef]}, Fred =>
  76 undef) ;
  77     ok $got->parsed('Fred'), "undef" ;
  78     is $got->value('Fred'), "", "empty string" ;
  79
  80 }
  81
  82 My::testParseParameters();
  83
  84
  85 {
  86     title "isaFilename" ;
  87     ok   isaFilename("abc"), "'abc' isaFilename";
  88
  89     ok ! isaFilename(undef), "undef ! isaFilename";
  90     ok ! isaFilename([]),    "[] ! isaFilename";
  91     $main::X = 1; $main::X = $main::X ;
  92     ok ! isaFilename(*X),    "glob ! isaFilename";
  93 }
  94
  95 {
  96     title "whatIsInput" ;
  97
  98     my $lex = new LexFile my $out_file ;
  99     open FH, ">$out_file" ;
 100     is whatIsInput(*FH), 'handle', "Match filehandle" ;
 101     close FH ;
 102
 103     my $stdin = '-';
 104     is whatIsInput($stdin),       'handle',   "Match '-' as stdin";
 105     #is $stdin,                    \*STDIN,    "'-' changed to *STDIN";
 106     #isa_ok $stdin,                'IO::File',    "'-' changed to IO::File";
 107     is whatIsInput("abc"),        'filename', "Match filename";
 108     is whatIsInput(\"abc"),       'buffer',   "Match buffer";
 109     is whatIsInput(sub { 1 }, 1), 'code',     "Match code";
 110     is whatIsInput(sub { 1 }),    ''   ,      "Don't match code";
 111
 112 }
 113
 114 {
 115     title "whatIsOutput" ;
 116
 117     my $lex = new LexFile my $out_file ;
 118     open FH, ">$out_file" ;
 119     is whatIsOutput(*FH), 'handle', "Match filehandle" ;
 120     close FH ;
 121
 122     my $stdout = '-';
 123     is whatIsOutput($stdout),     'handle',   "Match '-' as stdout";
 124     #is $stdout,                   \*STDOUT,   "'-' changed to *STDOUT";
 125     #isa_ok $stdout,               'IO::File',    "'-' changed to IO::File";
 126     is whatIsOutput("abc"),        'filename', "Match filename";
 127     is whatIsOutput(\"abc"),       'buffer',   "Match buffer";
 128     is whatIsOutput(sub { 1 }, 1), 'code',     "Match code";
 129     is whatIsOutput(sub { 1 }),    ''   ,      "Don't match code";
 130
 131 }