xref: /openbsd-src/gnu/usr.bin/perl/cpan/IO-Compress/t/01misc.t (revision 50b7afb2c2c0993b0894d4e34bf857cb13ed9c80) 
1BEGIN {
2    if ($ENV{PERL_CORE}) {
3	chdir 't' if -d 't';
4	@INC = ("../lib", "lib/compress");
5    }
6}
7
8use lib qw(t t/compress);
9use strict;
10use warnings;
11use bytes;
12
13use Test::More ;
14use CompTestUtils;
15
16BEGIN {
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 => 163 + $extra ;
23
24    use_ok('Scalar::Util');
25    use_ok('IO::Compress::Base::Common');
26}
27
28
29ok gotScalarUtilXS(), "Got XS Version of Scalar::Util"
30    or diag <<EOM;
31You don't have the XS version of Scalar::Util
32EOM
33
34# Compress::Zlib::Common;
35
36sub My::testParseParameters()
37{
38    eval { ParseParameters(1, {}, 1) ; };
39    like $@, mkErr(': Expected even number of parameters, got 1'),
40            "Trap odd number of params";
41
42    eval { ParseParameters(1, {}, undef) ; };
43    like $@, mkErr(': Expected even number of parameters, got 1'),
44            "Trap odd number of params";
45
46    eval { ParseParameters(1, {}, []) ; };
47    like $@, mkErr(': Expected even number of parameters, got 1'),
48            "Trap odd number of params";
49
50    eval { ParseParameters(1, {'fred' => [Parse_boolean, 0]}, fred => 'joe') ; };
51    like $@, mkErr("Parameter 'fred' must be an int, got 'joe'"),
52            "wanted unsigned, got undef";
53
54    eval { ParseParameters(1, {'fred' => [Parse_unsigned, 0]}, fred => undef) ; };
55    like $@, mkErr("Parameter 'fred' must be an unsigned int, got 'undef'"),
56            "wanted unsigned, got undef";
57
58    eval { ParseParameters(1, {'fred' => [Parse_signed, 0]}, fred => undef) ; };
59    like $@, mkErr("Parameter 'fred' must be a signed int, got 'undef'"),
60            "wanted signed, got undef";
61
62    eval { ParseParameters(1, {'fred' => [Parse_signed, 0]}, fred => 'abc') ; };
63    like $@, mkErr("Parameter 'fred' must be a signed int, got 'abc'"),
64            "wanted signed, got 'abc'";
65
66    eval { ParseParameters(1, {'fred' => [Parse_code, undef]}, fred => 'abc') ; };
67    like $@, mkErr("Parameter 'fred' must be a code reference, got 'abc'"),
68            "wanted code, got 'abc'";
69
70
71    SKIP:
72    {
73        use Config;
74
75        skip 'readonly + threads', 2
76            if $Config{useithreads};
77
78        eval { ParseParameters(1, {'fred' => [Parse_writable_scalar, 0]}, fred => 'abc') ; };
79        like $@, mkErr("Parameter 'fred' not writable"),
80                "wanted writable, got readonly";
81
82        eval { ParseParameters(1, {'fred' => [Parse_writable_scalar, 0]}, fred => \'abc') ; };
83        like $@, mkErr("Parameter 'fred' not writable"),
84                "wanted writable, got readonly";
85    }
86
87    my @xx;
88    eval { ParseParameters(1, {'fred' => [Parse_writable_scalar, 0]}, fred => \@xx) ; };
89    like $@, mkErr("Parameter 'fred' not a scalar reference"),
90            "wanted scalar reference";
91
92    local *ABC;
93    eval { ParseParameters(1, {'fred' => [Parse_writable_scalar, 0]}, fred => *ABC) ; };
94    like $@, mkErr("Parameter 'fred' not a scalar"),
95            "wanted scalar";
96
97    eval { ParseParameters(1, {'fred' => [Parse_any, 0]}, fred => 1, fred => 2) ; };
98    like $@, mkErr("Muliple instances of 'fred' found"),
99        "multiple instances";
100
101#    my $g = ParseParameters(1, {'fred' => [Parse_unsigned|Parse_multiple, 7]}, fred => 1, fred => 2) ;
102#    is_deeply $g->value('fred'), [ 1, 2 ] ;
103    ok 1;
104
105    #ok 1;
106
107    my $got = ParseParameters(1, {'fred' => [0x1000000, 0]}, fred => 'abc') ;
108    is $got->getValue('fred'), "abc", "other" ;
109
110    $got = ParseParameters(1, {'fred' => [Parse_any, undef]}, fred => undef) ;
111    ok $got->parsed('fred'), "undef" ;
112    ok ! defined $got->getValue('fred'), "undef" ;
113
114    $got = ParseParameters(1, {'fred' => [Parse_string, undef]}, fred => undef) ;
115    ok $got->parsed('fred'), "undef" ;
116    is $got->getValue('fred'), "", "empty string" ;
117
118    my $xx;
119    $got = ParseParameters(1, {'fred' => [Parse_writable_scalar, undef]}, fred => $xx) ;
120
121    ok $got->parsed('fred'), "parsed" ;
122    my $xx_ref = $got->getValue('fred');
123    $$xx_ref = 77 ;
124    is $xx, 77;
125
126    $got = ParseParameters(1, {'fred' => [Parse_writable_scalar, undef]}, fred => \$xx) ;
127
128    ok $got->parsed('fred'), "parsed" ;
129    $xx_ref = $got->getValue('fred');
130
131    $$xx_ref = 666 ;
132    is $xx, 666;
133
134    {
135        my $got1 = ParseParameters(1, {'fred' => [Parse_writable_scalar, undef]}, $got) ;
136        is $got1, $got, "Same object";
137
138        ok $got1->parsed('fred'), "parsed" ;
139        $xx_ref = $got1->getValue('fred');
140
141        $$xx_ref = 777 ;
142        is $xx, 777;
143    }
144
145    for my $type (Parse_unsigned, Parse_signed, Parse_any)
146    {
147        my $value = 0;
148        my $got1 ;
149        eval { $got1 = ParseParameters(1, {'fred' => [$type, 1]}, fred => $value) } ;
150
151        ok ! $@;
152        ok $got1->parsed('fred'), "parsed ok" ;
153        is $got1->getValue('fred'), 0;
154    }
155
156    {
157        # setValue/getValue
158        my $value = 0;
159        my $got1 ;
160        eval { $got1 = ParseParameters(1, {'fred' => [Parse_any, 1]}, fred => $value) } ;
161
162        ok ! $@;
163        ok $got1->parsed('fred'), "parsed ok" ;
164        is $got1->getValue('fred'), 0;
165        $got1->setValue('fred' => undef);
166        is $got1->getValue('fred'), undef;
167    }
168
169    {
170        # twice
171        my $value = 0;
172
173        my $got = IO::Compress::Base::Parameters::new();
174
175
176        ok $got->parse({'fred' => [Parse_any, 1]}, fred => $value) ;
177
178        ok $got->parsed('fred'), "parsed ok" ;
179        is $got->getValue('fred'), 0;
180
181        ok $got->parse({'fred' => [Parse_any, 1]}, fred => undef) ;
182        ok $got->parsed('fred'), "parsed ok" ;
183        is $got->getValue('fred'), undef;
184
185        ok $got->parse({'fred' => [Parse_any, 1]}, fred => 7) ;
186        ok $got->parsed('fred'), "parsed ok" ;
187        is $got->getValue('fred'), 7;
188    }
189}
190
191
192My::testParseParameters();
193
194
195{
196    title "isaFilename" ;
197    ok   isaFilename("abc"), "'abc' isaFilename";
198
199    ok ! isaFilename(undef), "undef ! isaFilename";
200    ok ! isaFilename([]),    "[] ! isaFilename";
201    $main::X = 1; $main::X = $main::X ;
202    ok ! isaFilename(*X),    "glob ! isaFilename";
203}
204
205{
206    title "whatIsInput" ;
207
208    my $lex = new LexFile my $out_file ;
209    open FH, ">$out_file" ;
210    is whatIsInput(*FH), 'handle', "Match filehandle" ;
211    close FH ;
212
213    my $stdin = '-';
214    is whatIsInput($stdin),       'handle',   "Match '-' as stdin";
215    #is $stdin,                    \*STDIN,    "'-' changed to *STDIN";
216    #isa_ok $stdin,                'IO::File',    "'-' changed to IO::File";
217    is whatIsInput("abc"),        'filename', "Match filename";
218    is whatIsInput(\"abc"),       'buffer',   "Match buffer";
219    is whatIsInput(sub { 1 }, 1), 'code',     "Match code";
220    is whatIsInput(sub { 1 }),    ''   ,      "Don't match code";
221
222}
223
224{
225    title "whatIsOutput" ;
226
227    my $lex = new LexFile my $out_file ;
228    open FH, ">$out_file" ;
229    is whatIsOutput(*FH), 'handle', "Match filehandle" ;
230    close FH ;
231
232    my $stdout = '-';
233    is whatIsOutput($stdout),     'handle',   "Match '-' as stdout";
234    #is $stdout,                   \*STDOUT,   "'-' changed to *STDOUT";
235    #isa_ok $stdout,               'IO::File',    "'-' changed to IO::File";
236    is whatIsOutput("abc"),        'filename', "Match filename";
237    is whatIsOutput(\"abc"),       'buffer',   "Match buffer";
238    is whatIsOutput(sub { 1 }, 1), 'code',     "Match code";
239    is whatIsOutput(sub { 1 }),    ''   ,      "Don't match code";
240
241}
242
243# U64
244
245{
246    title "U64" ;
247
248    my $x = new U64();
249    is $x->getHigh, 0, "  getHigh is 0";
250    is $x->getLow, 0, "  getLow is 0";
251    ok ! $x->is64bit(), " ! is64bit";
252
253    $x = new U64(1,2);
254    is $x->getHigh, 1, "  getHigh is 1";
255    is $x->getLow, 2, "  getLow is 2";
256    ok $x->is64bit(), " is64bit";
257
258    $x = new U64(0xFFFFFFFF,2);
259    is $x->getHigh, 0xFFFFFFFF, "  getHigh is 0xFFFFFFFF";
260    is $x->getLow, 2, "  getLow is 2";
261    ok $x->is64bit(), " is64bit";
262
263    $x = new U64(7, 0xFFFFFFFF);
264    is $x->getHigh, 7, "  getHigh is 7";
265    is $x->getLow, 0xFFFFFFFF, "  getLow is 0xFFFFFFFF";
266    ok $x->is64bit(), " is64bit";
267
268    $x = new U64(666);
269    is $x->getHigh, 0, "  getHigh is 0";
270    is $x->getLow, 666, "  getLow is 666";
271    ok ! $x->is64bit(), " ! is64bit";
272
273    title "U64 - add" ;
274
275    $x = new U64(0, 1);
276    is $x->getHigh, 0, "  getHigh is 0";
277    is $x->getLow, 1, "  getLow is 1";
278    ok ! $x->is64bit(), " ! is64bit";
279
280    $x->add(1);
281    is $x->getHigh, 0, "  getHigh is 0";
282    is $x->getLow, 2, "  getLow is 2";
283    ok ! $x->is64bit(), " ! is64bit";
284
285    $x = new U64(0, 0xFFFFFFFE);
286    is $x->getHigh, 0, "  getHigh is 0";
287    is $x->getLow, 0xFFFFFFFE, "  getLow is 0xFFFFFFFE";
288    is $x->get32bit(),  0xFFFFFFFE, "  get32bit is 0xFFFFFFFE";
289    is $x->get64bit(),  0xFFFFFFFE, "  get64bit is 0xFFFFFFFE";
290    ok ! $x->is64bit(), " ! is64bit";
291
292    $x->add(1);
293    is $x->getHigh, 0, "  getHigh is 0";
294    is $x->getLow, 0xFFFFFFFF, "  getLow is 0xFFFFFFFF";
295    is $x->get32bit(),  0xFFFFFFFF, "  get32bit is 0xFFFFFFFF";
296    is $x->get64bit(),  0xFFFFFFFF, "  get64bit is 0xFFFFFFFF";
297    ok ! $x->is64bit(), " ! is64bit";
298
299    $x->add(1);
300    is $x->getHigh, 1, "  getHigh is 1";
301    is $x->getLow, 0, "  getLow is 0";
302    is $x->get32bit(),  0x0, "  get32bit is 0x0";
303    is $x->get64bit(), 0xFFFFFFFF+1, "  get64bit is 0x100000000";
304    ok $x->is64bit(), " is64bit";
305
306    $x->add(1);
307    is $x->getHigh, 1, "  getHigh is 1";
308    is $x->getLow, 1, "  getLow is 1";
309    is $x->get32bit(),  0x1, "  get32bit is 0x1";
310    is $x->get64bit(),  0xFFFFFFFF+2, "  get64bit is 0x100000001";
311    ok $x->is64bit(), " is64bit";
312
313    $x->add(1);
314    is $x->getHigh, 1, "  getHigh is 1";
315    is $x->getLow, 2, "  getLow is 1";
316    is $x->get32bit(),  0x2, "  get32bit is 0x2";
317    is $x->get64bit(),  0xFFFFFFFF+3, "  get64bit is 0x100000002";
318    ok $x->is64bit(), " is64bit";
319
320    $x = new U64(1, 0xFFFFFFFE);
321    my $y = new U64(2, 3);
322
323    $x->add($y);
324    is $x->getHigh, 4, "  getHigh is 4";
325    is $x->getLow, 1, "  getLow is 1";
326    ok $x->is64bit(), " is64bit";
327
328    title "U64 - subtract" ;
329
330    $x = new U64(0, 1);
331    is $x->getHigh, 0, "  getHigh is 0";
332    is $x->getLow, 1, "  getLow is 1";
333    ok ! $x->is64bit(), " ! is64bit";
334
335    $x->subtract(1);
336    is $x->getHigh, 0, "  getHigh is 0";
337    is $x->getLow, 0, "  getLow is 0";
338    ok ! $x->is64bit(), " ! is64bit";
339
340    $x = new U64(1, 0);
341    is $x->getHigh, 1, "  getHigh is 1";
342    is $x->getLow, 0, "  getLow is 0";
343    is $x->get32bit(),  0, "  get32bit is 0xFFFFFFFE";
344    is $x->get64bit(),  0xFFFFFFFF+1, "  get64bit is 0x100000000";
345    ok $x->is64bit(), " is64bit";
346
347    $x->subtract(1);
348    is $x->getHigh, 0, "  getHigh is 0";
349    is $x->getLow, 0xFFFFFFFF, "  getLow is 0xFFFFFFFF";
350    is $x->get32bit(),  0xFFFFFFFF, "  get32bit is 0xFFFFFFFF";
351    is $x->get64bit(),  0xFFFFFFFF, "  get64bit is 0xFFFFFFFF";
352    ok ! $x->is64bit(), " ! is64bit";
353
354    $x = new U64(2, 2);
355    $y = new U64(1, 3);
356
357    $x->subtract($y);
358    is $x->getHigh, 0, "  getHigh is 0";
359    is $x->getLow, 0xFFFFFFFF, "  getLow is 1";
360    ok ! $x->is64bit(), " ! is64bit";
361
362    $x = new U64(0x01CADCE2, 0x4E815983);
363    $y = new U64(0x19DB1DE, 0xD53E8000); # NTFS to Unix time delta
364
365    $x->subtract($y);
366    is $x->getHigh, 0x2D2B03, "  getHigh is 2D2B03";
367    is $x->getLow, 0x7942D983, "  getLow is 7942D983";
368    ok $x->is64bit(), " is64bit";
369
370    title "U64 - equal" ;
371
372    $x = new U64(0, 1);
373    is $x->getHigh, 0, "  getHigh is 0";
374    is $x->getLow, 1, "  getLow is 1";
375    ok ! $x->is64bit(), " ! is64bit";
376
377    $y = new U64(0, 1);
378    is $y->getHigh, 0, "  getHigh is 0";
379    is $y->getLow, 1, "  getLow is 1";
380    ok ! $y->is64bit(), " ! is64bit";
381
382    my $z = new U64(0, 2);
383    is $z->getHigh, 0, "  getHigh is 0";
384    is $z->getLow, 2, "  getLow is 2";
385    ok ! $z->is64bit(), " ! is64bit";
386
387    ok $x->equal($y), "  equal";
388    ok !$x->equal($z), "  ! equal";
389
390    title "U64 - clone" ;
391    $x = new U64(21, 77);
392    $z =  U64::clone($x);
393    is $z->getHigh, 21, "  getHigh is 21";
394    is $z->getLow, 77, "  getLow is 77";
395
396    title "U64 - cmp.gt" ;
397    $x = new U64 1;
398    $y = new U64 0;
399    cmp_ok $x->cmp($y), '>', 0, "  cmp > 0";
400    is $x->gt($y), 1, "  gt";
401    cmp_ok $y->cmp($x), '<', 0, "  cmp < 0";
402
403}
404