develooper Front page | perl.cvs.parrot | Postings from December 2008

[svn:parrot] r33822 - branches/testparrottest/lib/Parrot

From:
jkeenan
Date:
December 11, 2008 19:33
Subject:
[svn:parrot] r33822 - branches/testparrottest/lib/Parrot
Message ID:
20081212033324.02A8ECB9AF@x12.develooper.com
Author: jkeenan
Date: Thu Dec 11 19:33:23 2008
New Revision: 33822

Modified:
   branches/testparrottest/lib/Parrot/Test.pm

Log:
Continue to restore previous order of subroutines.

Modified: branches/testparrottest/lib/Parrot/Test.pm
==============================================================================
--- branches/testparrottest/lib/Parrot/Test.pm	(original)
+++ branches/testparrottest/lib/Parrot/Test.pm	Thu Dec 11 19:33:23 2008
@@ -504,6 +504,130 @@
 # The following methods are private.  They should not be used by modules
 # inheriting from Parrot::Test.
 
+sub _handle_error_output {
+    my ( $builder, $real_output, $expected, $desc ) = @_;
+
+    my $level = $builder->level();
+    $builder->level( $level + 1 );
+    $builder->ok( 0, $desc );
+    $builder->diag(
+        "Expected error but exited cleanly\n" . "Received:\n$real_output\nExpected:\n$expected\n" );
+    $builder->level($level);
+
+    return 0;
+}
+
+sub _run_test_file {
+    my ( $func, $code, $expected, $desc, %extra ) = @_;
+    my $path_to_parrot = path_to_parrot();
+    my $parrot = File::Spec->join( File::Spec->curdir(), 'parrot' . $PConfig{exe} );
+
+    # Strange Win line endings
+    convert_line_endings($expected);
+
+    # $test_no will be part of temporary file
+    my $test_no = $builder->current_test() + 1;
+
+    # Name of the file where output is written.
+    # Switch to a different extension when we are generating code.
+    my $out_f = per_test( '.out', $test_no );
+
+    # 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/ ) {
+        $code_f = per_test( '.pir', $test_no );
+    }
+    elsif ( $func =~ m/^pasm_.*?output_/ ) {
+        $code_f = per_test( '.pasm', $test_no );
+    }
+    elsif ( $func =~ m/^pbc_.*?output_/ ) {
+        $code_f = per_test( '.pbc', $test_no );
+    }
+    else {
+        die "Unknown test function: $func";
+    }
+    $code_f = File::Spec->rel2abs($code_f);
+    my $code_basef = basename($code_f);
+
+    # native tests are just run, others need to write code first
+    if ( $code_f !~ /\.pbc$/ ) {
+        write_code_to_file( $code, $code_f );
+    }
+
+    # honor opt* filename to actually run code with -Ox
+    my $args = $ENV{TEST_PROG_ARGS} || '';
+    my $opt = $code_basef =~ m!opt(.)! ? "-O$1" : "";
+    $args .= " $opt";
+
+    my $run_exec = 0;
+    if ( $args =~ s/--run-exec// ) {
+        $run_exec = 1;
+        my $pbc_f = per_test( '.pbc', $test_no );
+        my $o_f = per_test( '_pbcexe' . $PConfig{o}, $test_no );
+        my $exe_f =
+            per_test( '_pbcexe' . $PConfig{exe}, $test_no )
+            ;    # Make cleanup and svn:ignore more simple
+        my $exec_f = per_test( '_pbcexe', $test_no );    # Make cleanup and svn:ignore more simple
+        $exe_f =~ s@[\\/:]@$PConfig{slash}@g;
+
+        # RT#43751 put this into sub generate_pbc()
+        run_command(
+            qq{$parrot $args -o $pbc_f "$code_f"},
+            CD     => $path_to_parrot,
+            STDOUT => $out_f,
+            STDERR => $out_f
+        );
+        if ( -e $pbc_f ) {
+            run_command(
+                qq{$parrot $args -o $o_f "$pbc_f"},
+                CD     => $path_to_parrot,
+                STDOUT => $out_f,
+                STDERR => $out_f
+            );
+            if ( -e $o_f ) {
+                run_command(
+                    qq{$PConfig{make} EXEC=$exec_f exec},
+                    CD     => $path_to_parrot,
+                    STDOUT => $out_f,
+                    STDERR => $out_f
+                );
+                if ( -e $exe_f ) {
+                    run_command(
+                        $exe_f,
+                        CD     => $path_to_parrot,
+                        STDOUT => $out_f,
+                        STDERR => $out_f
+                    );
+                }
+            }
+        }
+    }
+
+    my ( $exit_code, $cmd );
+    unless ($run_exec) {
+        if ( $args =~ s/--run-pbc// || $args =~ s/-r // ) {
+            my $pbc_f = per_test( '.pbc', $test_no );
+            $args = qq{$args -o "$pbc_f"};
+
+            # In this case, we need to execute more than one command. Instead
+            # of a single scalar, build an array of commands.
+            $cmd = [ qq{$parrot $args "$code_f"}, qq{$parrot "$pbc_f"}, ];
+        }
+        else {
+            $cmd = qq{$parrot $args "$code_f"};
+        }
+        $exit_code = run_command(
+            $cmd,
+            CD     => $path_to_parrot,
+            STDOUT => $out_f,
+            STDERR => $out_f
+        );
+    }
+
+    return ( $out_f, $cmd, $exit_code );
+}
+
 sub _generate_test_functions {
 
     my $package        = 'Parrot::Test';
@@ -915,130 +1039,6 @@
     return;
 }
 
