view release on metacpan or  search on metacpan

tests/602_threads.t  view on Meta::CPAN

  Convert::Binary::C->new->parse('');  # allocate/free some memory
  @t = 1 .. NUM_THREADS
}

skip($have_threads ? '' : $reason,
     $have_threads ? $_->join : $_, '', "thread failed") for @t;

sub task
{
  my $arg = shift;
  my $p;

  eval {
    $p = Convert::Binary::C->new(
      %$CCCFG,
      EnumSize       => 0,
    );
    if ($arg % 2) {
      print "# parse_file ($arg) called\n";
      $p->parse_file('tests/include/include.c');
      print "# parse_file ($arg) returned\n";
    }
    else {
      open FH, "tests/include/include.c" or die;
      my $code = do { local $/; <FH> };
      close FH;
      print "# parse ($arg) called\n";
      $p->parse($code);
      print "# parse ($arg) returned\n";
    }
  };

  $@ and return $@;

  # some simplified checks from the parse test

  my @enum_ids     = $p->enum_names;
  my @compound_ids = $p->compound_names;
  my @struct_ids   = $p->struct_names;
  my @union_ids    = $p->union_names;
  my @typedef_ids  = $p->typedef_names;

  @enum_ids     ==  1 or return "incorrect number of enum identifiers";
  @compound_ids == 20 or return "incorrect number of compound identifiers";
  @struct_ids   == 19 or return "incorrect number of struct identifiers";
  @union_ids    ==  1 or return "incorrect number of union identifiers";
  @typedef_ids  == 54 or return "incorrect number of typedef identifiers";

  my @enums     = $p->enum;
  my @compounds = $p->compound;
  my @structs   = $p->struct;
  my @unions    = $p->union;
  my @typedefs  = $p->typedef;

  @enums      == 12 or return "incorrect number of enums";
  @compounds  == 26 or return "incorrect number of compounds";
  @structs    == 20 or return "incorrect number of structs";
  @unions     ==  6 or return "incorrect number of unions";
  @typedefs   == 54 or return "incorrect number of typedefs";

  my %size = do { local (@ARGV, $/) = ('tests/include/sizeof.pl'); eval <> };
  my $max_size = 0;
  my @fail = ();

  local $SIG{__WARN__} = sub {
    print "# unexpected warning: $_[0]";
    push @fail, $_[0];
  };

  for my $t (keys %size) {
    my $s = eval { $p->sizeof($t) };

    if ($@) {
      print "# sizeof failed for '$t': $@\n";
    }
    elsif ($size{$t} != $s) {
      print "# incorrect size for '$t' (expected $size{$t}, got $s)\n";
    }
    else {
      $max_size = $s if $s > $max_size;
      next;
    }

    push @fail, $t unless $s == $size{$t}
  }

  @fail == 0 or return "size test failed for [@fail]";

  # don't use random data as it may cause failures
  # for floating point values
  my $data = pack 'C*', map { $_ & 0xFF } 1 .. $max_size;
  @fail = ();

  for my $id (@enum_ids, @compound_ids, @typedef_ids) {

    # skip long doubles
    next if grep { $id eq $_ } qw( __convert_long_double float_t double_t );

    my $x = eval { $p->unpack($id, $data) };

    if( $@ ) {
      print "# ($arg) unpack failed for '$id': $@\n";
      push @fail, $id;
      next;
    }

    my $packed = eval { $p->pack($id, $x) };

    if ($@) {
      print "# ($arg) pack failed for '$id': $@\n";
      push @fail, $id;
      next;
    }

    unless (chkpack($data, $packed)) {
      print "# ($arg) inconsistent pack/unpack data for '$id'\n";
      push @fail, $id;
      next;
    }
  }