[svn:parrot] r10765 - in trunk/languages/tcl/t: . Parrot/Test

[bernhard]

Author: bernhard
Date: Thu Dec 29 09:42:31 2005
New Revision: 10765

Modified:
   trunk/languages/tcl/t/Parrot/Test/Tcl.pm
   trunk/languages/tcl/t/cmd_time.t
Log:
Tcl: Add Parrot::Test::Tcl::output_like() in order to
make tcl/t/cmd_time.t succeed.


Modified: trunk/languages/tcl/t/Parrot/Test/Tcl.pm
==============================================================================
--- trunk/languages/tcl/t/Parrot/Test/Tcl.pm    (original)
+++ trunk/languages/tcl/t/Parrot/Test/Tcl.pm    Thu Dec 29 09:42:31 2005
@@ -2,6 +2,8 @@ package Parrot::Test::Tcl;
 
 use File::Basename;
 
+require Parrot::Test;
+
 =head1 Parrot::Test::Tcl
 
 Provide language specific testing routines here...
@@ -15,7 +17,16 @@ sub new {
   return bless {};
 }
 
-sub output_is() {
+
+my %language_test_map = (
+    output_is         => 'is_eq',
+    output_like       => 'like',
+    output_isnt       => 'isnt_eq'
+                        );
+
+foreach my $func ( keys %language_test_map ) {
+
+  *{"Parrot::Test::Tcl::$func"} = sub ($$;$) {
 
   my ($self, $code, $output, $desc) = @_;
   
@@ -49,7 +60,13 @@ sub output_is() {
   
   unless ($pass) {
     my $file = Parrot::Test::slurp_file($out_f);
-    $pass =$self->{builder}->is_eq( Parrot::Test::slurp_file($out_f), $output, 
$desc );
+    my $builder_func = $language_test_map{$func};
+    
+    {
+       no strict 'refs';
+
+       $pass = $self->{builder}->$builder_func( 
Parrot::Test::slurp_file($out_f), $output, $desc );
+    }
     $self->{builder}->diag("'$cmd' failed with exit code $exit_code")
       if $exit_code and not $pass;
   }
@@ -61,5 +78,6 @@ sub output_is() {
 
   return $pass;
 }
+}
 
 1;

Modified: trunk/languages/tcl/t/cmd_time.t
==============================================================================
--- trunk/languages/tcl/t/cmd_time.t    (original)
+++ trunk/languages/tcl/t/cmd_time.t    Thu Dec 29 09:42:31 2005
@@ -3,16 +3,7 @@
 use strict;
 use lib qw(tcl/t t . ../lib ../../lib ../../../lib);
 use Parrot::Test tests => 1;
-use Test::More;
-use vars qw($TODO);
 
-TODO: {
-  local $TODO = "pending a language_output_like test.";
-    
-language_output_is("tcl",<<'TCL',<<OUT,"simple time");
+language_output_like('tcl', <<'TCL', '/\d+ microseconds per iteration\n/', 
'simple time');
  puts [time { expr 2+2 }]
 TCL
-20 microseconds per iteration
-OUT
-
-}