git.maemo.org Git - pkg-perl/blob - deb-src/libio-compress-base-perl/libio-compress-base-perl-2.012/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 => 78 + $extra ;
  23
  24     use_ok('Scalar::Util');
  25     use_ok('IO::Compress::Base::Common');
  26 }
  27
  28
  29 ok gotScalarUtilXS(), "Got XS Version of Scalar::Util"
  30     or diag <<EOM;
  31 You don't have the XS version of Scalar::Util
  32 EOM
  33
  34 # Compress::Zlib::Common;
  35
  36 sub 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' => [1, 1, 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' => [1, 1, 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' => [1, 1, 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' => [1, 1, Parse_signed, 0]}, Fred => 'abc') ; };
  63     like $@, mkErr("Parameter 'Fred' must be a signed int, got 'abc'"),
  64             "wanted signed, got 'abc'";
  65
  66
  67     SKIP:
  68     {
  69         use Config;
  70
  71         skip 'readonly + threads', 1
  72             if $Config{useithreads};
  73
  74         eval { ParseParameters(1, {'Fred' => [1, 1, Parse_writable_scalar, 0]}, Fred => 'abc') ; };
  75         like $@, mkErr("Parameter 'Fred' not writable"),
  76                 "wanted writable, got readonly";
  77     }
  78
  79     my @xx;
  80     eval { ParseParameters(1, {'Fred' => [1, 1, Parse_writable_scalar, 0]}, Fred => \@xx) ; };
  81     like $@, mkErr("Parameter 'Fred' not a scalar reference"),
  82             "wanted scalar reference";
  83
  84     local *ABC;
  85     eval { ParseParameters(1, {'Fred' => [1, 1, Parse_writable_scalar, 0]}, Fred => *ABC) ; };
  86     like $@, mkErr("Parameter 'Fred' not a scalar"),
  87             "wanted scalar";
  88
  89     #eval { ParseParameters(1, {'Fred' => [1, 1, Parse_any|Parse_multiple, 0]}, Fred => 1, Fred => 2) ; };
  90     #like $@, mkErr("Muliple instances of 'Fred' found"),
  91         #"wanted scalar";
  92
  93     ok 1;
  94
  95     my $got = ParseParameters(1, {'Fred' => [1, 1, 0x1000000, 0]}, Fred => 'abc') ;
  96     is $got->value('Fred'), "abc", "other" ;
  97
  98     $got = ParseParameters(1, {'Fred' => [0, 1, Parse_any, undef]}, Fred =>
  99 undef) ;
 100     ok $got->parsed('Fred'), "undef" ;
 101     ok ! defined $got->value('Fred'), "undef" ;
 102
 103     $got = ParseParameters(1, {'Fred' => [0, 1, Parse_string, undef]}, Fred =>
 104 undef) ;
 105     ok $got->parsed('Fred'), "undef" ;
 106     is $got->value('Fred'), "", "empty string" ;
 107
 108     my $xx;
 109     $got = ParseParameters(1, {'Fred' => [1, 1, Parse_writable_scalar, undef]}, Fred => $xx) ;
 110
 111     ok $got->parsed('Fred'), "parsed" ;
 112     my $xx_ref = $got->value('Fred');
 113     $$xx_ref = 77 ;
 114     is $xx, 77;
 115
 116     $got = ParseParameters(1, {'Fred' => [1, 1, Parse_writable_scalar, undef]}, Fred => \$xx) ;
 117
 118     ok $got->parsed('Fred'), "parsed" ;
 119     $xx_ref = $got->value('Fred');
 120     $$xx_ref = 666 ;
 121     is $xx, 666;
 122
 123 #    my $got1 = ParseParameters(1, {'Fred' => [1, 1, Parse_writable_scalar, undef]}, $got) ;
 124 #    ok $got->parsed('Fred'), "parsed" ;
 125 #    $xx_ref = $got->value('Fred');
 126 #    $$xx_ref = 666 ;
 127 #    is $xx, 666;
 128 }
 129
 130 My::testParseParameters();
 131
 132
 133 {
 134     title "isaFilename" ;
 135     ok   isaFilename("abc"), "'abc' isaFilename";
 136
 137     ok ! isaFilename(undef), "undef ! isaFilename";
 138     ok ! isaFilename([]),    "[] ! isaFilename";
 139     $main::X = 1; $main::X = $main::X ;
 140     ok ! isaFilename(*X),    "glob ! isaFilename";
 141 }
 142
 143 {
 144     title "whatIsInput" ;
 145
 146     my $lex = new LexFile my $out_file ;
 147     open FH, ">$out_file" ;
 148     is whatIsInput(*FH), 'handle', "Match filehandle" ;
 149     close FH ;
 150
 151     my $stdin = '-';
 152     is whatIsInput($stdin),       'handle',   "Match '-' as stdin";
 153     #is $stdin,                    \*STDIN,    "'-' changed to *STDIN";
 154     #isa_ok $stdin,                'IO::File',    "'-' changed to IO::File";
 155     is whatIsInput("abc"),        'filename', "Match filename";
 156     is whatIsInput(\"abc"),       'buffer',   "Match buffer";
 157     is whatIsInput(sub { 1 }, 1), 'code',     "Match code";
 158     is whatIsInput(sub { 1 }),    ''   ,      "Don't match code";
 159
 160 }
 161
 162 {
 163     title "whatIsOutput" ;
 164
 165     my $lex = new LexFile my $out_file ;
 166     open FH, ">$out_file" ;
 167     is whatIsOutput(*FH), 'handle', "Match filehandle" ;
 168     close FH ;
 169
 170     my $stdout = '-';
 171     is whatIsOutput($stdout),     'handle',   "Match '-' as stdout";
 172     #is $stdout,                   \*STDOUT,   "'-' changed to *STDOUT";
 173     #isa_ok $stdout,               'IO::File',    "'-' changed to IO::File";
 174     is whatIsOutput("abc"),        'filename', "Match filename";
 175     is whatIsOutput(\"abc"),       'buffer',   "Match buffer";
 176     is whatIsOutput(sub { 1 }, 1), 'code',     "Match code";
 177     is whatIsOutput(sub { 1 }),    ''   ,      "Don't match code";
 178
 179 }
 180
 181 # U64
 182
 183 {
 184     title "U64" ;
 185
 186     my $x = new U64();
 187     is $x->getHigh, 0, "  getHigh is 0";
 188     is $x->getLow, 0, "  getLow is 0";
 189
 190     $x = new U64(1,2);
 191     $x = new U64(1,2);
 192     is $x->getHigh, 1, "  getHigh is 1";
 193     is $x->getLow, 2, "  getLow is 2";
 194
 195     $x = new U64(0xFFFFFFFF,2);
 196     is $x->getHigh, 0xFFFFFFFF, "  getHigh is 0xFFFFFFFF";
 197     is $x->getLow, 2, "  getLow is 2";
 198
 199     $x = new U64(7, 0xFFFFFFFF);
 200     is $x->getHigh, 7, "  getHigh is 7";
 201     is $x->getLow, 0xFFFFFFFF, "  getLow is 0xFFFFFFFF";
 202
 203     $x = new U64(666);
 204     is $x->getHigh, 0, "  getHigh is 0";
 205     is $x->getLow, 666, "  getLow is 666";
 206
 207     title "U64 - add" ;
 208
 209     $x = new U64(0, 1);
 210     is $x->getHigh, 0, "  getHigh is 0";
 211     is $x->getLow, 1, "  getLow is 1";
 212
 213     $x->add(1);
 214     is $x->getHigh, 0, "  getHigh is 0";
 215     is $x->getLow, 2, "  getLow is 2";
 216
 217     $x = new U64(0, 0xFFFFFFFE);
 218     is $x->getHigh, 0, "  getHigh is 0";
 219     is $x->getLow, 0xFFFFFFFE, "  getLow is 0xFFFFFFFE";
 220
 221     $x->add(1);
 222     is $x->getHigh, 0, "  getHigh is 0";
 223     is $x->getLow, 0xFFFFFFFF, "  getLow is 0xFFFFFFFF";
 224
 225     $x->add(1);
 226     is $x->getHigh, 1, "  getHigh is 1";
 227     is $x->getLow, 0, "  getLow is 0";
 228
 229     $x->add(1);
 230     is $x->getHigh, 1, "  getHigh is 1";
 231     is $x->getLow, 1, "  getLow is 1";
 232
 233     $x = new U64(1, 0xFFFFFFFE);
 234     my $y = new U64(2, 3);
 235
 236     $x->add($y);
 237     is $x->getHigh, 4, "  getHigh is 4";
 238     is $x->getLow, 1, "  getLow is 1";
 239
 240     title "U64 - equal" ;
 241
 242     $x = new U64(0, 1);
 243     is $x->getHigh, 0, "  getHigh is 0";
 244     is $x->getLow, 1, "  getLow is 1";
 245
 246     $y = new U64(0, 1);
 247     is $x->getHigh, 0, "  getHigh is 0";
 248     is $x->getLow, 1, "  getLow is 1";
 249
 250     my $z = new U64(0, 2);
 251     is $x->getHigh, 0, "  getHigh is 0";
 252     is $x->getLow, 1, "  getLow is 1";
 253
 254     ok $x->equal($y), "  equal";
 255     ok !$x->equal($z), "  ! equal";
 256
 257     title "U64 - pack_V" ;
 258 }