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

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

From:
jkeenan
Date:
December 7, 2008 07:36
Subject:
[svn:parrot] r33608 - branches/testparrottest/lib/Parrot
Message ID:
20081207153650.81BA6CB9AF@x12.develooper.com
Author: jkeenan
Date: Sun Dec  7 07:36:49 2008
New Revision: 33608

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

Log:
Rearrange order of subs for easier editing.  Correct one spelling error.

Modified: branches/testparrottest/lib/Parrot/Test.pm
==============================================================================
--- branches/testparrottest/lib/Parrot/Test.pm	(original)
+++ branches/testparrottest/lib/Parrot/Test.pm	Sun Dec  7 07:36:49 2008
@@ -165,222 +165,6 @@
 # The following methods --up until generate_languages_functions() -- 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 {
-    local $SIG{__WARN__} = \&_report_odd_hash;
-    my ( $func, $code, $expected, $desc, %extra ) = @_;
-#my $incoming_desc_status;
-#if ($desc) {
-#    $incoming_desc_status++;
-#    print STDERR "desc:  $desc\n";
-#} else {
-#    print STDERR "desc is Perl-false\n";
-#}
-
-    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);
-
-    # set up default description
-    unless ($desc) {
-        ( undef, my $file, my $line ) = caller();
-        $desc = "($file line $line)";
-    }
-#unless ($incoming_desc_status) {
-#    if ($desc) {
-#        print STDERR "desc is now:  $desc\n";
-#    } else {
-#        print STDERR "desc is still Perl-false\n";
-#    }
-#}
-
-    # $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 _report_odd_hash {
-    my $warning = shift;
-    if ( $warning =~ m/Odd number of elements in hash assignment/ ) {
-        require Carp;
-        my @args = DB::uplevel_args();
-        shift @args;
-        my $func = ( caller() )[2];
-
-        Carp::carp("Odd $func invocation; probably missing description for TODO test");
-    }
-    else {
-        warn $warning;
-    }
-}
-
-sub _handle_test_options {
-    my $options = shift;
-    # To run the command in a different directory.
-    my $chdir = delete $options->{CD} || '';
-
-    while ( my ( $key, $value ) = each %{ $options } ) {
-        $key =~ m/^STD(OUT|ERR)$/
-            or die "I don't know how to redirect '$key' yet!";
-        my $strvalue = "$value";        # filehandle `eq' string will fail
-        $value = File::Spec->devnull()  # on older perls, so stringify it
-            if $strvalue eq '/dev/null';
-    }
-
-    my $out = $options->{'STDOUT'} || '';
-    my $err = $options->{'STDERR'} || '';
-    ##  File::Temp overloads 'eq' here, so we need the quotes. RT #58840
-    if ( $out and $err and "$out" eq "$err" ) {
-        $err = '&STDOUT';
-    }
-    return ( $out, $err, $chdir );
-}
-
-sub _handle_blib_path {
-    my $blib_path =
-        File::Spec->catfile( $PConfig{build_dir}, 'blib', 'lib' );
-    if ($^O eq 'cygwin') {
-        $ENV{PATH} = $blib_path . ':' . $ENV{PATH};
-    }
-    elsif ($^O eq 'MSWin32') {
-        $ENV{PATH} = $blib_path . ';' . $ENV{PATH};
-    }
-    else {
-        $ENV{LD_RUN_PATH} = $blib_path;
-    }
-}
-
-sub _handle_command {
-    my $command = shift;
-    $command = [$command] unless ( ref $command );
-
-    if ( defined $ENV{VALGRIND} ) {
-        $_ = "$ENV{VALGRIND} $_" for (@$command);
-    }
-    return $command;
-}
-
-sub _prepare_exit_message {
-    my $exit_code = $?;
-    return (
-          ( $exit_code < 0 )    ? $exit_code
-        : ( $exit_code & 0xFF ) ? "[SIGNAL $exit_code]"
-        : ( $? >> 8 )
-    );
-}
-
 sub _generate_test_functions {
 
     my $package        = 'Parrot::Test';
@@ -791,6 +575,222 @@
     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 {
+    local $SIG{__WARN__} = \&_report_odd_hash;
+    my ( $func, $code, $expected, $desc, %extra ) = @_;
+#my $incoming_desc_status;
+#if ($desc) {
+#    $incoming_desc_status++;
+#    print STDERR "desc:  $desc\n";
+#} else {
+#    print STDERR "desc is Perl-false\n";
+#}
+
+    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);
+
+    # set up default description
+    unless ($desc) {
+        ( undef, my $file, my $line ) = caller();
+        $desc = "($file line $line)";
+    }
+#unless ($incoming_desc_status) {
+#    if ($desc) {
+#        print STDERR "desc is now:  $desc\n";
+#    } else {
+#        print STDERR "desc is still Perl-false\n";
+#    }
+#}
+
+    # $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 _report_odd_hash {
+    my $warning = shift;
+    if ( $warning =~ m/Odd number of elements in hash assignment/ ) {
+        require Carp;
+        my @args = DB::uplevel_args();
+        shift @args;
+        my $func = ( caller() )[2];
+
+        Carp::carp("Odd $func invocation; probably missing description for TODO test");
+    }
+    else {
+        warn $warning;
+    }
+}
+
+sub _handle_test_options {
+    my $options = shift;
+    # To run the command in a different directory.
+    my $chdir = delete $options->{CD} || '';
+
+    while ( my ( $key, $value ) = each %{ $options } ) {
+        $key =~ m/^STD(OUT|ERR)$/
+            or die "I don't know how to redirect '$key' yet!";
+        my $strvalue = "$value";        # filehandle `eq' string will fail
+        $value = File::Spec->devnull()  # on older perls, so stringify it
+            if $strvalue eq '/dev/null';
+    }
+
+    my $out = $options->{'STDOUT'} || '';
+    my $err = $options->{'STDERR'} || '';
+    ##  File::Temp overloads 'eq' here, so we need the quotes. RT #58840
+    if ( $out and $err and "$out" eq "$err" ) {
+        $err = '&STDOUT';
+    }
+    return ( $out, $err, $chdir );
+}
+
+sub _handle_blib_path {
+    my $blib_path =
+        File::Spec->catfile( $PConfig{build_dir}, 'blib', 'lib' );
+    if ($^O eq 'cygwin') {
+        $ENV{PATH} = $blib_path . ':' . $ENV{PATH};
+    }
+    elsif ($^O eq 'MSWin32') {
+        $ENV{PATH} = $blib_path . ';' . $ENV{PATH};
+    }
+    else {
+        $ENV{LD_RUN_PATH} = $blib_path;
+    }
+}
+
+sub _handle_command {
+    my $command = shift;
+    $command = [$command] unless ( ref $command );
+
+    if ( defined $ENV{VALGRIND} ) {
+        $_ = "$ENV{VALGRIND} $_" for (@$command);
+    }
+    return $command;
+}
+
+sub _prepare_exit_message {
+    my $exit_code = $?;
+    return (
+          ( $exit_code < 0 )    ? $exit_code
+        : ( $exit_code & 0xFF ) ? "[SIGNAL $exit_code]"
+        : ( $? >> 8 )
+    );
+}
+
 sub generate_languages_functions {
 
     my %test_map = (
@@ -1084,7 +1084,7 @@
 =item C<example_output_isnt( $example_f, $expected, @todo )>
 
 Determines the language, PIR or PASM, from the extension of C<$example_f> and runs
-the appropriate C<^language_output_(is|kike|isnt)> sub.
+the appropriate C<^language_output_(is|like|isnt)> sub.
 C<$example_f> is used as a description, so don't pass one.
 
 =item C<skip($why, $how_many)>



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