Author: coke
Date: Fri Aug  5 09:00:13 2005
New Revision: 8822

Modified:
   trunk/languages/tcl/t/cmd_break.t
   trunk/languages/tcl/t/cmd_continue.t
   trunk/languages/tcl/t/cmd_eval.t
   trunk/languages/tcl/t/cmd_exit.t
   trunk/languages/tcl/t/cmd_for.t
   trunk/languages/tcl/t/cmd_format.t
   trunk/languages/tcl/t/cmd_if.t
   trunk/languages/tcl/t/cmd_incr.t
   trunk/languages/tcl/t/cmd_inline.t
   trunk/languages/tcl/t/cmd_proc.t
   trunk/languages/tcl/t/cmd_rename.t
   trunk/languages/tcl/t/cmd_return.t
   trunk/languages/tcl/t/cmd_set.t
   trunk/languages/tcl/t/cmd_source.t
   trunk/languages/tcl/t/cmd_time.t
   trunk/languages/tcl/t/cmd_while.t
   trunk/languages/tcl/t/tcl_backslash.t
   trunk/languages/tcl/t/tcl_misc.t
Log:
Update all partcl tests to use saner style.



Modified: trunk/languages/tcl/t/cmd_break.t
==============================================================================
--- trunk/languages/tcl/t/cmd_break.t   (original)
+++ trunk/languages/tcl/t/cmd_break.t   Fri Aug  5 09:00:13 2005
@@ -5,25 +5,22 @@ use lib qw(tcl/t t . ../lib ../../lib ..
 use Parrot::Test tests => 2;
 use Test::More;
 
-my($tcl,$expected);
-
-$tcl = <<'EOTCL';
+language_output_is("tcl",<<'TCL',<<OUT,"break from for");
  for {set a 0} {$a < 20} {incr a} {
    if {$a > 10} { break }
  }
  puts $a
-EOTCL
-$expected = "11\n";
-language_output_is("tcl",$tcl,$expected,"break from for");
-
+TCL
+11
+OUT
 
-$tcl = <<'EOTCL';
+language_output_is("tcl",<<'TCL',<<OUT,"break from while");
  set a 20
  while {$a} {
    incr a -1
    if {$a < 10} { break }
  }
  puts $a
-EOTCL
-$expected = "9\n";
-language_output_is("tcl",$tcl,$expected,"break from while");
+TCL
+9
+OUT

Modified: trunk/languages/tcl/t/cmd_continue.t
==============================================================================
--- trunk/languages/tcl/t/cmd_continue.t        (original)
+++ trunk/languages/tcl/t/cmd_continue.t        Fri Aug  5 09:00:13 2005
@@ -4,18 +4,14 @@ use strict;
 use lib qw(tcl/t t . ../lib ../../lib ../../../lib);
 use Parrot::Test tests => 2;
 use Test::More;
-use vars qw($TODO);
 
-my($tcl,$expected);
-
-$tcl = <<'EOTCL';
+language_output_is("tcl",<<'TCL',<<OUT,"continue from for");
  for {set a 0} {$a < 10} {incr a} {
    if {$a > 5} { continue }
    puts $a
  }
  puts $a
-EOTCL
-$expected = <<EOF;
+TCL
 0
 1
 2
@@ -23,11 +19,9 @@ $expected = <<EOF;
 4
 5
 10
-EOF
-language_output_is("tcl",$tcl,$expected,"continue from for");
-
+OUT
 
-$tcl = <<'EOTCL';
+language_output_is("tcl",<<'TCL',<<OUT,"continue from while");
  set a 0
  while {$a <= 10} {
    incr a
@@ -36,8 +30,7 @@ $tcl = <<'EOTCL';
  }
  puts "--"
  puts $a
-EOTCL
-$expected = <<EOF;
+TCL
 5
 6
 7
@@ -47,5 +40,4 @@ $expected = <<EOF;
 11
 --
 11
-EOF
-language_output_is("tcl",$tcl,$expected,"continue from while");
+OUT

Modified: trunk/languages/tcl/t/cmd_eval.t
==============================================================================
--- trunk/languages/tcl/t/cmd_eval.t    (original)
+++ trunk/languages/tcl/t/cmd_eval.t    Fri Aug  5 09:00:13 2005
@@ -5,12 +5,10 @@ use lib qw(tcl/t t . ../lib ../../lib ..
 use Parrot::Test tests => 1;
 use Test::More;
 
-my($tcl,$expected);
-
-$tcl = <<'EOTCL';
+language_output_is("tcl",<<'TCL',<<OUT,"simple eval");
  set code "set a 2"
  set b [eval $code]
  puts $b
-EOTCL
-$expected = "2\n";
-language_output_is("tcl",$tcl,$expected,"simple eval");
+TCL
+2
+OUT

Modified: trunk/languages/tcl/t/cmd_exit.t
==============================================================================
--- trunk/languages/tcl/t/cmd_exit.t    (original)
+++ trunk/languages/tcl/t/cmd_exit.t    Fri Aug  5 09:00:13 2005
@@ -5,14 +5,12 @@ use lib qw(tcl/t t . ../lib ../../lib ..
 use Parrot::Test tests => 1;
 use Test::More;
 
-my($tcl,$expected);
-
-$tcl = <<'EOTCL';
+language_output_is("tcl",<<'TCL',<<OUT,"noarg");
  puts here
  exit
  puts nothere
-EOTCL
-$expected = "here\n";
-language_output_is("tcl",$tcl,$expected,"noarg");
+TCL
+here
+OUT
 
-# XXX should check return value of exit, also
+# TODO: should check return value of exit, also

Modified: trunk/languages/tcl/t/cmd_for.t
==============================================================================
--- trunk/languages/tcl/t/cmd_for.t     (original)
+++ trunk/languages/tcl/t/cmd_for.t     Fri Aug  5 09:00:13 2005
@@ -5,18 +5,14 @@ use lib qw(tcl/t t . ../lib ../../lib ..
 use Parrot::Test tests => 1;
 use Test::More;
 
-my($tcl,$expected);
-
-$tcl = <<'EOTCL';
+language_output_is("tcl",<<'TCL',<<OUT,"simple for");
  for {set a 0} {$a < 5} {incr a} {
    puts $a 
  }
-EOTCL
-$expected = <<EOF;
+TCL
 0
 1
 2
 3
 4
-EOF
-language_output_is("tcl",$tcl,$expected,"simple for");
+OUT

Modified: trunk/languages/tcl/t/cmd_format.t
==============================================================================
--- trunk/languages/tcl/t/cmd_format.t  (original)
+++ trunk/languages/tcl/t/cmd_format.t  Fri Aug  5 09:00:13 2005
@@ -5,12 +5,9 @@ use lib qw(tcl/t t . ../lib ../../lib ..
 use Parrot::Test tests => 1;
 use Test::More;
 
-my($tcl,$expected);
-
-$tcl = <<'EOTCL';
+language_output_is("tcl",<<'TCL',<<OUT,"simple format check");
  set a [format "%05d" 12]
  puts $a
-EOTCL
-$expected = "00012\n";
-# it's a passthrough to parrot's format op, so...
-language_output_is("tcl",$tcl,$expected,"simple format check");
+TCL
+00012
+OUT

Modified: trunk/languages/tcl/t/cmd_if.t
==============================================================================
--- trunk/languages/tcl/t/cmd_if.t      (original)
+++ trunk/languages/tcl/t/cmd_if.t      Fri Aug  5 09:00:13 2005
@@ -5,69 +5,57 @@ use lib qw(tcl/t t . ../lib ../../lib ..
 use Parrot::Test tests => 9;
 use Test::More;
 
-my($tcl,$expected);
-
-$tcl = <<'EOTCL';
+language_output_is("tcl",<<'TCL',<<OUT,"simple if");
  if { 1 == 1 } {
    puts true
  } {
    puts false
  }
-EOTCL
-$expected = <<EOL;
+TCL
 true
-EOL
-language_output_is("tcl",$tcl,$expected,"simple if");
+OUT
 
-$tcl = <<'EOTCL';
+language_output_is("tcl",<<'TCL',<<OUT,"simple if with else");
  if { 1 == 1 } {
    puts true
  } else {
    puts false
  }
-EOTCL
-$expected = <<EOL;
+TCL
 true
-EOL
-language_output_is("tcl",$tcl,$expected,"simple if with else");
+OUT
 
-$tcl = <<'EOTCL';
+language_output_is("tcl",<<'TCL',<<OUT,"simple if with then");
  if { 1 != 1 } then {
    puts true
  } {
    puts false
  }
-EOTCL
-$expected = <<EOL;
+TCL
 false
-EOL
-language_output_is("tcl",$tcl,$expected,"simple if with then");
+OUT
 
-$tcl = <<'EOTCL';
+language_output_is("tcl",<<'TCL',<<OUT,"simple if with then, else");
  if { 1 == 1 } then {
    puts true
  } else {
    puts false
  }
-EOTCL
-$expected = <<EOL;
+TCL
 true
-EOL
-language_output_is("tcl",$tcl,$expected,"simple if with then, else");
+OUT
 
-$tcl = <<'EOTCL';
+language_output_is("tcl",<<'TCL',<<OUT,"simple if with then, elseif");
  if { 1 != 1 } then {
    puts true
  } elseif { 2==2 } {
    puts blue
  }
-EOTCL
-$expected = <<EOL;
+TCL
 blue
-EOL
-language_output_is("tcl",$tcl,$expected,"simple if with then, elseif");
+OUT
 
-$tcl = <<'EOTCL';
+language_output_is("tcl",<<'TCL',<<OUT,"simple if with then, elseif, else");
  if { 1 != 1 } then {
    puts true
  } elseif { 2 != 2 } {
@@ -75,13 +63,11 @@ $tcl = <<'EOTCL';
  } else {
    puts whee
  }
-EOTCL
-$expected = <<EOL;
+TCL
 whee
-EOL
-language_output_is("tcl",$tcl,$expected,"simple if with then, elseif,else");
+OUT
 
-$tcl = <<'EOTCL';
+language_output_is("tcl",<<'TCL',<<OUT,"simple if with elseif, implicit else");
  if { 1 != 1 } {
    puts true
  } elseif { 2 != 2 } {
@@ -89,26 +75,20 @@ $tcl = <<'EOTCL';
  } {
    puts whee
  }
-EOTCL
-$expected = <<EOL;
+TCL
 whee
-EOL
-language_output_is("tcl",$tcl,$expected,"simple if with elseif, implicit 
else");
+OUT
 
-$tcl = <<'EOTCL';
+language_output_is("tcl",<<'TCL','',"simple if with implicit then, false");
  if { 1 != 1 } {
    puts true
  }
-EOTCL
-$expected = "";
-language_output_is("tcl",$tcl,$expected,"simple if with implicit then, false");
+TCL
 
-$tcl = <<'EOTCL';
+language_output_is("tcl",<<'TCL',<<OUT,"simple if with implicit then, true");
  if { 1 == 1 } {
    puts true
  }
-EOTCL
-$expected = <<EOL;
+TCL
 true
-EOL
-language_output_is("tcl",$tcl,$expected,"simple if with implicit then, true");
+OUT

Modified: trunk/languages/tcl/t/cmd_incr.t
==============================================================================
--- trunk/languages/tcl/t/cmd_incr.t    (original)
+++ trunk/languages/tcl/t/cmd_incr.t    Fri Aug  5 09:00:13 2005
@@ -5,44 +5,42 @@ use lib qw(tcl/t t . ../lib ../../lib ..
 use Parrot::Test tests => 5;
 use Test::More;
 
-my($tcl,$expected);
-
-$tcl = <<'EOTCL';
+language_output_is("tcl",<<'TCL',<<OUT,"simple");
  set a 2
  incr a
  puts $a
-EOTCL
-$expected = "3\n";
-language_output_is("tcl",$tcl,$expected,"simple");
+TCL
+3
+OUT
 
-$tcl = <<'EOTCL';
+language_output_is("tcl",<<'TCL',<<OUT,"offset");
  set a 1
  incr a 5
  puts $a
-EOTCL
-$expected = "6\n";
-language_output_is("tcl",$tcl,$expected,"offset");
+TCL
+6
+OUT
 
-$tcl = <<'EOTCL';
+language_output_is("tcl",<<'TCL',<<OUT,"negative offset");
  set a 2
  incr a -1
  puts $a
-EOTCL
-$expected = "1\n";
-language_output_is("tcl",$tcl,$expected,"negative offset");
+TCL
+1
+OUT
 
-$tcl = <<'EOTCL';
+language_output_is("tcl",<<'TCL',<<OUT,"return value");
  set a 1
  set b [incr a]
  puts $b
-EOTCL
-$expected = "2\n";
-language_output_is("tcl",$tcl,$expected,"return value");
+TCL
+2
+OUT
 
-$tcl = <<'EOTCL';
+language_output_is("tcl",<<'TCL',<<OUT,"negative base");
  set a -2
  incr a
  puts $a
-EOTCL
-$expected = "-1\n";
-language_output_is("tcl",$tcl,$expected,"negative base");
+TCL
+-1
+OUT

Modified: trunk/languages/tcl/t/cmd_inline.t
==============================================================================
--- trunk/languages/tcl/t/cmd_inline.t  (original)
+++ trunk/languages/tcl/t/cmd_inline.t  Fri Aug  5 09:00:13 2005
@@ -5,8 +5,6 @@ use lib qw(tcl/t t . ../lib ../../lib ..
 use Parrot::Test tests => 3;
 use Test::More;
 
-my($tcl,$expected);
-
 language_output_is("tcl",<<'TCL',<<'OUT',"PIR compiler");
  inline PIR {
    .sub test

Modified: trunk/languages/tcl/t/cmd_proc.t
==============================================================================
--- trunk/languages/tcl/t/cmd_proc.t    (original)
+++ trunk/languages/tcl/t/cmd_proc.t    Fri Aug  5 09:00:13 2005
@@ -6,8 +6,6 @@ use Parrot::Test tests => 4;
 use Test::More;
 use vars qw($SKIP $TODO);
 
-my($tcl,$expected);
-
 language_output_is("tcl",<<'TCL',<<OUT,"noarg");
  proc me {} {
   puts 2

Modified: trunk/languages/tcl/t/cmd_rename.t
==============================================================================
--- trunk/languages/tcl/t/cmd_rename.t  (original)
+++ trunk/languages/tcl/t/cmd_rename.t  Fri Aug  5 09:00:13 2005
@@ -5,19 +5,17 @@ use lib qw(tcl/t t . ../lib ../../lib ..
 use Parrot::Test tests => 2;
 use Test::More;
 
-my($tcl,$expected);
-
-$tcl = <<'EOTCL';
+language_output_is("tcl",<<'TCL',<<OUT,"rename");
  set a 2
  rename puts fnord
  fnord $a
-EOTCL
-$expected = "2\n";
-language_output_is("tcl",$tcl,$expected,"rename");
+TCL
+2
+OUT
 
-$tcl = <<'EOTCL';
+language_output_is("tcl",<<'TCL',<<OUT,"remove");
  rename puts ""
  puts "Whee"
-EOTCL
-$expected = "invalid command name \"puts\"\n";
-language_output_is("tcl",$tcl,$expected,"remove");
+TCL
+invalid command name "puts"
+OUT

Modified: trunk/languages/tcl/t/cmd_return.t
==============================================================================
--- trunk/languages/tcl/t/cmd_return.t  (original)
+++ trunk/languages/tcl/t/cmd_return.t  Fri Aug  5 09:00:13 2005
@@ -5,16 +5,13 @@ use lib qw(tcl/t t . ../lib ../../lib ..
 use Parrot::Test tests => 1;
 use Test::More;
 
-my($tcl,$expected);
-
-$tcl = <<'EOTCL';
+language_output_is("tcl",<<'TCL',<<OUT,"simple return");
  proc joe {} {
    set a 10
    return $a
    set a 20
  }
-
  puts [joe]
-EOTCL
-$expected = "10\n";
-language_output_is("tcl",$tcl,$expected,"simple return");
+TCL
+10
+OUT

Modified: trunk/languages/tcl/t/cmd_set.t
==============================================================================
--- trunk/languages/tcl/t/cmd_set.t     (original)
+++ trunk/languages/tcl/t/cmd_set.t     Fri Aug  5 09:00:13 2005
@@ -5,31 +5,29 @@ use lib qw(tcl/t t . ../lib ../../lib ..
 use Parrot::Test tests => 4;
 use Test::More;
 
-my($tcl,$expected);
-
-$tcl = <<'EOTCL';
+language_output_is("tcl",<<'TCL',<<OUT,"set");
  set a 2
  puts $a
-EOTCL
-$expected = "2\n";
-language_output_is("tcl",$tcl,$expected,"set");
+TCL
+2
+OUT
 
-$tcl = <<'EOTCL';
+language_output_is("tcl",<<'TCL',<<OUT,"get");
  set a 1
  puts [set a]
-EOTCL
-$expected = "1\n";
-language_output_is("tcl",$tcl,$expected,"get");
+TCL
+1
+OUT
 
-$tcl = <<'EOTCL';
- puts -nonewline $a
-EOTCL
-$expected = "can't read \"a\": no such variable\n";
-language_output_is("tcl",$tcl,$expected,"missing lexical");
+language_output_is("tcl",<<'TCL',<<OUT,"missing global");
+ puts $a
+TCL
+can't read "a": no such variable
+OUT
 
-$tcl = <<'EOTCL';
+language_output_is("tcl",<<'TCL',<<OUT,"not an array");
  set b 1
  set b(c) 2
-EOTCL
-$expected = "can't set \"b(c)\": variable isn't array\n";
-language_output_is("tcl",$tcl,$expected,"not an array");
+TCL
+can't set "b(c)": variable isn't array
+OUT

Modified: trunk/languages/tcl/t/cmd_source.t
==============================================================================
--- trunk/languages/tcl/t/cmd_source.t  (original)
+++ trunk/languages/tcl/t/cmd_source.t  Fri Aug  5 09:00:13 2005
@@ -6,32 +6,28 @@ use Parrot::Test tests => 2;
 use Test::More;
 use vars qw($TODO);
 
-my($tcl,$expected);
-
 TODO: {
-  local $TODO = "fails when run as .t - running the two tcl files manually 
works.";
+  local $TODO = "fails when run as .t - probably due to path changing.";
     
 # prolly not portable, patches welcome.
-my $source_file = <<'EOF';
+my $source_filename = "tmp.tcl";
+open (TMP,">$source_filename") or die $!;
+print TMP <<'EOF';
  set a 10
  puts $b
 EOF
-
-my $source_filename = "tmp.tcl";
-open (TMP,">$source_filename") or die $!;
-print TMP $source_file;
 close(TMP) ;
 
-$tcl = <<"EOTCL";
+language_output_is("tcl",<<TCL,<<OUT,"simple source");
  set b 20
  source "$source_filename"
  puts \$a
-EOTCL
-$expected = <<EOF;
+TCL
 20
 10
-EOF
-language_output_is("tcl",$tcl,$expected,"simple source");
+OUT
+
+# clean up temp file.
 unlink($source_filename);
 }
 

Modified: trunk/languages/tcl/t/cmd_time.t
==============================================================================
--- trunk/languages/tcl/t/cmd_time.t    (original)
+++ trunk/languages/tcl/t/cmd_time.t    Fri Aug  5 09:00:13 2005
@@ -6,16 +6,13 @@ use Parrot::Test tests => 1;
 use Test::More;
 use vars qw($TODO);
 
-my($tcl,$expected);
-
 TODO: {
   local $TODO = "pending a language_output_like test.";
     
-$tcl = <<"EOTCL";
+language_output_is("tcl",<<'TCL',<<OUT,"simple time");
  puts [time { expr 2+2 }]
-EOTCL
-$expected = <<EOF;
+TCL
 20 microseconds per iteration
-EOF
-language_output_is("tcl",$tcl,$expected,"simple time");
+OUT
+
 }

Modified: trunk/languages/tcl/t/cmd_while.t
==============================================================================
--- trunk/languages/tcl/t/cmd_while.t   (original)
+++ trunk/languages/tcl/t/cmd_while.t   Fri Aug  5 09:00:13 2005
@@ -5,22 +5,16 @@ use lib qw(tcl/t t . ../lib ../../lib ..
 use Parrot::Test tests => 1;
 use Test::More;
 
-my($tcl,$expected);
-
-$tcl = <<'EOTCL';
+language_output_is("tcl",<<'TCL',<<OUT,"simple while");
  set a 3
  while {$a} {
    puts $a
    incr a -1
  }
  puts "done"
-EOTCL
-$expected = <<EOL;
+TCL
 3
 2
 1
 done
-EOL
-language_output_is("tcl",$tcl,$expected,"simple while");
-
-# XXX should check return value of exit, also
+OUT

Modified: trunk/languages/tcl/t/tcl_backslash.t
==============================================================================
--- trunk/languages/tcl/t/tcl_backslash.t       (original)
+++ trunk/languages/tcl/t/tcl_backslash.t       Fri Aug  5 09:00:13 2005
@@ -5,68 +5,65 @@ use lib qw(tcl/t t . ../lib ../../lib ..
 use Parrot::Test tests => 35;
 use Test::More;
 
-my($tcl,$expected);
-
 language_output_is("tcl",<<'TCL',<<'OUT',"in braces");
  puts {a\n}
 TCL
 a\n
 OUT
 
-$tcl = <<'EOTCL';
- puts -nonewline "\n"
-EOTCL
-$expected = chr(0xa);
-language_output_is("tcl",$tcl,$expected,"newline");
-
-$tcl = <<'EOTCL';
- puts -nonewline "\t"
-EOTCL
-$expected = chr(0x9);
-language_output_is("tcl",$tcl,$expected,"tab");
-
-$tcl = <<'EOTCL';
- puts -nonewline "\b"
-EOTCL
-$expected = chr(0x8);
-language_output_is("tcl",$tcl,$expected,"backspace");
-
-$tcl = <<'EOTCL';
- puts -nonewline "\f"
-EOTCL
-$expected = chr(0xc);
-language_output_is("tcl",$tcl,$expected,"formfeed");
-
-$tcl = <<'EOTCL';
- puts -nonewline "\r"
-EOTCL
-$expected = chr(0xd);
-language_output_is("tcl",$tcl,$expected,"carriage return");
-
-$tcl = <<'EOTCL';
- puts -nonewline "\v"
-EOTCL
-$expected = chr(0xb);
-language_output_is("tcl",$tcl,$expected,"vertical tab");
-
-$tcl = <<'EOTCL';
- puts -nonewline "\\"
-EOTCL
-$expected = "\\";
-language_output_is("tcl",$tcl,$expected,"backslash");
-
-$tcl = <<'EOTCL';
-puts -nonewline "\q"
-EOTCL
-$expected = "q";
-language_output_is("tcl",$tcl,$expected,"normal character");
-
-$tcl = <<'EOTCL';
-puts "a\
-b"
-EOTCL
-$expected = "a b\n";
-language_output_is("tcl",$tcl,$expected,"backslash newline substitution");
+language_output_is("tcl",<<'TCL',<<'OUT',"newline");
+ puts \n
+TCL
+
+
+OUT
+
+language_output_is("tcl",<<'TCL',<<OUT,"tab");
+ puts \t
+TCL
+\t
+OUT
+
+language_output_is("tcl",<<'TCL',<<OUT,"backspace");
+ puts \b
+TCL
+\x08
+OUT
+
+language_output_is("tcl",<<'TCL',<<OUT,"formfeed");
+ puts \f
+TCL
+\x0c
+OUT
+
+language_output_is("tcl",<<'TCL',chr(0xd),"carriage return");
+ puts -nonewline \r
+TCL
+
+language_output_is("tcl",<<'TCL',<<OUT,"vertical tab");
+ puts \v
+TCL
+\x0b
+OUT
+
+language_output_is("tcl",<<'TCL',<<OUT,"backslash");
+ puts \\
+TCL
+\\
+OUT
+
+language_output_is("tcl",<<'TCL',<<OUT,"normal character");
+ puts \q
+TCL
+q
+OUT
+
+language_output_is("tcl",<<'TCL',<<OUT,"backslash newline substitution");
+ puts "a\
+       b"
+TCL
+a b
+OUT
 
 language_output_is("tcl",<<'TCL',<<OUT,"octal single digit");
   set a \7

Modified: trunk/languages/tcl/t/tcl_misc.t
==============================================================================
--- trunk/languages/tcl/t/tcl_misc.t    (original)
+++ trunk/languages/tcl/t/tcl_misc.t    Fri Aug  5 09:00:13 2005
@@ -6,60 +6,59 @@ use Parrot::Test tests => 16;
 use Test::More;
 use vars qw($TODO);
 
-my($tcl,$expected);
+language_output_is("tcl",<<'TCL',<<OUT,"leading spacex2 should be ok");
+   puts Parsing
+TCL
+Parsing
+OUT
 
-$tcl = '  puts Parsing';
-$expected = "Parsing\n";
-language_output_is("tcl",$tcl,$expected,"leading spacex2 should be ok");
-
-
-$tcl = <<'EOTCL';
+language_output_is("tcl",<<'TCL',<<OUT,"double quoting words, puts");
  puts "Parsing"
-EOTCL
-$expected = "Parsing\n";
-language_output_is("tcl",$tcl,$expected,"double quoting words, puts");
+TCL
+Parsing
+OUT
 
-$tcl = <<'EOTCL';
+language_output_is("tcl",<<'TCL',<<OUT,"simple block quoting");
  puts {Parsing}
-EOTCL
-$expected = "Parsing\n";
-language_output_is("tcl",$tcl,$expected,"simple block quoting");
-
-$tcl = <<'EOTCL';
- puts Parsing;
-EOTCL
-$expected = "Parsing\n";
-language_output_is("tcl",$tcl,$expected,"bare words should be allowed");
+TCL
+Parsing
+OUT
+
+language_output_is("tcl",<<'TCL',<<OUT,"bare words should be allowed");
+ puts Parsing
+TCL
+Parsing
+OUT
 
-$tcl = <<'EOTCL';
+language_output_is("tcl",<<'TCL',<<OUT,"hash isn't a comment if it only starts 
a word (not a command)");
  puts #whee
  exit ;
-EOTCL
-$expected = "#whee\n";
-language_output_is("tcl",$tcl,$expected,"hash isn't a comment if it starts a 
word");
+TCL
+#whee
+OUT
 
-$tcl = <<'EOTCL';
+language_output_is("tcl",<<'TCL',<<OUT,"no arg command");
  puts {test}
  exit
  puts {bar}
-EOTCL
-$expected = "test\n";
-language_output_is("tcl",$tcl,$expected,"no arg command");
+TCL
+test
+OUT
 
-$tcl = <<'EOTCL';
+language_output_is("tcl",<<'TCL',<<OUT,"no arg command with semicolon");
  puts {test}
  exit;
  puts {bar}
-EOTCL
-$expected = "test\n";
-language_output_is("tcl",$tcl,$expected,"no arg command with semicolon");
+TCL
+test
+OUT
 
-$tcl = <<'EOTCL';
+language_output_is("tcl",<<'TCL',<<OUT,"no arg command with spaced semicolon");
  puts {test}
  exit ;
-EOTCL
-$expected = "test\n";
-language_output_is("tcl",$tcl,$expected,"no arg command with spaced 
semicolon");
+TCL
+test
+OUT
 
 language_output_is("tcl",<<'TCL',<<'OUT',"\$ is only a variable if it's 
followed by \\w or {");
 set x $

Reply via email to