#! perl
# Copyright: 2001-2005 The Perl Foundation.  All Rights Reserved.
# $Id: header.t 10144 2005-11-23 02:24:38Z particle $

use strict;
use warnings;
use lib qw( . lib ../lib ../../lib );
use Test::More;
use Parrot::Test tests => 8;

use File::Temp;
use Parrot::Config;


=head1 NAME

t/native_pbc/header.t - PBC header format

=head1 SYNOPSIS

	% prove t/native_pbc/header.t

=head1 DESCRIPTION

Tests the layout of the PBC header.

=cut


SKIP: {
    skip "new header format not yet implemented", 8;
    # idea stolen from t/pmc/sub.t
    my $tmppasm = File::Temp->new(UNLINK => 1, SUFFIX => '.pasm');
    print $tmppasm <<END;
    set I0, 0
END
    $tmppasm->flush;
    my $tmppbc = File::Temp->new(UNLINK => 1, SUFFIX => '.pbc');
    system(".$PConfig{slash}parrot$PConfig{exe} -o $tmppbc $tmppasm");
    my $pbc = slurp_file($tmppbc);

my @fields = qw(
    magic
    wordsize
    byteorder
    major
    minor
    intval
    floattype
    fingerprint
    padding
);

    my %h;
    @h{@fields} = unpack "a8CCCCCCa10a8", $pbc;

    is($h{magic}, "\xfe\x50\x42\x43\x0d\x0a\x1a\x0a", "magic string");
    ok($h{wordsize} < 2, "wordsize");
    ok($h{byteorder} < 2, "byteorder");
    is($h{major}, $PConfig{MAJOR}, "major version");
    is($h{minor}, $PConfig{MINOR}, "minor version");
    ok($h{intval} == 4 || $h{intval} == 8, "intval");
    ok($h{floattype} < 2, "floattype");
    is($h{padding}, pack "x8", "NULL padding");
}
