Ticket #357: tt357-better_native_pbc_t.patch

File tt357-better_native_pbc_t.patch, 27.3 KB (added by rurban, 5 years ago)

now independent of TT#254 64bit fixes

  • lib/Parrot/BuildUtil.pm

    old new  
    1212 
    1313=head1 DESCRIPTION 
    1414 
    15 This package holds three subroutines:  C<parrot_version()>, C<slurp_file>, 
    16 and C<generated_file_header>. Subroutines are not exported--each must be 
    17 requested by using a fully qualified name. 
     15This package holds pre-configure time subroutines, which are not exported 
     16and should not require Parrot::Config. 
     17Each must be requested by using a fully qualified name. 
    1818 
    1919=head1 SUBROUTINES 
    2020 
     
    134134    return $header; 
    135135} 
    136136 
    137 1; 
     137=item C<get_bc_version()> 
    138138 
    139 =back 
     139Return an array of ($bc_major, $bc_minor) from F<PBC_COMPAT>. 
     140This is used in the native_pbc tests. 
     141 
     142See also F<tools/dev/pbc_header.pl> and F<tools/build/pbcversion_h.pl>. 
    140143 
    141 =head1 AUTHOR 
     144=cut 
    142145 
    143 Gregor N. Purdy.  Revised by James E Keenan. 
     146sub get_bc_version { 
     147    my $compat_file = 'PBC_COMPAT'; 
     148    my ( $bc_major, $bc_minor ); 
     149    open my $IN, '<', $compat_file or die "Can't read $compat_file"; 
     150    while (<$IN>) { 
     151        if (/^(\d+)\.0*(\d+)/) { 
     152            ( $bc_major, $bc_minor ) = ( $1, $2 ); 
     153            last; 
     154        } 
     155    } 
     156    unless ( defined $bc_major && defined $bc_minor ) { 
     157        die "No bytecode version found in '$compat_file'."; 
     158    } 
     159    close $IN; 
     160    return ( $bc_major, $bc_minor ); 
     161} 
     162 
     1631; 
     164 
     165=back 
    144166 
    145167=cut 
    146168 
  • tools/build/pbcversion_h.pl

    old new  
    2121use warnings; 
    2222use strict; 
    2323use lib 'lib'; 
     24use Parrot::BuildUtil; 
    2425 
    25 my ( $major, $minor ); 
    26  
    27 my $compat_file = 'PBC_COMPAT'; 
    28 open my $IN, '<', $compat_file or die "Can't read $compat_file"; 
    29 while (<$IN>) { 
    30     if (/^(\d+)\.0*(\d+)/) { 
    31         ( $major, $minor ) = ( $1, $2 ); 
    32         last; 
    33     } 
    34 } 
    35 close $IN; 
     26my ( $major, $minor ) = Parrot::BuildUtil::get_bc_version(); 
    3627 
    3728unless ( defined $major && defined $minor ) { 
    38     die "No bytecode version found in '$compat_file'."; 
     29    die "No bytecode version found in 'PBC_COMPAT'."; 
    3930} 
    4031 
    4132print << "EOF"; 
    4233/* ex: set ro: 
    4334 * !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!! 
    4435 * 
    45  * This file is generated automatically from '$compat_file' 
     36 * This file is generated automatically from 'PBC_COMPAT' 
    4637 * by $0. 
    4738 * 
    4839 * Any changes made here will be lost! 
  • t/native_pbc/integer.t

    old new  
    77use lib qw( . lib ../lib ../../lib ); 
    88use Test::More; 
    99use Parrot::Config; 
     10use Parrot::BuildUtil; 
    1011 
    11 use Parrot::Test tests => 5; 
     12use Parrot::Test tests => 7; 
    1213 
    1314=head1 NAME 
    1415 
     
    2223 
    2324Tests word-size/float-type/endian-ness for different architectures. 
    2425 
    25 These tests usually only work on releases, not on svn checkouts 
    26 and if every release has updated native pbc test files. 
    27  
    28 See F<tools/dev/mk_native_pbc> to create the platform-specific native pbcs. 
     26These tests usually only work on updated native pbc test files. 
     27See F<tools/dev/mk_native_pbc> to create the platform-specific 
     28native pbcs. 
    2929 
    3030=head1 PLATFORMS 
    3131 
    32   _1   i386 32 bit opcode_t, 32 bit intval 
    33        (linux-gcc-ix86, freebsd-gcc, cygwin) 
     32  _1   i386 32 bit opcode_t, 32 bit intval, 8 byte double 
     33       (linux-gcc-i386, freebsd-gcc, cygwin, ...) 
    3434 
    35   _2   i386 32 bit opcode_t, 32 bit intval, 12 bit long double 
    36        (linux-gcc-ix86) 
     35  _2   i386 32 bit opcode_t, 32 bit intval, 12 byte long double 
     36       (linux-gcc-i386 or cygwin with --floatval="long double") 
    3737 
    38   _3   PPC BE 32 bit opcode_t, 32 bit intval 
     38  _3   PPC BE 32 bit opcode_t, 32 bit intval, 8 byte double 
    3939       (darwin-ppc) 
    4040 
    41   _4   x86_64 12-bit double 64 bit opcode_t 
    42        (linux-gcc-x86_64 -m96bit-long-double) 
     41  _4   x86_64 64 bit opcode_t, 64 bit intval, 8 byte double 
     42       (linux-gcc-x86_64 resp. amd64, solaris-cc-64int) 
     43 
     44  _5   x86_64 64 bit opcode_t, 64 bit intval, 16 byte long double 
     45       (linux-gcc-x86_64, solaris-cc-64int --floatval="long double") 
    4346 
    44   _5   x86_64 16 bit long double 64 bit opcode_t 
    45        (linux-gcc-x86_64, solaris-cc-64int) 
     47  _6   big-endian 64 bit opcode_t, 64 bit intval, 8 byte double 
     48       (Sparc64/Solaris, MIPS irix or similar) 
    4649 
    47   _6   big-endian 64-bit 
    48        (MIPS irix or similar) 
     50  _7   big-endian 64 bit opcode_t, 64 bit intval, 16 byte long double 
     51       (Sparc64/Solaris --floatval="long double") 
    4952 
    5053=cut 
    5154 
     
    7780 
    7881=cut 
    7982 
     83my @archtest = qw(4_le 4_le 4_be 4_le 8_le 8_be 8_be); 
     84sub this_arch { 
     85    return $PConfig{intvalsize} 
     86      . "_" 
     87      . (substr($PConfig{byteorder},0,2) eq '12' ? "le" : "be"); 
     88} 
     89 
     90sub bc_version($) { 
     91    my $f = shift; 
     92    my $b; 
     93    open my $F, "<", "$f" or return "Can't open $f: $!"; 
     94    binmode $F; 
     95    seek $F, 14, 0; 
     96    read $F, $b, 8; 
     97    my ($bc_major, $bc_minor) = unpack "cc", $b; 
     98    return ($bc_major . "." . $bc_minor); 
     99} 
     100my ( $bc_major, $bc_minor ) = Parrot::BuildUtil::get_bc_version(); 
     101my $bc = ($bc_major . "." . $bc_minor); 
     102my $arch = this_arch(); 
     103# all should pass 
     104my $todo = {}; 
     105my $skip = {}; 
     106 
     107# expected result 
     108my $output = '270544960'; 
     109 
     110# test_pbc_integer(1, "i386 8-byte double float, 32 bit opcode_t"); 
     111sub test_pbc_integer { 
     112    my $id   = shift; 
     113    my $desc = shift; 
     114    my $file = "t/native_pbc/integer_$id.pbc"; 
     115    my $cvt = "$archtest[$id-1]=>$arch"; 
     116    my $skip_msg; 
     117    # check if this a platform where we can produce the needed file 
     118    if ($archtest[$id-1] eq $arch) { 
     119        $skip_msg = "Want to help? Regenerate $file " 
     120          . "with tools/dev/mk_native_pbc --noconf"; 
     121    } 
     122    else { 
     123        $skip_msg  = "$file is outdated. " 
     124          . "Need $archtest[$id-1] platform."; 
     125    } 
     126    # check if skip or todo 
     127  SKIP: { 
     128    if ( $skip->{$id} ) { 
     129        skip "$cvt not yet implemented", 1 
     130    } 
     131    elsif ( $todo->{$id} ) { 
     132        skip $skip_msg, 1 
     133          if ($bc ne bc_version($file)); 
     134        pbc_output_is( undef, $output, "$cvt $desc", 
     135                       todo => "$cvt yet untested, TT #357. " 
     136                       . "Please report success." ); 
     137    } 
     138    else { 
     139        skip $skip_msg, 1 
     140          if ($bc ne bc_version($file)); 
     141        pbc_output_is( undef, $output, "$cvt $desc" ); 
     142    } 
     143  } 
     144} 
     145 
    80146# execute the file t/native_pbc/integer_1.pbc 
    81147# 
    82148# any ordinary intel 386 linux, cygwin, mingw, MSWin32, ... 
     
    84150#         wordsize  = 4   (interpreter's wordsize/INTVAL = 4/4) 
    85151#         byteorder = 0   (interpreter's byteorder       = 0) 
    86152#         floattype = 0   (interpreter's NUMVAL_SIZE     = 8) 
    87 #         parrot-version 0.9.0, bytecode-version 3.34 
     153#         parrot-version 0.9.1, bytecode-version 3.36 
    88154#         UUID type = 0, UUID size = 0 
    89155#         no endianize, no opcode, no numval transform 
    90156#         dirformat = 1 
    91157# ] 
    92 TODO: { 
    93     local $TODO; 
    94     if ($PConfig{ptrsize} == 8) { 
    95         $TODO = "Known problem on 64bit with reading 32bit dirs. See TT #254" 
    96     } elsif ($PConfig{DEVEL}) { 
    97         $TODO = "devel versions are not guaranteed to succeed"; 
    98     } 
     158test_pbc_integer(1, "i386 8-byte double float, 32 bit opcode_t, 4-byte int"); 
    99159 
    100 pbc_output_is( undef, '270544960', "i386 32 bit opcode_t, 32 bit intval" ) 
    101     or diag "May need to regenerate t/native_pbc/integer_1.pbc; read test file"; 
    102  
    103 # adding --floatval='long double' 
     160# adding --floatval="long double" --jitcapable=0 
    104161# HEADER => [ 
    105162#         wordsize  = 4   (interpreter's wordsize/INTVAL = 4/4) 
    106163#         byteorder = 0   (interpreter's byteorder       = 0) 
    107164#         floattype = 1   (interpreter's NUMVAL_SIZE     = 12) 
    108 #         parrot-version 0.9.0, bytecode-version 3.34 
     165#         parrot-version 0.9.1, bytecode-version 3.36 
    109166#         UUID type = 0, UUID size = 0 
    110167#         no endianize, no opcode, no numval transform 
    111168#         dirformat = 1 
    112169# ] 
    113 pbc_output_is( undef, '270544960', "i386 32 bit opcode_t, 32 bit intval 12-byte long double" ) 
    114     or diag "May need to regenerate t/native_pbc/integer_2.pbc; read test file"; 
     170test_pbc_integer(2, "i386 12-byte double float, 32 bit opcode_t, 4-byte int"); 
    115171 
    116172# darwin/ppc: 
    117173# HEADER => [ 
     
    123179#         no endianize, no opcode, no numval transform 
    124180#         dirformat = 1 
    125181# ] 
    126  
    127 pbc_output_is(undef, '270544960', "PPC BE 32 bit opcode_t, 32 bit intval") 
    128     or diag "May need to regenerate t/native_pbc/integer_3.pbc; read test file"; 
    129  
    130 } 
    131  
    132 TODO: { 
    133     local $TODO; 
    134     if ($PConfig{ptrsize} == 4) { 
    135         $TODO = "Known problem on 32bit with reading 64bit dirs. See TT #254" 
    136         # Unknown PMC type to thaw 0 
    137     } elsif ($PConfig{DEVEL}) { 
    138         $TODO = "devel versions are not guaranteed to succeed"; 
    139     } 
     182test_pbc_integer(3, "PPC BE 32 bit opcode_t, 4-byte int"); 
    140183 
    141184# any ordinary 64-bit intel unix: 
    142185# HEADER => [ 
    143186#         wordsize  = 8   (interpreter's wordsize/INTVAL = 8/8) 
    144187#         byteorder = 0   (interpreter's byteorder       = 0) 
    145188#         floattype = 0   (interpreter's NUMVAL_SIZE     = 8) 
    146 #         parrot-version 0.9.0, bytecode-version 3.34 
     189#         parrot-version 0.9.1, bytecode-version 3.36 
    147190#         UUID type = 0, UUID size = 0 
    148191#         no endianize, no opcode, no numval transform 
    149192#         dirformat = 1 
    150193# ] 
     194test_pbc_integer(4, "i86_64 LE 64 bit opcode_t, 8-byte int, 8-byte double"); 
    151195 
    152 pbc_output_is(undef, '270544960', "i86_64 LE 64 bit opcode_t, 64 bit intval") 
    153     or diag "May need to regenerate t/native_pbc/integer_4.pbc; read test file"; 
    154  
    155 # adding --floatval='long double' 
     196# adding --floatval="long double" 
    156197# HEADER => [ 
    157198#         wordsize  = 8   (interpreter's wordsize/INTVAL = 8/8) 
    158199#         byteorder = 0   (interpreter's byteorder       = 0) 
     
    162203#         no endianize, no opcode, no numval transform 
    163204#         dirformat = 1 
    164205# ] 
     206test_pbc_integer(5, "i86_64 LE 64 bit opcode_t, 8-byte int, 16-byte double"); 
    165207 
    166 pbc_output_is(undef, '270544960', "i86_64 LE 64 bit opcode_t, 64 bit intval, 16-byte long double") 
    167     or diag "May need to regenerate t/native_pbc/integer_5.pbc; read test file"; 
    168  
    169 # Formerly following tests had been set up: 
    170 # pbc_output_is(undef, '270544960', "big-endian 64-bit (irix)"); 
    171 #    or diag "May need to regenerate t/native_pbc/integer_6.pbc; read test file"; 
     208# ppc/mips -m64 
     209# HEADER => [ 
     210#         wordsize  = 8   (interpreter's wordsize/INTVAL = 8/8) 
     211#         byteorder = 1   (interpreter's byteorder       = 0) 
     212#         floattype = 0   (interpreter's NUMVAL_SIZE     = 8) 
     213#         parrot-version 0.9.1, bytecode-version 3.35 
     214#         UUID type = 0, UUID size = 0 
     215#         *need* endianize, no opcode, no numval transform 
     216#         dirformat = 1 
     217# ] 
     218test_pbc_integer(6, "big-endian 64-bit, 8-byte int, 8-byte double"); 
    172219 
    173 } 
     220# ppc/mips -m64 --floatval="long double" 
     221test_pbc_integer(7, "big-endian 64-bit, 8-byte int, 16-byte double"); 
    174222 
    175223# Local Variables: 
    176224#   mode: cperl 
  • t/native_pbc/number.t

    old new  
    77use lib qw( . lib ../lib ../../lib ); 
    88use Test::More; 
    99use Parrot::Config; 
     10use Parrot::BuildUtil; 
    1011 
    11 use Parrot::Test tests => 5; 
     12use Parrot::Test tests => 7; 
    1213 
    1314=head1 NAME 
    1415 
     
    2223 
    2324Tests word-size/float-type/endian-ness for different architectures. 
    2425 
    25 These tests usually only work on releases, not on svn checkouts 
    26 and if every release has updated native pbc test files. 
    27  
    28 See F<tools/dev/mk_native_pbc> to create the platform-specific native pbcs. 
     26These tests usually only work on updated native pbc test files. 
     27See F<tools/dev/mk_native_pbc> to create the platform-specific 
     28native pbcs. 
    2929 
    3030=head1 PLATFORMS 
    3131 
    32   _1   i386 32 bit opcode_t, 32 bit intval   (linux-gcc-ix86, freebsd-gcc, cygwin) 
    33   _2   i386 32 bit opcode_t, 32 bit intval, 12 bit long double (linux-gcc-ix86) 
    34   _3   PPC BE 32 bit opcode_t, 32 bit intval  (darwin-ppc) 
    35   _4   x86_64 12-bit double 64 bit opcode_t   (linux-gcc-x86_64 -m96bit-long-double) 
    36   _5   x86_64 16 bit long double 64 bit opcode_t (linux-gcc-x86_64, solaris-cc-64int) 
    37   _6   big-endian 64-bit                     (MIPS irix or similar) 
     32  _1   i386 32 bit opcode_t, 32 bit intval, 8 byte double 
     33       (linux-gcc-i386, freebsd-gcc, cygwin, ...) 
     34 
     35  _2   i386 32 bit opcode_t, 32 bit intval, 12 byte long double 
     36       (linux-gcc-i386 or cygwin with --floatval="long double") 
     37 
     38  _3   PPC BE 32 bit opcode_t, 32 bit intval, 8 byte double 
     39       (darwin-ppc) 
     40 
     41  _4   x86_64 64 bit opcode_t, 64 bit intval, 8 byte double 
     42       (linux-gcc-x86_64 resp. amd64, solaris-cc-64int) 
     43 
     44  _5   x86_64 64 bit opcode_t, 64 bit intval, 16 byte long double 
     45       (linux-gcc-x86_64, solaris-cc-64int --floatval="long double") 
     46 
     47  _6   big-endian 64 bit opcode_t, 64 bit intval, 8 byte double 
     48       (Sparc64/Solaris, MIPS irix or similar) 
     49 
     50  _7   big-endian 64 bit opcode_t, 64 bit intval, 16 byte long double 
     51       (Sparc64/Solaris --floatval="long double") 
    3852 
    3953=cut 
    4054 
     55# tt #357: need better testmatrix for coverage overview 
     56# float conversion src: left-side (pbc) to dest: upper-side (platform) 
     57# 1: tested ok, 0: fails (skip), ?: not yet tested (todo) 
     58my $testmatrix = <<EOF; 
     59       8_le 12_le 16_le 8_be 16_be 
     608_le     1     1    ?     ?     ? 
     6112_le    1     1    ?     ?     ? 
     6216_le    1     1    1     ?     ? 
     638_be     1     1    ?     1     ? 
     6416_be    1     1    1     ?     1 
     65EOF 
     66 
    4167=begin comment 
    4268 
    4369# these are PBC files generated from t/op/number_1.pasm with 
     
    5581# - include the pbc_dump header info for reference 
    5682# - put the file into MANIFEST 
    5783# - add the file as binary (svn add) and commit it 
    58 # thanks -leo 
     84# thanks -leo and reini 
    5985 
    6086On test failures please add the output of 
    6187 
     
    6591 
    6692=cut 
    6793 
     94#       8_le 12_le 16_le 8_be 16_be 
     95#8_le     1     1    ?     ?     ? 
     96#12_le    1     1    ?     ?     ? 
     97#16_le    1     1    1     ?     ? 
     98#8_be     1     1    ?     1     ? 
     99#16_be    1     1    1     ?     1 
     100my $destarch = { '8_le'  => [1,4], '12_le' => [2], '16_le' => [5], 
     101                 '8_be'  => [3,6], '16_be' => [7] }; 
     102# the reverse: which tests for which arch 
     103my @archtest = qw(8_le 12_le 8_be 8_le 16_le 8_be 16_be); 
     104# @todo lists of tests for your architecture. 
     105# e.g. for arch 8_le => tests (8_be) => todo (3 6) 
     106sub generate_skip_list { 
     107    my $arch = shift; 
     108    my $check = shift; 
     109    my %skip; 
     110    my @lines = split /\n/, $testmatrix; 
     111    my @dest  = split /\s+/, shift @lines; 
     112    shift @dest unless $dest[0]; 
     113    my $i = 0; 
     114    my %cols  = map { $_ => $i++ } @dest; 
     115    my $col   = $cols{$arch};      # the column for our arch 
     116    for my $s (@lines) { 
     117        my @s  = split /\s+/, $s; 
     118        my $pbc = shift @s; 
     119        if ($s[$col] eq $check) { 
     120            for (@{$destarch->{$pbc}}) { $skip{$_}++ } 
     121        } 
     122    } 
     123    \%skip 
     124} 
     125# 16_le 
     126sub this_arch { 
     127    return $PConfig{numvalsize} 
     128      . "_" 
     129      . (substr($PConfig{byteorder},0,2) eq '12' ? "le" : "be"); 
     130} 
     131 
     132sub bc_version($) { 
     133    my $f = shift; 
     134    my $b; 
     135    open my $F, "<", "$f" or return "Can't open $f: $!"; 
     136    binmode $F; 
     137    seek $F, 14, 0; 
     138    read $F, $b, 8; 
     139    my ($bc_major, $bc_minor) = unpack "cc", $b; 
     140    return ($bc_major . "." . $bc_minor); 
     141} 
     142my ( $bc_major, $bc_minor ) = Parrot::BuildUtil::get_bc_version(); 
     143my $bc = ($bc_major . "." . $bc_minor); 
     144my $arch = this_arch(); 
     145my $todo = generate_skip_list($arch, '?'); 
     146my $skip = generate_skip_list($arch, '0'); 
     147 
    68148my $output = << 'END_OUTPUT'; 
    691491 
    701504 
     
    941741.12589990684262e+15 
    95175END_OUTPUT 
    96176 
    97 # execute t/native_pbc/number_1.pbc 
     177# test_pbc_number(1, "i386 8-byte double float, 32 bit opcode_t"); 
     178sub test_pbc_number { 
     179    my $id   = shift; 
     180    my $desc = shift; 
     181    my $cvt = "$archtest[$id-1]=>$arch"; 
     182    my $skip_msg; 
     183    # check if this a platform where we can produce the needed file 
     184    if ($archtest[$id-1] eq $arch) { 
     185        $skip_msg = "Want to help? Regenerate t/native_pbc/number_$id.pbc " 
     186          . "with tools/dev/mk_native_pbc --noconf"; 
     187    } 
     188    else { 
     189        $skip_msg  = "t/native_pbc/number_$id.pbc is outdated. " 
     190          . "Need $archtest[$id-1] platform."; 
     191    } 
     192    # check if skip or todo 
     193  SKIP: { 
     194    if ( $skip->{$id} ) { 
     195        skip "$cvt not yet implemented", 1 
     196    } 
     197    elsif ( $todo->{$id} ) { 
     198        skip $skip_msg, 1 
     199          if ($bc ne bc_version("t/native_pbc/number_$id.pbc")); 
     200        pbc_output_is( undef, $output, "$cvt $desc", 
     201                       todo => "$cvt yet untested, TT #357. " 
     202                       . "Please report success." ); 
     203    } 
     204    else { 
     205        skip $skip_msg, 1 
     206          if ($bc ne bc_version("t/native_pbc/number_$id.pbc")); 
     207        pbc_output_is( undef, $output, "$cvt $desc" ); 
     208    } 
     209  } 
     210} 
     211 
     212# execute t/native_pbc/number_*.pbc 
    98213# 
    99214# any ordinary intel 386 linux, cygwin, mingw, MSWin32, ... 
    100215# HEADER => [ 
    101216#         wordsize  = 4   (interpreter's wordsize/INTVAL = 4/4) 
    102217#         byteorder = 0   (interpreter's byteorder       = 0) 
    103218#         floattype = 0   (interpreter's NUMVAL_SIZE     = 8) 
    104 #         parrot-version 0.9.0, bytecode-version 3.34 
     219#         parrot-version 0.9.1, bytecode-version 3.36 
    105220#         UUID type = 0, UUID size = 0 
    106221#         no endianize, no opcode, no numval transform 
    107222#         dirformat = 1 
    108223# ] 
    109 TODO: { 
    110     local $TODO; 
    111     if ($PConfig{ptrsize} == 8) { 
    112         $TODO = "Known problem on 64bit with reading 32bit dirs. See TT #254" 
    113     } elsif ($PConfig{DEVEL}) { 
    114         $TODO = "devel versions are not guaranteed to succeed"; 
    115     } 
    116  
    117 pbc_output_is( undef, $output, "i386 double float 32 bit opcode_t" ) 
    118     or diag "May need to regenerate t/native_pbc/number_1.pbc; read test file"; 
     224test_pbc_number(1, "i386 8-byte double float, 32 bit opcode_t"); 
    119225 
    120226# HEADER => [ 
    121227#         wordsize  = 4   (interpreter's wordsize/INTVAL = 4/4) 
    122228#         byteorder = 0   (interpreter's byteorder       = 0) 
    123229#         floattype = 1   (interpreter's NUMVAL_SIZE     = 12) 
    124 #         parrot-version 0.9.0, bytecode-version 3.34 
     230#         parrot-version 0.9.1, bytecode-version 3.36 
    125231#         UUID type = 0, UUID size = 0 
    126232#         no endianize, no opcode, no numval transform 
    127233#         dirformat = 1 
    128234# ] 
    129 pbc_output_is( undef, $output, "i386 long double float 32 bit opcode_t") 
    130     or diag "May need to regenerate t/native_pbc/number_2.pbc; read test file"; 
     235test_pbc_number(2, "i386 12-byte long double float, 32 bit opcode_t"); 
    131236 
    132237# darwin/ppc: 
    133238# HEADER => [ 
     
    139244#         no endianize, no opcode, no numval transform 
    140245#         dirformat = 1 
    141246# ] 
    142  
    143 pbc_output_is(undef, $output, "PPC double float 32 bit BE opcode_t") 
    144     or diag "May need to regenerate t/native_pbc/number_3.pbc; read test file"; 
    145 } 
    146  
    147 TODO: { 
    148     local $TODO; 
    149     if ($PConfig{ptrsize} == 4) { 
    150         $TODO = "Known problem on 32bit with reading 64bit dirs. See TT #254" 
    151         # Unknown PMC type to thaw 0 
    152     } elsif ($PConfig{DEVEL}) { 
    153         $TODO = "devel versions are not guaranteed to succeed"; 
    154     } 
     247test_pbc_number(3, "PPC double float 32 bit BE opcode_t"); 
    155248 
    156249# any ordinary 64-bit intel unix: 
    157250# HEADER => [ 
    158251#         wordsize  = 8   (interpreter's wordsize/INTVAL = 8/8) 
    159252#         byteorder = 0   (interpreter's byteorder       = 0) 
    160253#         floattype = 0   (interpreter's NUMVAL_SIZE     = 8) 
    161 #         parrot-version 0.9.0, bytecode-version 3.34 
     254#         parrot-version 0.9.1, bytecode-version 3.36 
    162255#         UUID type = 0, UUID size = 0 
    163256#         no endianize, no opcode, no numval transform 
    164257#         dirformat = 1 
    165258# ] 
     259test_pbc_number(4, "i86_64 LE 64 bit opcode_t, 8-byte double"); 
    166260 
    167 pbc_output_is(undef, $output, "i86_64 LE 64 bit opcode_t, 64 bit intval") 
    168     or diag "May need to regenerate t/native_pbc/number_4.pbc; read test file"; 
    169  
     261# i86_64 with floatval='long double' 
    170262# HEADER => [ 
    171263#         wordsize  = 8   (interpreter's wordsize/INTVAL = 8/8) 
    172264#         byteorder = 0   (interpreter's byteorder       = 0) 
     
    176268#         no endianize, no opcode, no numval transform 
    177269#         dirformat = 1 
    178270# ] 
    179 pbc_output_is(undef, $output, "i86_64 LE 64 bit opcode_t, 64 bit intval, long double") 
    180     or diag "May need to regenerate t/native_pbc/integer_5.pbc; read test file"; 
     271test_pbc_number(5, "i86_64 LE 64 bit opcode_t, long double"); 
    181272 
    182 # Formerly there were also a test for: 
    183 # pbc_output_is(undef, $output, "big-endian 64-bit irix") 
    184 #   or diag "May need to regenerate t/native_pbc/number_6.pbc; read test file"; 
     273# PowerPC64 -m64 
     274# HEADER => [ 
     275#         wordsize  = 8   (interpreter's wordsize/INTVAL = 8/8) 
     276#         byteorder = 1   (interpreter's byteorder       = 0) 
     277#         floattype = 0   (interpreter's NUMVAL_SIZE     = 8) 
     278#         parrot-version 0.9.1, bytecode-version 3.35 
     279#         UUID type = 0, UUID size = 0 
     280#         *need* endianize, no opcode, no numval transform 
     281#         dirformat = 1 
     282# ] 
     283test_pbc_number(6, "big-endian 64-bit, 8-byte double"); 
    185284 
    186 } 
     285# PowerPC64 --floatval="long double" 
     286test_pbc_number(7, "big-endian 64-bit, 16-byte long double"); 
    187287 
    188288# Local Variables: 
    189289#   mode: cperl 
  • t/native_pbc/string.t

    old new  
    77use lib qw( . lib ../lib ../../lib ); 
    88use Test::More; 
    99use Parrot::Config; 
     10use Parrot::BuildUtil; 
    1011 
    1112use Parrot::Test tests => 1; 
    1213 
     
    2021 
    2122=head1 DESCRIPTION 
    2223 
    23 Tests word-size/string/endian-ness for different architectures. 
     24Tests word-size/endian-ness for different architectures. 
     25TODO: Test foreign charsets and encodings. 
    2426 
    25 These tests usually only work on releases, not on svn checkouts 
    26 and if every release has updated native pbc test files. 
    27  
    28 See F<tools/dev/mk_native_pbc> to create the platform-specific native pbcs. 
     27These tests usually only work on updated native pbc test files. 
     28See F<tools/dev/mk_native_pbc> to create the platform-specific 
     29native pbcs. 
    2930 
    3031=head1 PLATFORMS 
    3132 
     
    3435  _3   PPC BE 32 bit opcode_t, 32 bit intval (darwin-ppc) 
    3536  _4   x86_64 double float 64 bit opcode_t   (linux-gcc-x86_64, solaris-cc-64int) 
    3637  _5   x86_64 16 bit long double 64 bit opcode_t (linux-gcc-x86_64, solaris-cc-64int) 
    37   _6   big-endian 64-bit                     (MIPS irix or similar) 
     38  _6   big-endian 64 bit opcode_t, 8 byte double (Sparc64/Solaris, MIPS irix) 
     39  _7   big-endian 64 bit opcode_t, 16 byte long double (Sparc64/Solaris, MIPS irix) 
    3840 
    3941=cut 
    4042 
     
    4749 
    4850=cut 
    4951 
     52sub bc_version($) { 
     53    my $f = shift; 
     54    my $b; 
     55    open my $F, "<", "$f" or return "Can't open $f: $!"; 
     56    binmode $F; 
     57    seek $F, 14, 0; 
     58    read $F, $b, 8; 
     59    my ($bc_major, $bc_minor) = unpack "cc", $b; 
     60    return ($bc_major . "." . $bc_minor); 
     61} 
     62my ( $bc_major, $bc_minor ) = Parrot::BuildUtil::get_bc_version(); 
     63my $bc = ($bc_major . "." . $bc_minor); 
     64 
    5065my $output = << 'END_OUTPUT'; 
    51 a2c 
    52 ÂžÃÂœ 
    53 ÂžÃÂœ 
    54 a2c 
     66%Ec 
     67Dw 
     68ABCX 
     69   X 
    5570END_OUTPUT 
    5671 
    5772# execute t/native_pbc/string_1.pbc 
     
    6075#         wordsize  = 4   (interpreter's wordsize/INTVAL = 4/4) 
    6176#         byteorder = 0   (interpreter's byteorder       = 0) 
    6277#         floattype = 0   (interpreter's NUMVAL_SIZE     = 8) 
    63 #         parrot-version 0.9.0, bytecode-version 3.34 
     78#         parrot-version 0.9.1, bytecode-version 3.36 
    6479#         UUID type = 0, UUID size = 0 
    6580#         no endianize, no opcode, no numval transform 
    6681#         dirformat = 1 
    6782# ] 
    68 TODO: { 
    69     local $TODO; 
    70     if ($PConfig{ptrsize} == 8) { 
    71         $TODO = "Known problem on 64bit with reading 32bit dirs. See TT #254" 
    72     } elsif ($PConfig{DEVEL}) { 
    73         $TODO = "devel versions are not guaranteed to succeed"; 
    74     } else { 
    75         $TODO = "currently broken. See TT #254"; 
    76     } 
    77  
    78 pbc_output_is( undef, $output, "i386 32 bit opcode_t, 32 bit intval" ); 
    79  
    80 #pbc_output_is( undef, $output, "i386 32 bit opcode_t, 32 bit intval 12-byte long double" ); 
    81 #pbc_output_is( undef, $output, "PPC BE 32 bit opcode_t, 32 bit intval" ); 
    82 #pbc_output_is( undef, $output, "i86_64 LE 64 bit opcode_t, 64 bit intval" ); 
    83 #pbc_output_is( undef, $output, "i86_64 LE 64 bit opcode_t, 64 bit intval, 16-byte long double" ); 
    84 #pbc_output_is( undef, $output, "64bit BE 64 bit opcode_t, 64 bit intval" ); 
     83SKIP: { 
     84    skip "Need to regenerate t/native_pbc/string_1.pbc; read test file", 1 
     85      if ($bc ne bc_version("t/native_pbc/string_1.pbc")); 
    8586 
     87    pbc_output_is( undef, $output, "i386 LE 32 bit opcode_t" ); 
    8688} 
     89#pbc_output_is( undef, $output, "i386 LE 32 bit opcode_t, 12-byte long double" ); 
     90#pbc_output_is( undef, $output, "PPC BE 32 bit opcode_t" ); 
     91#pbc_output_is( undef, $output, "i86_64 LE 64 bit opcode_t" ); 
     92#pbc_output_is( undef, $output, "i86_64 LE 64 bit opcode_t, 16-byte long double" ); 
     93#pbc_output_is( undef, $output, "64bit BE 64 bit opcode_t" ); 
    8794 
    8895# Local Variables: 
    8996#   mode: cperl 
  • tools/dev/mk_native_pbc

    old new  
    5151            # try --floatval="long double" and see if that makes 12 
    5252            enable_long_double=1 
    5353            # force double on 2nd run not to default to long double 
    54             conf=" --floatval='double'" 
     54            conf=" --floatval=double" 
    5555        fi 
    5656    else 
    5757        if [ "$byteorder" == "4321" ] 
     
    8383                # try --floatval="long double" and see if that makes 16 
    8484                enable_long_double=1 
    8585                # force double on 2nd run not to default to long double 
    86                 conf=" --floatval='double'" 
     86                conf=" --floatval=double" 
    8787            else 
    8888                N=5 
    89                 echo "5: x86_64 double float 64 bit opcode_t, 16-byte long double" 
     89                echo "5: x86_64 64 bit opcode_t, 16-byte long double" 
    9090            fi 
    9191        else 
    92             N=6 
    93             echo "6: big-endian 64-bit" 
     92            if [ "$numvalsize" == "8" ] 
     93            then 
     94                N=6 
     95                echo "6: big-endian 64-bit" 
     96                # try --floatval="long double" and see if that makes 16 
     97                enable_long_double=1 
     98                # force double on 2nd run not to default to long double 
     99                conf=" --floatval=double" 
     100            else 
     101                N=7 
     102                echo "7: ppc/BE 64 bit opcode_t, 16-byte long double" 
     103            fi 
    94104        fi 
    95105    else 
    96106        echo "unsupported ptrsize $ptrsize" 
  • t/op/string.t

    old new  
    23582358ok 10 
    23592359OUTPUT 
    23602360 
     2361# string_133.pasm, used for t/native_pbc/string.t 
    23612362pasm_output_is( <<'CODE', <<'OUTPUT', 'bxors 2' ); 
    23622363 set S1, "a2c" 
    23632364 set S2, "Dw" 
     
    24502451 
    24512452SKIP: { 
    24522453    skip( "No unicode yet", 1 ); 
     2454    # This was the previous test used for t/native_pbc/string.t 
    24532455    pasm_output_is( <<'CODE', <<'OUTPUT', 'bnots 2' ); 
    24542456 getstdout P0 
    24552457 push P0, "utf8"