-sub _handle_error_output {
-    my ( $builder, $real_output, $expected, $desc ) = @_;
-
-    my $level = $builder->level();
-    $builder->level( $level + 1 );
-    $builder->ok( 0, $desc );
-    $builder->diag(
-        "Expected error but exited cleanly\n" . "Received:\n$real_output\nExpected:\n$expected\n" );
-    $builder->level($level);
-
-    return 0;
-}
-
-sub _run_test_file {
-    my ( $func, $code, $expected, $desc, %extra ) = @_;
-    my $path_to_parrot = path_to_parrot();
-    my $parrot = File::Spec->join( File::Spec->curdir(), 'parrot' . $PConfig{exe} );
-
-    # Strange Win line endings
-    convert_line_endings($expected);
-
-    # $test_no will be part of temporary file
-    my $test_no = $builder->current_test() + 1;
-
-    # Name of the file where output is written.
-    # Switch to a different extension when we are generating code.
-    my $out_f = per_test( '.out', $test_no );
-
-    # 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/ ) {
-        $code_f = per_test( '.pir', $test_no );
-    }
-    elsif ( $func =~ m/^pasm_.*?output_/ ) {
-        $code_f = per_test( '.pasm', $test_no );
-    }
-    elsif ( $func =~ m/^pbc_.*?output_/ ) {
-        $code_f = per_test( '.pbc', $test_no );
-    }
-    else {
-        die "Unknown test function: $func";
-    }
-    $code_f = File::Spec->rel2abs($code_f);
-    my $code_basef = basename($code_f);
-
-    # native tests are just run, others need to write code first
-    if ( $code_f !~ /\.pbc$/ ) {
-        write_code_to_file( $code, $code_f );
-    }
-
-    # honor opt* filename to actually run code with -Ox
-    my $args = $ENV{TEST_PROG_ARGS} || '';
-    my $opt = $code_basef =~ m!opt(.)! ? "-O$1" : "";
-    $args .= " $opt";
-
-    my $run_exec = 0;
-    if ( $args =~ s/--run-exec// ) {
-        $run_exec = 1;
-        my $pbc_f = per_test( '.pbc', $test_no );
-        my $o_f = per_test( '_pbcexe' . $PConfig{o}, $test_no );
-        my $exe_f =
-            per_test( '_pbcexe' . $PConfig{exe}, $test_no )
-            ;    # Make cleanup and svn:ignore more simple
-        my $exec_f = per_test( '_pbcexe', $test_no );    # Make cleanup and svn:ignore more simple
-        $exe_f =~ s@[\\/:]@$PConfig{slash}@g;
-
-        # RT#43751 put this into sub generate_pbc()
-        run_command(
-            qq{$parrot $args -o $pbc_f "$code_f"},
-            CD     => $path_to_parrot,
-            STDOUT => $out_f,
-            STDERR => $out_f
-        );
-        if ( -e $pbc_f ) {
-            run_command(
-                qq{$parrot $args -o $o_f "$pbc_f"},
-                CD     => $path_to_parrot,
-                STDOUT => $out_f,
-                STDERR => $out_f
-            );
-            if ( -e $o_f ) {
-                run_command(
-                    qq{$PConfig{make} EXEC=$exec_f exec},
-                    CD     => $path_to_parrot,
-                    STDOUT => $out_f,
-                    STDERR => $out_f
-                );
-                if ( -e $exe_f ) {
-                    run_command(
-                        $exe_f,
-                        CD     => $path_to_parrot,
-                        STDOUT => $out_f,
-                        STDERR => $out_f
-                    );
-                }
-            }
-        }
-    }
-
-    my ( $exit_code, $cmd );
-    unless ($run_exec) {
-        if ( $args =~ s/--run-pbc// || $args =~ s/-r // ) {
-            my $pbc_f = per_test( '.pbc', $test_no );
-            $args = qq{$args -o "$pbc_f"};
-
-            # In this case, we need to execute more than one command. Instead
-            # of a single scalar, build an array of commands.
-            $cmd = [ qq{$parrot $args "$code_f"}, qq{$parrot "$pbc_f"}, ];
-        }
-        else {
-            $cmd = qq{$parrot $args "$code_f"};
-        }
-        $exit_code = run_command(
-            $cmd,
-            CD     => $path_to_parrot,
-            STDOUT => $out_f,
-            STDERR => $out_f
-        );
-    }
-
-    return ( $out_f, $cmd, $exit_code );
-}
-
 sub _handle_test_options {
     my $options = shift;
     # To run the command in a different directory.



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About