4 @INC = ("../lib", "lib/compress");
8 use lib qw(t t/compress);
17 # use Test::NoWarnings, if available
20 if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 };
22 plan tests => 69 + $extra ;
25 use_ok('IO::Compress::Base::Common');
27 #use_ok('Compress::Zlib::ParseParameters');
32 # Compress::Zlib::Common;
34 sub My::testParseParameters()
36 eval { ParseParameters(1, {}, 1) ; };
37 like $@, mkErr(': Expected even number of parameters, got 1'),
38 "Trap odd number of params";
40 eval { ParseParameters(1, {}, undef) ; };
41 like $@, mkErr(': Expected even number of parameters, got 1'),
42 "Trap odd number of params";
44 eval { ParseParameters(1, {}, []) ; };
45 like $@, mkErr(': Expected even number of parameters, got 1'),
46 "Trap odd number of params";
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";
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";
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";
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'";
64 my $got = ParseParameters(1, {'Fred' => [1, 1, Parse_store_ref, 0]}, Fred => 'abc') ;
65 is ${ $got->value('Fred') }, "abc", "Parse_store_ref" ;
67 $got = ParseParameters(1, {'Fred' => [1, 1, 0x1000000, 0]}, Fred => 'abc') ;
68 is $got->value('Fred'), "abc", "other" ;
70 $got = ParseParameters(1, {'Fred' => [0, 1, Parse_any, undef]}, Fred =>
72 ok $got->parsed('Fred'), "undef" ;
73 ok ! defined $got->value('Fred'), "undef" ;
75 $got = ParseParameters(1, {'Fred' => [0, 1, Parse_string, undef]}, Fred =>
77 ok $got->parsed('Fred'), "undef" ;
78 is $got->value('Fred'), "", "empty string" ;
82 My::testParseParameters();
87 ok isaFilename("abc"), "'abc' isaFilename";
89 ok ! isaFilename(undef), "undef ! isaFilename";
90 ok ! isaFilename([]), "[] ! isaFilename";
91 $main::X = 1; $main::X = $main::X ;
92 ok ! isaFilename(*X), "glob ! isaFilename";
98 my $lex = new LexFile my $out_file ;
99 open FH, ">$out_file" ;
100 is whatIsInput(*FH), 'handle', "Match filehandle" ;
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";
115 title "whatIsOutput" ;
117 my $lex = new LexFile my $out_file ;
118 open FH, ">$out_file" ;
119 is whatIsOutput(*FH), 'handle', "Match filehandle" ;
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";
139 is $x->getHigh, 0, " getHigh is 0";
140 is $x->getLow, 0, " getLow is 0";
144 is $x->getHigh, 1, " getHigh is 1";
145 is $x->getLow, 2, " getLow is 2";
147 $x = new U64(0xFFFFFFFF,2);
148 is $x->getHigh, 0xFFFFFFFF, " getHigh is 0xFFFFFFFF";
149 is $x->getLow, 2, " getLow is 2";
151 $x = new U64(7, 0xFFFFFFFF);
152 is $x->getHigh, 7, " getHigh is 7";
153 is $x->getLow, 0xFFFFFFFF, " getLow is 0xFFFFFFFF";
156 is $x->getHigh, 0, " getHigh is 0";
157 is $x->getLow, 666, " getLow is 666";
162 is $x->getHigh, 0, " getHigh is 0";
163 is $x->getLow, 1, " getLow is 1";
166 is $x->getHigh, 0, " getHigh is 0";
167 is $x->getLow, 2, " getLow is 2";
169 $x = new U64(0, 0xFFFFFFFE);
170 is $x->getHigh, 0, " getHigh is 0";
171 is $x->getLow, 0xFFFFFFFE, " getLow is 0xFFFFFFFE";
174 is $x->getHigh, 0, " getHigh is 0";
175 is $x->getLow, 0xFFFFFFFF, " getLow is 0xFFFFFFFF";
178 is $x->getHigh, 1, " getHigh is 1";
179 is $x->getLow, 0, " getLow is 0";
182 is $x->getHigh, 1, " getHigh is 1";
183 is $x->getLow, 1, " getLow is 1";
185 $x = new U64(1, 0xFFFFFFFE);
186 my $y = new U64(2, 3);
189 is $x->getHigh, 4, " getHigh is 4";
190 is $x->getLow, 1, " getLow is 1";
192 title "U64 - equal" ;
195 is $x->getHigh, 0, " getHigh is 0";
196 is $x->getLow, 1, " getLow is 1";
199 is $x->getHigh, 0, " getHigh is 0";
200 is $x->getLow, 1, " getLow is 1";
202 my $z = new U64(0, 2);
203 is $x->getHigh, 0, " getHigh is 0";
204 is $x->getLow, 1, " getLow is 1";
206 ok $x->equal($y), " equal";
207 ok !$x->equal($z), " ! equal";
209 title "U64 - pack_V" ;