t/native_pbc/header.t

   1 #! perl
   2 # Copyright (C) 2001-2005, The Perl Foundation.
   3 # $Id$
   4
   5 use strict;
   6 use warnings;
   7 use lib qw( . lib ../lib ../../lib );
   8 use Test::More;
   9 use Parrot::Test skip_all => 'ongoing PBC format changes';
  10
  11 use File::Temp;
  12 use Parrot::Config;
  13
  14 =head1 NAME
  15
  16 t/native_pbc/header.t - PBC header format
  17
  18 =head1 SYNOPSIS
  19
  20         % prove t/native_pbc/header.t
  21
  22 =head1 DESCRIPTION
  23
  24 Tests the layout of the PBC header.
  25
  26 =cut
  27
  28 # idea stolen from t/pmc/sub.t
  29 my $tmppasm = File::Temp->new( UNLINK => 1, SUFFIX => '.pasm' );
  30 print $tmppasm <<END;
  31 set I0, 0
  32 END
  33 $tmppasm->flush;
  34 my $tmppbc = File::Temp->new( UNLINK => 1, SUFFIX => '.pbc' );
  35 system(".$PConfig{slash}parrot$PConfig{exe} -o $tmppbc $tmppasm");
  36 my $pbc = slurp_file($tmppbc);
  37
  38 my @fields = qw(
  39     magic
  40     wordsize
  41     byteorder
  42     major
  43     minor
  44     intval
  45     floattype
  46     fingerprint
  47     padding
  48 );
  49
  50 my %h;
  51 @h{@fields} = unpack "a8CCCCCCa10a8", $pbc;
  52
  53 is( $h{magic}, "\xfe\x50\x42\x43\x0a\x1a\x0a\cD", "magic string" );
  54 ok( $h{wordsize} < 2,  "wordsize" );
  55 ok( $h{byteorder} < 2, "byteorder" );
  56 is( $h{major}, $PConfig{MAJOR}, "major version" );
  57 is( $h{minor}, $PConfig{MINOR}, "minor version" );
  58 ok( $h{intval} == 3 || $h{intval} == 4 || $h{intval} == 8, "intval" );
  59 ok( $h{floattype} < 4, "floattype" );
  60 is( $h{padding}, pack("x7")."\cA", "NULL padding" );
  61
  62 # Local Variables:
  63 #   mode: cperl
  64 #   cperl-indent-level: 4
  65 #   fill-column: 100
  66 # End:
  67 # vim: expandtab shiftwidth=4: