[svn:parrot] r12512 - trunk/languages/regex/lib/Parrot/Test

[fperrad]

Author: fperrad
Date: Fri May  5 00:12:06 2006
New Revision: 12512

Modified:
   trunk/languages/regex/lib/Parrot/Test/Regex.pm

Log:
some improvements for Win32

Modified: trunk/languages/regex/lib/Parrot/Test/Regex.pm
==============================================================================
--- trunk/languages/regex/lib/Parrot/Test/Regex.pm      (original)
+++ trunk/languages/regex/lib/Parrot/Test/Regex.pm      Fri May  5 00:12:06 2006
@@ -9,6 +9,7 @@
 use Data::Dumper;
 use File::Basename;
 use File::Spec::Functions;
+use Parrot::Config;
 
 
 =head1 NAME
@@ -21,9 +22,7 @@
 
 =cut
 
-# FIXME: This is still probably unix-only, because the parrot binary
-# will have different names
-my $PARROT_EXE = catfile(catdir($FindBin::Bin, updir(), updir(), updir(), 
updir()), "parrot");
+my $PARROT_EXE = File::Spec->catfile( File::Spec->updir(), $PConfig{test_prog} 
);
 
 sub run_spec {
     my ( $spec_fh ) = @_;
@@ -31,8 +30,6 @@
     my $pattern = <$spec_fh>;
     chomp($pattern);
 
-    generate_regular($pattern);
-
     $_ = <$spec_fh>;
     my @spec;
     while (1) {
@@ -42,10 +39,10 @@
          die "INPUT: expected" if ! /^INPUT:/;
 
          # Gather input, look for OUTPUT:
-         $input = '';
+         $input = q{};
          undef $output;
          while (<$spec_fh>) {
-             $output = '', last if /^OUTPUT:/;
+             $output = q{}, last if /^OUTPUT:/;
              $input .= $_;
          }
          chomp($input);
@@ -61,6 +58,9 @@
     }
     
     Test::More::plan( tests => scalar(@spec) );
+
+    generate_regular($pattern);
+
     foreach ( @spec ) {
         process($_->{input}, $_->{output});
     }
@@ -70,51 +70,54 @@
 
 sub generate_regular_pir {
     my ($filename, $pattern) = @_;
-    open(PIR, ">$filename") or die "create $filename: $!";
+    my $PIR;
+    open($PIR, '>', $filename) or die "create $filename: $!";
 
     my $ctx = { };
     my $trees = Regex::expr_to_tree($pattern, $ctx, DEBUG => 0);
 
     my $driver = Regex::Driver->new('pir', emit_main => 1);
 
-    print PIR <<"END";
+    print $PIR <<"END";
 # Regular expression test
 # Generated by $0
 # Pattern >>$pattern<<
 
 END
 
-    $driver->output_header(*PIR);
+    $driver->output_header($PIR);
 
     for my $tree (@$trees) {
-        $driver->output_rule(*PIR, '_regex', $tree, $ctx, DEBUG => 0);
+        $driver->output_rule($PIR, '_regex', $tree, $ctx, DEBUG => 0);
     }
 
-    close PIR;
+    close $PIR;
 }
 
 sub generate_pbc {
     my ($pir, $pbc) = @_;
-    my $status = system("$PARROT_EXE", "-o", $pbc, $pir);
+    my $status = system($PARROT_EXE, '-o', $pbc, $pir);
     if (! defined($status) || $status) {
         die "assemble failed with status " . ($? >> 8);
     }
 }
 
 sub generate_regular {
-    my $pattern = shift;
+    my ($pattern) = @_;
 
-    generate_regular_pir("test_regex.pir", $pattern);
-    generate_pbc("test_regex.pir", "test_regex.pbc");
+    generate_regular_pir('test_regex.pir', $pattern);
+    generate_pbc('test_regex.pir', 'test_regex.pbc');
 }
 
 sub process {
     my ($input, $output) = @_;
 
-    open(TEST, "$PARROT_EXE test_regex.pbc '$input' |");
+    my $TEST;
+    open($TEST, "$PARROT_EXE test_regex.pbc '$input' |");
 
     local $/;
-    my $actual_output = <TEST>;
+    my $actual_output = <$TEST>;
+    close $TEST;
     Test::More::is($actual_output, $output); 
 
     return;