Commit | Line | Data |
25f0751f |
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 | |
c70c1701 |
22 | plan tests => 33 + $extra ; |
25f0751f |
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 | |
c70c1701 |
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 | |
25f0751f |
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 | } |