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 $