Author: coke
Date: Thu Feb 9 11:44:12 2006
New Revision: 11490
Modified:
trunk/languages/tcl/config/root.in
trunk/languages/tcl/lib/Parrot/Test/Tcl.pm
trunk/languages/tcl/t/cmd_pwd.t
trunk/languages/tcl/t/cmd_source.t
Log:
Tcl -
Fix a long standing issue in the tcl test harness. It hasn't been required
to chdir up to the top level parrot dir to run parrot for some time now.
This also lets us more easily keep the generated .tcl files during
testing, and lets us pass two tests that were failing due to the chdir.
Anyone who's cargo culted Parrot::Test::Tcl might want to cargo this as well.
Modified: trunk/languages/tcl/config/root.in
==============================================================================
--- trunk/languages/tcl/config/root.in (original)
+++ trunk/languages/tcl/config/root.in Thu Feb 9 11:44:12 2006
@@ -193,6 +193,8 @@ tcl.pbc \
#CONDITIONED_LINE(ld_parrot_exe_def):"$(PMCDIR)@[EMAIL PROTECTED]" \
"$(PMCDIR)@[EMAIL PROTECTED]" \
"$(PMCDIR)@[EMAIL PROTECTED](O)" \
+"[EMAIL PROTECTED]@*.pir" \
+"[EMAIL PROTECTED]@*.tcl" \
$(GENERATED_INLINES)
clean:
Modified: trunk/languages/tcl/lib/Parrot/Test/Tcl.pm
==============================================================================
--- trunk/languages/tcl/lib/Parrot/Test/Tcl.pm (original)
+++ trunk/languages/tcl/lib/Parrot/Test/Tcl.pm Thu Feb 9 11:44:12 2006
@@ -33,33 +33,51 @@ foreach my $func ( keys %language_test_m
$count = $self->{builder}->current_test + 1;
$desc = $language unless $desc;
-
+
+ # Figure out how many levels we have to go back to get to parrot.
+ # And, conversely, how many levels we have to go down to get to
+ # the tcl binary.
+
+ # There are basically 3 choices: run in one of:
+ # languages
+ # languages/tcl
+ # languages/tcl/t
+
+ my $path_to_parrot = $INC{"Parrot/Config.pm"};
+ $path_to_parrot =~ s:/lib/Parrot/Config.pm$::;
+ print "$path_to_parrot\n";
+ my $dir_count = scalar(File::Spec->splitdir($path_to_parrot));
+ my $path_to_tcl;
+ print "DIR COUNT : $dir_count\n";
+ if ($dir_count <2) {
+ $path_to_tcl = File::Spec->join((qw{languages tcl})[0..$dir_count]);
+ } elsif ($dir_count >2) {
+ $path_to_tcl = File::Spec->join(File::Spec->updir() x ($dir_count - 2));
+ } else {
+ $path_to_tcl = ".";
+ }
+
my $lang_f = Parrot::Test::per_test('.tcl',$count);
my $out_f = Parrot::Test::per_test('.out',$count);
- my $parrotdir = dirname $self->{parrot};
$TEST_PROG_ARGS = $ENV{TEST_PROG_ARGS} || '';
my $args = $TEST_PROG_ARGS;
- # flatten filenames (don't use directories)
- $lang_f = (File::Spec->splitpath($lang_f))[2];
- $out_f = (File::Spec->splitpath($out_f))[2];
- # but, always put the test in a tempdir, so we're not cluttering
- $lang_f = File::Spec->catfile(File::Spec->tmpdir(),$lang_f);
- $out_f = File::Spec->catfile(File::Spec->tmpdir(),$out_f);
- Parrot::Test::generate_code( $code, $parrotdir, $count, $lang_f );
+ Parrot::Test::generate_code( $code, undef, undef, $lang_f );
my $cmd;
my $exit_code = 0;
my $pass = 0;
- my $executable = "$self->{parrot} $args languages/tcl/tcl.pbc";
+ my $executable = File::Spec->join($path_to_parrot,$self->{parrot}) .
+ " $args " . File::Spec->join($path_to_tcl, 'tcl.pbc');
+ print "USING $executable\n";
if (defined($ENV{PARROT_TCLSH})) {
$executable = $ENV{PARROT_TCLSH};
}
$cmd = "$executable $lang_f";
- $exit_code = Parrot::Test::run_command($cmd, CD => $self->{relpath},
+ $exit_code = Parrot::Test::run_command($cmd, #CD => $self->{relpath},
STDOUT => $out_f, STDERR => $out_f);
unless ($pass) {
@@ -76,7 +94,6 @@ foreach my $func ( keys %language_test_m
}
unless($ENV{POSTMORTEM}) {
- unlink $lang_f;
unlink $out_f;
}
Modified: trunk/languages/tcl/t/cmd_pwd.t
==============================================================================
--- trunk/languages/tcl/t/cmd_pwd.t (original)
+++ trunk/languages/tcl/t/cmd_pwd.t Thu Feb 9 11:44:12 2006
@@ -11,9 +11,6 @@ TCL
wrong # args: should be "pwd"
OUT
-TODO: {
- local $TODO = "test harness does a chdir...";
-
use Cwd;
my $dir = getcwd;
@@ -22,4 +19,3 @@ language_output_is("tcl",<<'TCL',<<"OUT"
TCL
$dir
OUT
-}
Modified: trunk/languages/tcl/t/cmd_source.t
==============================================================================
--- trunk/languages/tcl/t/cmd_source.t (original)
+++ trunk/languages/tcl/t/cmd_source.t Thu Feb 9 11:44:12 2006
@@ -4,10 +4,6 @@ use strict;
use lib qw(tcl/lib ./lib ../lib ../../lib ../../../lib);
use Parrot::Test tests => 2;
use Test::More;
-use vars qw($TODO);
-
-TODO: {
- local $TODO = "fails when run as .t - probably due to path changing.";
# prolly not portable, patches welcome.
my $source_filename = "tmp.tcl";
@@ -29,7 +25,6 @@ OUT
# clean up temp file.
unlink($source_filename);
-}
language_output_is("tcl",<<'TCL',<<'OUT',"invalid file");
source "hopefullynonexistantfile.tcl"
