[svn:parrot] r40658 - in trunk: . lib/Parrot t/op

[dukeleto at svn.parrot.org]

Author: dukeleto
Date: Wed Aug 19 16:03:57 2009
New Revision: 40658
URL: https://trac.parrot.org/parrot/changeset/40658

Log:
[TT #834] Add functions for testing exit codes to Parrot::Test and add tests for the exit opcode

eirik++ for the original patch

Added:
   trunk/t/op/exit.t
Modified:
   trunk/MANIFEST
   trunk/lib/Parrot/Test.pm

Modified: trunk/MANIFEST
==============================================================================
--- trunk/MANIFEST	Wed Aug 19 14:12:58 2009	(r40657)
+++ trunk/MANIFEST	Wed Aug 19 16:03:57 2009	(r40658)
@@ -1791,6 +1791,7 @@
 t/op/copy.t                                                 [test]
 t/op/debuginfo.t                                            [test]
 t/op/exceptions.t                                           [test]
+t/op/exit.t                                                 [test]
 t/op/gc.t                                                   [test]
 t/op/globals.t                                              [test]
 t/op/hacks.t                                                [test]

Modified: trunk/lib/Parrot/Test.pm
==============================================================================
--- trunk/lib/Parrot/Test.pm	Wed Aug 19 14:12:58 2009	(r40657)
+++ trunk/lib/Parrot/Test.pm	Wed Aug 19 16:03:57 2009	(r40658)
@@ -100,6 +100,11 @@
 the output with the unexpected result is false I<and> if Parrot exits with a
 non-zero exit code.
 
+=item C<pasm_exit_code_is($code, $exit_code, $description)>
+
+Runs the PASM code and passes the test if the exit code equals $exit_code,
+fails the test otherwise.
+
 =item C<pir_output_is($code, $expected, $description)>
 
 Runs the PIR code and passes the test if a string comparison of output with the
@@ -130,6 +135,11 @@
 the unexpected result is false I<and> if Parrot exits with a non-zero exit
 code.
 
+=item C<pir_exit_code_is($code, $exit_code, $description)>
+
+Runs the PIR code and passes the test if the exit code equals $exit_code,
+fails the test otherwise.
+
 =item C<pbc_output_is($code, $expected, $description)>
 
 Runs the Parrot Bytecode and passes the test if a string comparison of output
@@ -161,6 +171,11 @@
 with the unexpected result is false I<and> if Parrot exits with a non-zero exit
 code.
 
+=item C<pbc_exit_code_is($code, $exit_code, $description)>
+
+Runs the Parrot Bytecode and passes the test if the exit code equals $exit_code,
+fails the test otherwise.
+
 =item C<pir_2_pasm_is($code, $expected, $description)>
 
 Compile the Parrot Intermediate Representation and generate Parrot Assembler Code.
@@ -579,13 +594,13 @@
     # Name of the file with test code.
     # This depends on which kind of code we are testing.
     my $code_f;
-    if ( $func =~ m/^pir_.*?output/ ) {
+    if ( $func =~ m/^pir_(exit_code|.*?output)/ ) {
         $code_f = per_test( '.pir', $test_no );
     }
-    elsif ( $func =~ m/^pasm_.*?output_/ ) {
+    elsif ( $func =~ m/^pasm_(exit_code|.*?output_)/ ) {
         $code_f = per_test( '.pasm', $test_no );
     }
-    elsif ( $func =~ m/^pbc_.*?output_/ ) {
+    elsif ( $func =~ m/^pbc_(exit_code|.*?output_)/ ) {
         $code_f = per_test( '.pbc', $test_no );
     }
     else {
@@ -684,6 +699,7 @@
     my %parrot_test_map = map {
         $_ . '_output_is'           => 'is_eq',
         $_ . '_error_output_is'     => 'is_eq',
+        $_ . '_exit_code_is'        => 'is_eq',
         $_ . '_output_isnt'         => 'isnt_eq',
         $_ . '_error_output_isnt'   => 'isnt_eq',
         $_ . '_output_like'         => 'like',
@@ -723,6 +739,18 @@
                 \$extra{todo}
                 if defined $extra{todo};
 
+            if ( $func =~ /_exit_code_is$/ ) {
+                $expected = int($expected);
+                if ($exit_code == $expected) {
+                    my $pass = $builder->$meth( $exit_code, $expected, $desc );
+                    return $pass;
+                }
+                else {
+                    $builder->ok(0);
+                    return 0;
+                }
+            }
+
             if ( $func =~ /_error_/ ) {
                 return _handle_error_output( $builder, $real_output, $expected, $desc )
                     unless $exit_code;

Added: trunk/t/op/exit.t
==============================================================================
--- /dev/null	00:00:00 1970	(empty, because file is newly added)
+++ trunk/t/op/exit.t	Wed Aug 19 16:03:57 2009	(r40658)
@@ -0,0 +1,72 @@
+#!perl
+# Copyright (C) 2009, Parrot Foundation.
+# $Id$
+
+use strict;
+use warnings;
+use lib qw( . lib ../lib ../../lib );
+
+use Test::More;
+use Parrot::Test tests => 7;
+
+=head1 NAME
+
+t/op/exit.t - Testing the exit pseudo-opcode
+
+=head1 SYNOPSIS
+
+    % prove t/op/exit.t
+
+=head1 DESCRIPTION
+
+Test both success and failure exit status.
+
+=cut
+
+pir_exit_code_is( <<'CODE', 0, 'pir exit with success' );
+.sub main
+    exit 0
+.end
+CODE
+
+pir_exit_code_is( <<'CODE', 1, 'pir exit with failure' );
+.sub main
+    exit 1
+.end
+CODE
+
+pasm_exit_code_is( <<'CODE', 1, 'pasm exit with failure' );
+    exit 1
+CODE
+
+pasm_exit_code_is( <<'CODE', 0, 'pasm exit without failure' );
+    exit 0
+CODE
+
+# If you know of a better place to put these tests, please put them there
+
+pir_exit_code_is( <<'CODE', 0, 'pir exits with success by default' );
+.sub main
+    $S0 = "cheese"
+.end
+CODE
+
+TODO: {
+    local $TODO = 'pasm exits with 1 by default';
+    pasm_exit_code_is( <<'CODE', 0, 'exit with success by default' );
+        set I0, 0
+CODE
+
+}
+TODO: {
+    local $TODO = 'pbc exits with 1 by default';
+    # Should we be using this file?
+    my $pbc = File::Spec->catfile(qw/ t native_pbc integer_1.pbc /);
+    pbc_exit_code_is($pbc, 0, 'pbc exits with 0 by default');
+}
+
+#   mode: cperl
+#   cperl-indent-level: 4
+#   fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4: