File: 226_indexed.t

package info (click to toggle)
libconvert-binary-c-perl 0.74-1
  • links: PTS, VCS
  • area: main
  • in suites: squeeze
  • size: 9,100 kB
  • ctags: 21,416
  • sloc: ansic: 63,666; perl: 18,582; yacc: 2,143; makefile: 44
file content (95 lines) | stat: -rw-r--r-- 2,496 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
################################################################################
#
# $Project: /Convert-Binary-C $
# $Author: mhx $
# $Date: 2009/03/15 04:10:57 +0100 $
# $Revision: 13 $
# $Source: /tests/226_indexed.t $
#
################################################################################
#
# Copyright (c) 2002-2009 Marcus Holland-Moritz. All rights reserved.
# This program is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.
#
################################################################################

use Test;
use Convert::Binary::C @ARGV;

$^W = 1;

BEGIN { plan tests => 45 }

my $reason = do {
  my @w;
  local $SIG{__WARN__} = sub { push @w, @_ };
  my $c = new Convert::Binary::C OrderMembers => 1;
  (grep /Couldn't load a module for member ordering/, @w)
  ? "member ordering requires indexed hashes" : "";
};

my $order = $reason ? 0 : 1;

my @keys = grep !/do|if/, 'aa' .. 'zz';
my $members = join "\n", map "unsigned char $_;", @keys;

my $u = new Convert::Binary::C OrderMembers => 0;
my $o = new Convert::Binary::C OrderMembers => $order;

for my $c ( $u, $o ) {
  $c->parse( <<ENDC );
  struct order {
    $members
    struct {
      $members
    } foo[2];
  };
ENDC
}

my $data = pack 'C*', map { rand(256) } 1 .. $u->sizeof('order');

my $unp_u = $u->unpack( 'order', $data );
my $unp_o = $o->unpack( 'order', $data );

my $fail = 0;
my $keys = join ',', @keys;

for( @keys ) {
  $unp_u->{$_} == $unp_o->{$_} or $fail++;
  $unp_u->{foo}[0]{$_} == $unp_o->{foo}[0]{$_} or $fail++;
  $unp_u->{foo}[1]{$_} == $unp_o->{foo}[1]{$_} or $fail++;
}

ok( $fail, 0 );

skip( $reason, $keys.",foo", join(',', keys %$unp_o) );
skip( $reason, $keys, join(',', keys %{$unp_o->{foo}[0]}) );
skip( $reason, $keys, join(',', keys %{$unp_o->{foo}[1]}) );

my $list = pack 'C*', map { rand(256) } 1 .. 10*$u->sizeof('order');

my @unp_u = $u->unpack('order', $list);
my @unp_o = $o->unpack('order', $list);

ok(scalar @unp_u, scalar @unp_o);

for my $i (0 .. $#unp_u) {
  $unp_u = $unp_u[$i];
  $unp_o = $unp_o[$i];

  $fail = 0;

  for( @keys ) {
    $unp_u->{$_} == $unp_o->{$_} or $fail++;
    $unp_u->{foo}[0]{$_} == $unp_o->{foo}[0]{$_} or $fail++;
    $unp_u->{foo}[1]{$_} == $unp_o->{foo}[1]{$_} or $fail++;
  }
  
  ok( $fail, 0 );

  skip( $reason, $keys.",foo", join(',', keys %$unp_o) );
  skip( $reason, $keys, join(',', keys %{$unp_o->{foo}[0]}) );
  skip( $reason, $keys, join(',', keys %{$unp_o->{foo}[1]}) );
}