cvsuser 05/02/22 13:39:17
Modified: lib/Parrot Test.pm
t/native_pbc integer.t integer_1.pbc number.t number_1.pbc
string.t string_1.pbc
Log:
Resurect tests in 't/native_pbc'. The information that PBC should be
executed is no longer taken from the dirname 'native_pbc', but from
the test function 'pbc_output_is'.
Right now only code generated on '32 bit, i686' is executed.
Revision Changes Path
1.62 +110 -84 parrot/lib/Parrot/Test.pm
Index: Test.pm
===================================================================
RCS file: /cvs/public/parrot/lib/Parrot/Test.pm,v
retrieving revision 1.61
retrieving revision 1.62
diff -u -r1.61 -r1.62
--- Test.pm 27 Nov 2004 04:19:28 -0000 1.61
+++ Test.pm 22 Feb 2005 21:39:16 -0000 1.62
@@ -1,5 +1,5 @@
# Copyright: 2004 The Perl Foundation. All Rights Reserved.
-# $Id: Test.pm,v 1.61 2004/11/27 04:19:28 josh Exp $
+# $Id: Test.pm,v 1.62 2005/02/22 21:39:16 bernhard Exp $
=head1 NAME
@@ -9,7 +9,7 @@
Set the number of tests to be run like this:
- use Parrot::Test tests => 8;
+ use Parrot::Test tests => 8;
Write individual tests like this:
@@ -59,6 +59,21 @@
Runs the PIR code and passes the test if a string comparison of output
with the expected result it false.
+=item C<pbc_output_is($code, $expected, $description)>
+
+Runs the Parrot Bytecode and passes the test if a string comparison of output
+with the expected result it true.
+
+=item C<pbc_output_like($code, $expected, $description)>
+
+Runs the Parrot Bytecode and passes the test if output matches the expected
+result.
+
+=item C<pbc_output_isnt($code, $expected, $description)>
+
+Runs the Parrot Bytecode and passes the test if a string comparison of output
+with the expected result it false.
+
=item C<c_output_is($code, $expected, $description)>
Compiles and runs the C code, passing the test if a string comparison of
@@ -101,10 +116,16 @@
my $Builder = Test::Builder->new;
@EXPORT = ( qw(output_is output_like output_isnt),
- qw(pir_output_is pir_output_like pir_output_isnt),
+ qw(pir_output_is pir_output_like pir_output_isnt),
qw(c_output_is c_output_like c_output_isnt),
qw(language_output_is),
qw(skip) );
[EMAIL PROTECTED] = qw( output_is output_like output_isnt
+ pir_output_is pir_output_like pir_output_isnt
+ pbc_output_is pbc_output_like pbc_output_isnt
+ c_output_is c_output_like c_output_isnt
+ language_output_is
+ skip );
@ISA = qw(Exporter);
sub import {
@@ -179,12 +200,15 @@
}
# Map the Parrot::Test function to a Test::Builder method.
-my %Test_Map = ( output_is => 'is_eq',
- output_isnt => 'isnt_eq',
- output_like => 'like',
- pir_output_is => 'is_eq',
- pir_output_isnt => 'isnt_eq',
- pir_output_like => 'like',
+my %Test_Map = ( output_is => 'is_eq',
+ output_isnt => 'isnt_eq',
+ output_like => 'like',
+ pir_output_is => 'is_eq',
+ pir_output_isnt => 'isnt_eq',
+ pir_output_like => 'like',
+ pbc_output_is => 'is_eq',
+ pbc_output_isnt => 'isnt_eq',
+ pbc_output_like => 'like',
language_output_is => 'is_eq',
);
@@ -205,7 +229,7 @@
}
my $path_to_parrot = $INC{"Parrot/Config.pm"};
- $path_to_parrot =~ s:lib/Parrot/Config.pm$::;
+ $path_to_parrot =~ s:lib/Parrot/Config.pm$::;
$path_to_parrot = File::Spec->curdir if $path_to_parrot eq "";
my $PARROT = File::Spec->join(File::Spec->curdir,'parrot' . $PConfig{exe});
@@ -219,93 +243,95 @@
*{$package.'::'.$func} = sub ($$$;$) {
my $language = $_[0];
$language = ucfirst($language) unless ( $language eq 'm4' );
-
- # make sure TODO will work, by telling Test::Builder which package
- # the .t file is in (one more than usual, due to the extra layer
- # of package indirection
- my $level = $Builder->level();
+
+ # make sure TODO will work, by telling Test::Builder which package
+ # the .t file is in (one more than usual, due to the extra layer
+ # of package indirection
+ my $level = $Builder->level();
$Builder->level(2);
-
+
# get modified PARROT command.
require "Parrot/Test/$language.pm";
- # set the builder object, and parrot config.
+ # set the builder object, and parrot config.
my $obj = eval "Parrot::Test::${language}->new()";
$obj->{builder} = $Builder;
$obj->{relpath} = $path_to_parrot;
- $obj->{parrot} = $PARROT;
+ $obj->{parrot} = $PARROT;
$obj->$delegate_func(@_[1..$#_]);
- # retore prior level, just in case.
- $Builder->level($level);
+ # retore prior level, just in case.
+ $Builder->level($level);
}
} else {
*{$package.'::'.$func} = sub ($$;$) {
- my( $assembly, $output, $desc) = @_;
+ my( $assembly, $output, $desc) = @_;
+
+ $count = $Builder->current_test + 1;
- $count = $Builder->current_test + 1;
+ #set up default description
+ (undef, my $file, my $line) = caller;
+ unless ($desc) {
+ $desc = "($file line $line)";
+ }
+
+ $output =~ s/\cM\cJ/\n/g;
+
+ #generate pbc for this test (may be overriden)
+ my $out_f = per_test('.out',$count);
+ my $as_f = per_test('.pasm',$count);
+
+ if ( $func !~ /^pbc_output_/ &&
+ ( $assembly =~ /^##PIR##/ || $func =~ /^pir_/ )
+ ) {
+ $as_f = per_test('.imc',$count);
+ }
+
+ $TEST_PROG_ARGS = $ENV{TEST_PROG_ARGS} || '';
+ my $args = $TEST_PROG_ARGS;
- #set up default description
- (undef, my $file, my $line) = caller;
- unless ($desc) {
- $desc = "($file line $line)";
- }
-
- $output =~ s/\cM\cJ/\n/g;
-
- #generate pbc for this test (may be overriden)
- my $out_f = per_test('.out',$count);
- my $as_f = per_test('.pasm',$count);
-
- if ($assembly =~ /^##PIR##/ || $func =~ /^pir_/) {
- $as_f = per_test('.imc',$count);
- }
-
- $TEST_PROG_ARGS = $ENV{TEST_PROG_ARGS} || '';
- my $args = $TEST_PROG_ARGS;
-
- my $run_pbc = 0;
- if ($args =~ s/--run-pbc//) {
- # native tests with --run-pbc don't make sense
- if ($as_f =~ /native_pbc/) {
- return $Builder->ok(1, $desc);
- }
- my $pbc_f = per_test('.pbc', $count);
- $run_pbc = 1;
- $args = "$args -o $pbc_f -r -r";
- }
-
- # native tests are just run
- if ($as_f =~ /native_pbc/) {
- $as_f = per_test('.pbc',$count);
- $run_pbc = 0;
- }
- else {
- $as_f = File::Spec->rel2abs($as_f);
- $pbc_generator->( $assembly, $path_to_parrot, $count, $as_f );
- }
+ my $run_pbc = 0;
+ if ($args =~ s/--run-pbc//) {
+ # native tests with --run-pbc don't make sense
+ if ($func =~ /^pbc_output_/) {
+ return $Builder->ok(1, $desc);
+ }
+ my $pbc_f = per_test('.pbc', $count);
+ $run_pbc = 1;
+ $args = "$args -o $pbc_f -r -r";
+ }
+
+ # native tests are just run
+ if ($func =~ /^pbc_output_/) {
+ $as_f = per_test('.pbc',$count);
+ $run_pbc = 0;
+ }
+ else {
+ $as_f = File::Spec->rel2abs($as_f);
+ $pbc_generator->( $assembly, $path_to_parrot, $count, $as_f );
+ }
my $cmd;
my $exit_code = 0;
- my $pass = 0;
+ my $pass = 0;
- $cmd = "(cd $path_to_parrot && $PARROT ${args} \"$as_f\")";
+ $cmd = "(cd $path_to_parrot && $PARROT ${args} \"$as_f\")";
- $exit_code = _run_command($cmd, STDOUT => $out_f, STDERR => $out_f);
+ $exit_code = _run_command($cmd, STDOUT => $out_f, STDERR => $out_f);
- my $meth = $Test_Map{$func};
- unless ($pass) {
- $pass = $Builder->$meth( slurp_file($out_f), $output, $desc );
- $Builder->diag("'$cmd' failed with exit code $exit_code")
- if $exit_code and not $pass;
+ my $meth = $Test_Map{$func};
+ unless ($pass) {
+ $pass = $Builder->$meth( slurp_file($out_f), $output, $desc );
+ $Builder->diag("'$cmd' failed with exit code $exit_code")
+ if $exit_code and not $pass;
}
- unless($ENV{POSTMORTEM}) {
- unlink $out_f;
- }
+ unless($ENV{POSTMORTEM}) {
+ unlink $out_f;
+ }
- return $pass;
+ return $pass;
} # sub
} # language-if
}
@@ -360,10 +386,10 @@
$Builder->diag("'$cmd' failed with exit code $exit_code") if
$exit_code;
if (! -e $obj_f) {
- $Builder->diag("Failed to build '$obj_f': " . slurp_file($build_f));
- unlink $build_f;
- $Builder->ok(0,$desc);
- return 0;
+ $Builder->diag("Failed to build '$obj_f': " . slurp_file($build_f));
+ unlink $build_f;
+ $Builder->ok(0,$desc);
+ return 0;
}
$cmd = "$PConfig{link} $PConfig{linkflags} $PConfig{ld_debug} $obj_f "
.
@@ -373,10 +399,10 @@
if (! -e $exe_f) {
- $Builder->diag("Failed to build '$exe_f': " . slurp_file($build_f));
- unlink $build_f;
- $Builder->ok(0,$desc);
- return 0;
+ $Builder->diag("Failed to build '$exe_f': " . slurp_file($build_f));
+ unlink $build_f;
+ $Builder->ok(0,$desc);
+ return 0;
}
$cmd = ".$PConfig{slash}$exe_f";
@@ -389,9 +415,9 @@
unless($ENV{POSTMORTEM}) {
unlink $out_f;
- unlink $build_f;
- unlink $exe_f;
- unlink $obj_f;
+ unlink $build_f;
+ unlink $exe_f;
+ unlink $obj_f;
}
return $pass;
}
1.7 +24 -46 parrot/t/native_pbc/integer.t
Index: integer.t
===================================================================
RCS file: /cvs/public/parrot/t/native_pbc/integer.t,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- integer.t 24 Sep 2004 09:45:46 -0000 1.6
+++ integer.t 22 Feb 2005 21:39:17 -0000 1.7
@@ -1,6 +1,6 @@
#! perl -w
-# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: integer.t,v 1.6 2004/09/24 09:45:46 leo Exp $
+# Copyright: 2001-2005 The Perl Foundation. All Rights Reserved.
+# $Id: integer.t,v 1.7 2005/02/22 21:39:17 bernhard Exp $
=head1 NAME
@@ -16,63 +16,41 @@
=cut
-my $comment = <<'EOC';
+=begin comment
s. t/native_pbc/number.t for additional comments
-The file is generated by:
+Test files on different architectures are generated by:
+
$ parrot -o i.pbc -a - <<EOF
> print 0x10203040
> end
> EOF
+$ mv i.pbc t/native_pbc/integer_${N}.pbc
-$ pdump -h i.pbc
-$ mv i.pbc t/native_pbc/integer_1.pbc
-
-EOC
+The output of
-use Parrot::Test;
-use Test::More;
+$ pdump -h i.pbc
-if (0) {
- plan tests => 4;
-}
-else {
- plan skip_all => "ongoing ops-file cleanup";
-}
+should be included for reference.
-output_is(<<CODE, '270544960', "i386 32 bit opcode_t, 32 bit intval");
-# integer_1.pbc
-# HEADER => [
-# wordsize = 4 (interpreter's wordsize = 4)
-# int_size = 4 (interpreter's INTVAL size = 4)
-# byteorder = 0 (interpreter's byteorder = 0)
-# floattype = 0 (interpreter's NUMVAL_SIZE = 8)
-# no endianize, no opcode, no numval transform
-# dirformat = 1
-# ]
+=cut
-CODE
+use Parrot::Test tests => 1;
-output_is(<<CODE, '270544960', "PPC BE 32 bit opcode_t, 32 bit intval");
-# integer_1.pbc
+# execute the file t/native_pbc/integer_1.pbc
+#
# HEADER => [
-# wordsize = 4 (interpreter's wordsize = 4)
-# int_size = 4 (interpreter's INTVAL size = 4)
-# byteorder = 1 (interpreter's byteorder = 1)
-# floattype = 0 (interpreter's NUMVAL_SIZE = 8)
-# no endianize, no opcode, no numval transform
-# dirformat = 1
+# wordsize = 4 (interpreter's wordsize = 4)
+# int_size = 4 (interpreter's INTVAL size = 4)
+# byteorder = 0 (interpreter's byteorder = 0)
+# floattype = 0 (interpreter's NUMVAL_SIZE = 8)
+# no endianize, no opcode, no numval transform
+# dirformat = 1
# ]
+pbc_output_is(undef, '270544960', "i386 32 bit opcode_t, 32 bit intval");
-CODE
-
-output_is(<<CODE, '270544960', "little-endian 64-bit tru64");
-# wordsize = 8
-# byteorder = 0
-CODE
-
-output_is(<<CODE, '270544960', "big-endian 64-bit irix");
-# wordsize = 8
-# byteorder = 1
-CODE
+# Formerly following tests had been set up:
+# output_is(undef, '270544960', "PPC BE 32 bit opcode_t, 32 bit intval");
+# output_is(undef, '270544960', "little-endian 64-bit tru64");
+# output_is(undef, '270544960', "big-endian 64-bit irix");
1.3 +1 -1 parrot/t/native_pbc/integer_1.pbc
<<Binary file>>
1.23 +23 -175 parrot/t/native_pbc/number.t
Index: number.t
===================================================================
RCS file: /cvs/public/parrot/t/native_pbc/number.t,v
retrieving revision 1.22
retrieving revision 1.23
diff -u -r1.22 -r1.23
--- number.t 24 Sep 2004 09:45:46 -0000 1.22
+++ number.t 22 Feb 2005 21:39:17 -0000 1.23
@@ -1,6 +1,6 @@
#! perl -w
-# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: number.t,v 1.22 2004/09/24 09:45:46 leo Exp $
+# Copyright: 2001-2005 The Perl Foundation. All Rights Reserved.
+# $Id: number.t,v 1.23 2005/02/22 21:39:17 bernhard Exp $
=head1 NAME
@@ -16,7 +16,7 @@
=cut
-my $comment = <<'EOC';
+=begin comment
# these are PBC files generated from t/op/number_1.pasm with
# different architectures
@@ -35,107 +35,11 @@
# - add the file as binary (cvs add -kb) and commit it
# thanks -leo
-EOC
-
-use Parrot::Test;
-use Test::More;
-
-if (0) {
- plan tests => 5;
-}
-else {
- plan skip_all => "ongoing ops-file cleanup";
-}
-
-output_is(<<CODE, <<OUTPUT, "i386 double float 32 bit opcode_t");
-# number_1.pbc
-# HEADER => [
-# wordsize = 4 (interpreter's wordsize = 4)
-# int_size = 4 (interpreter's INTVAL size = 4)
-# byteorder = 0 (interpreter's byteorder = 0)
-# floattype = 0 (interpreter's NUMVAL_SIZE = 8)
-# no endianize, no opcode, no numval transform
-# dirformat = 1
-#] #
-CODE
-1.000000
-4.000000
-16.000000
-64.000000
-256.000000
-1024.000000
-4096.000000
-16384.000000
-65536.000000
-262144.000000
-1048576.000000
-4194304.000000
-16777216.000000
-67108864.000000
-268435456.000000
-1073741824.000000
-4294967296.000000
-17179869184.000000
-68719476736.000000
-274877906944.000000
-1099511627776.000000
-4398046511104.000000
-17592186044416.000000
-70368744177664.000000
-281474976710656.000000
-1125899906842620.000000
-OUTPUT
+=cut
-output_is(<<CODE, <<OUTPUT, "i386 long double float 32 bit opcode_t");
-# number_2.pbc
-#HEADER => [
-# wordsize = 4 (interpreter's wordsize = 4)
-# int_size = 4 (interpreter's INTVAL size = 4)
-# byteorder = 0 (interpreter's byteorder = 0)
-# floattype = 1 (interpreter's NUMVAL_SIZE = 8)
-# no endianize, no opcode, **need** numval transform
-# dirformat = 1
-#]
-CODE
-1.000000
-4.000000
-16.000000
-64.000000
-256.000000
-1024.000000
-4096.000000
-16384.000000
-65536.000000
-262144.000000
-1048576.000000
-4194304.000000
-16777216.000000
-67108864.000000
-268435456.000000
-1073741824.000000
-4294967296.000000
-17179869184.000000
-68719476736.000000
-274877906944.000000
-1099511627776.000000
-4398046511104.000000
-17592186044416.000000
-70368744177664.000000
-281474976710656.000000
-1125899906842620.000000
-OUTPUT
+use Parrot::Test tests => 1;
-output_is(<<CODE, <<OUTPUT, "PPC double float 32 bit BE opcode_t");
-# number_3.pbc
-#HEADER => [
-# wordsize = 4 (interpreter's wordsize = 4)
-# int_size = 4 (interpreter's INTVAL size = 4)
-# byteorder = 1 (interpreter's byteorder = 1)
-# floattype = 0 (interpreter's NUMVAL_SIZE = 8)
-# no endianize, no opcode, no numval transform
-# dirformat = 1
-#]
-CODE
+my $output = << 'END_OUTPUT';
1.000000
4.000000
16.000000
@@ -162,79 +66,23 @@
70368744177664.000000
281474976710656.000000
1125899906842620.000000
-OUTPUT
+END_OUTPUT
-output_is(<<CODE, <<OUTPUT, "little-endian 64-bit tru64");
-# number_4.pbc
-#HEADER => [
-# wordsize = 8 (interpreter's wordsize = 8)
-# int_size = 8 (interpreter's INTVAL size = 8)
-# byteorder = 0 (interpreter's byteorder = 0)
-# floattype = 0 (interpreter's NUMVAL_SIZE = 8)
-# no endianize, no opcode, no numval transform
-# dirformat = 1
-#]
-CODE
-1.000000
-4.000000
-16.000000
-64.000000
-256.000000
-1024.000000
-4096.000000
-16384.000000
-65536.000000
-262144.000000
-1048576.000000
-4194304.000000
-16777216.000000
-67108864.000000
-268435456.000000
-1073741824.000000
-4294967296.000000
-17179869184.000000
-68719476736.000000
-274877906944.000000
-1099511627776.000000
-4398046511104.000000
-17592186044416.000000
-70368744177664.000000
-281474976710656.000000
-1125899906842620.000000
-OUTPUT
+# execute t/native_pbc/number_1.pbc
+#
+# HEADER => [
+# wordsize = 4 (interpreter's wordsize = 4)
+# int_size = 4 (interpreter's INTVAL size = 4)
+# byteorder = 0 (interpreter's byteorder = 0)
+# floattype = 0 (interpreter's NUMVAL_SIZE = 8)
+# no endianize, no opcode, no numval transform
+# dirformat = 1
+# ]
+pbc_output_is(undef, $output, "i386 double float 32 bit opcode_t");
-output_is(<<CODE, <<OUTPUT, "big-endian 64-bit irix");
-# number_5.pbc
-# wordsize = 8
-# byteorder = 1
-# floattype = 0
-CODE
-1.000000
-4.000000
-16.000000
-64.000000
-256.000000
-1024.000000
-4096.000000
-16384.000000
-65536.000000
-262144.000000
-1048576.000000
-4194304.000000
-16777216.000000
-67108864.000000
-268435456.000000
-1073741824.000000
-4294967296.000000
-17179869184.000000
-68719476736.000000
-274877906944.000000
-1099511627776.000000
-4398046511104.000000
-17592186044416.000000
-70368744177664.000000
-281474976710656.000000
-1125899906842620.000000
-OUTPUT
-1;
+# Formerly there were tests for:
+# pbc_output_is(undef, <<OUTPUT, "i386 long double float 32 bit opcode_t");
+# pbc_output_is(undef, <<OUTPUT, "PPC double float 32 bit BE opcode_t");
+# pbc_output_is(undef, <<OUTPUT, "little-endian 64-bit tru64");
+# pbc_output_is(undef, <<OUTPUT, "big-endian 64-bit irix");
1.20 +6 -5 parrot/t/native_pbc/number_1.pbc
<<Binary file>>
1.3 +29 -19 parrot/t/native_pbc/string.t
Index: string.t
===================================================================
RCS file: /cvs/public/parrot/t/native_pbc/string.t,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- string.t 24 May 2004 13:46:53 -0000 1.2
+++ string.t 22 Feb 2005 21:39:17 -0000 1.3
@@ -1,6 +1,6 @@
#! perl -w
-# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: string.t,v 1.2 2004/05/24 13:46:53 leo Exp $
+# Copyright: 2001-2005 The Perl Foundation. All Rights Reserved.
+# $Id: string.t,v 1.3 2005/02/22 21:39:17 bernhard Exp $
=head1 NAME
@@ -16,22 +16,32 @@
=cut
-use Parrot::Test tests => 2;
+use Parrot::Test tests => 1;
-SKIP:
-{
- skip("utf8 IO changes", 2);
-
-output_is(<<CODE, <<OUTPUT, "angstrom 32 bit PPC BE");
-# string_1.pbc s. t/op/string_133
-CODE
-\xe2\x84\xab
-OUTPUT
-
-output_is(<<CODE, <<OUTPUT, "angstrom 32 bit x86 LE");
-# string_2.pbc s. t/op/string_133
-CODE
-\xe2\x84\xab
-OUTPUT
+=begin comment
-}
+The PBC is generated from t/op/strings_133.pasm for different architectures.
+Actually, there is a single architecture right now.
+
+For adding tests, see the comments in t/native_pbc/number.t
+
+=cut
+
+my $output = << 'END_OUTPUT';
+a2c
+Í
+Í
+a2c
+END_OUTPUT
+
+# execute t/native_pbc/string_1.pbc
+#
+# HEADER => [
+# wordsize = 4 (interpreter's wordsize = 4)
+# int_size = 4 (interpreter's INTVAL size = 4)
+# byteorder = 0 (interpreter's byteorder = 0)
+# floattype = 0 (interpreter's NUMVAL_SIZE = 8)
+# no endianize, no opcode, no numval transform
+# dirformat = 1
+# ]
+pbc_output_is( undef, $output, "i386 32 bit opcode_t, 32 bit intval");
1.2 +3 -2 parrot/t/native_pbc/string_1.pbc
<<Binary file>>
