Author: leo Date: Mon Aug 8 04:32:35 2005 New Revision: 8866 Modified: branches/leo-ctx5/MANIFEST branches/leo-ctx5/languages/LANGUAGES.STATUS branches/leo-ctx5/languages/bc/README branches/leo-ctx5/languages/bc/TODO branches/leo-ctx5/languages/bc/docs/parrot_bc.pod branches/leo-ctx5/languages/bc/grammar/bc_python.g branches/leo-ctx5/languages/bc/python/lib/bc/BcLexer.py branches/leo-ctx5/languages/bc/python/lib/bc/BcLexerTokenTypes.txt branches/leo-ctx5/languages/bc/python/lib/bc/BcParser.py branches/leo-ctx5/languages/bc/python/lib/bc/BcTreeWalker.py branches/leo-ctx5/languages/bc/t/basic.t branches/leo-ctx5/languages/bc/t/harness branches/leo-ctx5/languages/tcl/lib/commands/rename.pir branches/leo-ctx5/languages/tcl/lib/parser.pir branches/leo-ctx5/languages/tcl/lib/variables.pir branches/leo-ctx5/languages/tcl/t/cmd_rename.t branches/leo-ctx5/languages/tcl/t/tcl_misc.t branches/leo-ctx5/languages/tcl/t/tcl_var_subst.t branches/leo-ctx5/languages/tcl/tcl-test.pl branches/leo-ctx5/t/pmc/timer.t branches/leo-ctx5/t/src/extend.t Log: merge -r8854:8865 from trunk
Modified: branches/leo-ctx5/MANIFEST ============================================================================== --- branches/leo-ctx5/MANIFEST (original) +++ branches/leo-ctx5/MANIFEST Mon Aug 8 04:32:35 2005 @@ -1455,6 +1455,7 @@ languages/tcl/t/cmd_linsert.t languages/tcl/t/cmd_list.t [tcl] languages/tcl/t/cmd_llength.t [tcl] languages/tcl/t/cmd_lrepeat.t [tcl] +languages/tcl/t/cmd_lset.t [tcl] languages/tcl/t/cmd_proc.t [tcl] languages/tcl/t/cmd_puts.t [tcl] languages/tcl/t/cmd_rename.t [tcl] Modified: branches/leo-ctx5/languages/LANGUAGES.STATUS ============================================================================== --- branches/leo-ctx5/languages/LANGUAGES.STATUS (original) +++ branches/leo-ctx5/languages/LANGUAGES.STATUS Mon Aug 8 04:32:35 2005 @@ -1,11 +1,11 @@ -If you submit a language compiler please write a one-liner below -indicating roughly the state of your language. Does it have -samples, do they work? Is there a README and an easy way -to build it? The fields are: (N) Language name, (A) authors/maintainers, (D) +If you submit a language compiler please write a one-liner that roughly +indicates the state of your language. Where can the source be found? +Does it have samples and do they work? +Is there a README and an easy way to build it? +The fields are: (N) Language name, (A) authors/maintainers, (D) description, (S) status, (M) maintained, (V) minimum Parrot version required, (W) website. - N: Amber for parrot A: Roger Browne D: Scripting language inspired by Eiffel and ruby @@ -31,10 +31,10 @@ V: 0.0.11 N: bc A: Bernhard Schmalhofer -D: Needs ANTLR and Python -S: basic arithmetics working +D: Based on ANTLR and Python +S: very simple arithmetic expressions are working M: Yes -V: 0.2.2 +V: 0.2.3 N: befunge A: Jerome Quelin @@ -97,6 +97,7 @@ V: 0.2.2 N: Lua for Pirate, formerly known as Pirate, a new name is sought A: Klaas-Jan Stol D: Making Lua work on Parrot +S: Not in Parrot CVS, source available from the website W: http://members.home.nl/joeijoei/parrot/ M: Yes @@ -141,8 +142,11 @@ D: An example on how the builtin compile N: Perl6 A: Sean O'Rourke D: Perl6 compiler written in Perl5 -S: Largely functional, but stalled -M: Yes +S: This prototype of a Perl6 compiler was abandoned in June 2004. Current +S: work on the compiler may be found in the development of Pugs, +S: http://www.pugscode.org, and in the Parrot grammar engine (PGE) in +S: the Parrot repository at compilers/pge. +M: No V: 0.0.11 N: Pint Modified: branches/leo-ctx5/languages/bc/README ============================================================================== --- branches/leo-ctx5/languages/bc/README (original) +++ branches/leo-ctx5/languages/bc/README Mon Aug 8 04:32:35 2005 @@ -1,7 +1,7 @@ # Copyright: 2005 The Perl Foundation. All Rights Reserved. # $Id$ -Implementation of 'POSIX bc' with the help Python code created from +This in an implementation of 'POSIX bc' with the help Python code created from an ANTLR grammar. Requirements: @@ -17,4 +17,4 @@ Building: Testing: 'make test'. When GNU bc is available, the test suite will be run against GNU bc as well. - +For compatability with 'POSIX bc' the flags '--standard' and '--quiet' are used. Modified: branches/leo-ctx5/languages/bc/TODO ============================================================================== --- branches/leo-ctx5/languages/bc/TODO (original) +++ branches/leo-ctx5/languages/bc/TODO Mon Aug 8 04:32:35 2005 @@ -1,8 +1,10 @@ # Copyright: 2005 The Perl Foundation. All Rights Reserved. # $Id$ -A fairly concrete list of TODOs for Parrot bc. See docs/parrot_bc.pod for visions. +A fairly concrete list of TODOs for Parrot bc. +See docs/parrot_bc.pod for visions. +- TODO in t/basic.t is no longer handled - Format 0.1 as .1 - Open a ticket in RT Modified: branches/leo-ctx5/languages/bc/docs/parrot_bc.pod ============================================================================== --- branches/leo-ctx5/languages/bc/docs/parrot_bc.pod (original) +++ branches/leo-ctx5/languages/bc/docs/parrot_bc.pod Mon Aug 8 04:32:35 2005 @@ -3,11 +3,12 @@ =head1 Overview -This implementation of bc is based on ANTLR. +This is an implementation of 'POSIX bc'. It is based on ANTLR. =head1 Why Parrot bc -Self education. +Self education. A fairly simple language but has symbols and subroutines. +Test for decimal bignum libraries. =head2 Vision Modified: branches/leo-ctx5/languages/bc/grammar/bc_python.g ============================================================================== --- branches/leo-ctx5/languages/bc/grammar/bc_python.g (original) +++ branches/leo-ctx5/languages/bc/grammar/bc_python.g Mon Aug 8 04:32:35 2005 @@ -174,7 +174,7 @@ input_item ; semicolon_list - : statement (SEMICOLON statement)* + : statement (SEMICOLON! statement)* ; statement @@ -357,7 +357,7 @@ tokens plus! returns [reg_name] : #(PLUS reg_name_left=left:expr reg_name_right=right:expr) { - reg_name = "P%d" % self.reg_num + reg_name = "$P%d" % self.reg_num self.reg_num = self.reg_num + 1 pir = "\n" + \ reg_name + " = new .Float\n" + \ @@ -369,7 +369,7 @@ plus! returns [reg_name] minus! returns [reg_name] : #(MINUS reg_name_left=left:expr reg_name_right=right:expr) { - reg_name = "P%d" % self.reg_num + reg_name = "$P%d" % self.reg_num self.reg_num = self.reg_num + 1 pir = "\n" + \ reg_name + " = new .Float\n" + \ @@ -381,7 +381,7 @@ minus! returns [reg_name] mul! returns [reg_name] : #(MUL reg_name_left=left:expr reg_name_right=right:expr) { - reg_name = "P%d" % self.reg_num + reg_name = "$P%d" % self.reg_num self.reg_num = self.reg_num + 1 pir = "\n" + \ reg_name + " = new .Float\n" + \ @@ -393,7 +393,7 @@ mul! returns [reg_name] div! returns [reg_name] : #(DIV reg_name_left=left:expr reg_name_right=right:expr) { - reg_name = "P%d" % self.reg_num + reg_name = "$P%d" % self.reg_num self.reg_num = self.reg_num + 1 pir = "\n" + \ reg_name + " = new .Float\n" + \ @@ -405,7 +405,7 @@ div! returns [reg_name] mod! returns [reg_name] : #(MOD reg_name_left=left:expr reg_name_right=right:expr) { - reg_name = "P%d" % self.reg_num + reg_name = "$P%d" % self.reg_num self.reg_num = self.reg_num + 1 pir = "\n" + \ reg_name + " = new .Float\n" + \ @@ -417,7 +417,7 @@ mod! returns [reg_name] integer! returns [reg_name] : i:NUMBER { - reg_name = "P%d" % self.reg_num + reg_name = "$P%d" % self.reg_num self.reg_num = self.reg_num + 1 pir = "\n" + \ reg_name + " = new .Float\n" + \ @@ -451,18 +451,18 @@ expr returns [reg_name] ; expr_line - : reg_name=E:expr + : #( PIR_PRINT reg_name=E:expr ) { #expr = #( [ PIR_NOOP, "noop" ], #E, [PIR_OP, "\nprint "], [PIR_OP,reg_name], [PIR_NEWLINE, "\nprint \"\\n\" # "] ) } ; expr_list - : (expr)+ + : (expr_line)+ ; gen_pir! - : #( PIR_PRINT B:expr_line ) + : B:expr_list { #gen_pir = #([PIR_HEADER, "pir header tree\n#"], #B, [PIR_FOOTER, "pir footer tree\nend\n#"]); } Modified: branches/leo-ctx5/languages/bc/python/lib/bc/BcLexer.py ============================================================================== --- branches/leo-ctx5/languages/bc/python/lib/bc/BcLexer.py (original) +++ branches/leo-ctx5/languages/bc/python/lib/bc/BcLexer.py Mon Aug 8 04:32:35 2005 @@ -1,4 +1,4 @@ -### $ANTLR 2.7.5 (20050416): "bc_python.g" -> "BcLexer.py"$ +### $ANTLR 2.7.5 (20050425): "bc_python.g" -> "BcLexer.py"$ ### import antlr and other modules .. import sys import antlr Modified: branches/leo-ctx5/languages/bc/python/lib/bc/BcLexerTokenTypes.txt ============================================================================== --- branches/leo-ctx5/languages/bc/python/lib/bc/BcLexerTokenTypes.txt (original) +++ branches/leo-ctx5/languages/bc/python/lib/bc/BcLexerTokenTypes.txt Mon Aug 8 04:32:35 2005 @@ -1,4 +1,4 @@ -// $ANTLR 2.7.5 (20050416): bc_python.g -> BcLexerTokenTypes.txt$ +// $ANTLR 2.7.5 (20050425): bc_python.g -> BcLexerTokenTypes.txt$ BcLexer // output token vocab name DIGIT=4 NUMBER=5 Modified: branches/leo-ctx5/languages/bc/python/lib/bc/BcParser.py ============================================================================== --- branches/leo-ctx5/languages/bc/python/lib/bc/BcParser.py (original) +++ branches/leo-ctx5/languages/bc/python/lib/bc/BcParser.py Mon Aug 8 04:32:35 2005 @@ -1,4 +1,4 @@ -### $ANTLR 2.7.5 (20050416): "bc_python.g" -> "BcParser.py"$ +### $ANTLR 2.7.5 (20050425): "bc_python.g" -> "BcParser.py"$ ### import antlr and other modules .. import sys import antlr @@ -154,9 +154,6 @@ class Parser(antlr.LLkParser): while True: if (self.LA(1)==SEMICOLON): pass - tmp10_AST = None - tmp10_AST = self.astFactory.create(self.LT(1)) - self.addASTChild(currentAST, tmp10_AST) self.match(SEMICOLON) self.statement() self.addASTChild(currentAST, self.returnAST) Modified: branches/leo-ctx5/languages/bc/python/lib/bc/BcTreeWalker.py ============================================================================== --- branches/leo-ctx5/languages/bc/python/lib/bc/BcTreeWalker.py (original) +++ branches/leo-ctx5/languages/bc/python/lib/bc/BcTreeWalker.py Mon Aug 8 04:32:35 2005 @@ -1,4 +1,4 @@ -### $ANTLR 2.7.5 (20050416): "bc_python.g" -> "BcTreeWalker.py"$ +### $ANTLR 2.7.5 (20050425): "bc_python.g" -> "BcTreeWalker.py"$ ### import antlr and other modules .. import sys import antlr @@ -131,7 +131,7 @@ class Walker(antlr.TreeParser): _t = _t109 _t = _t.getNextSibling() plus_AST = currentAST.root - reg_name = "P%d" % self.reg_num + reg_name = "$P%d" % self.reg_num self.reg_num = self.reg_num + 1 pir = "\n" + \ reg_name + " = new .Float\n" + \ @@ -254,7 +254,7 @@ class Walker(antlr.TreeParser): _t = _t111 _t = _t.getNextSibling() minus_AST = currentAST.root - reg_name = "P%d" % self.reg_num + reg_name = "$P%d" % self.reg_num self.reg_num = self.reg_num + 1 pir = "\n" + \ reg_name + " = new .Float\n" + \ @@ -313,7 +313,7 @@ class Walker(antlr.TreeParser): _t = _t113 _t = _t.getNextSibling() mul_AST = currentAST.root - reg_name = "P%d" % self.reg_num + reg_name = "$P%d" % self.reg_num self.reg_num = self.reg_num + 1 pir = "\n" + \ reg_name + " = new .Float\n" + \ @@ -372,7 +372,7 @@ class Walker(antlr.TreeParser): _t = _t115 _t = _t.getNextSibling() div_AST = currentAST.root - reg_name = "P%d" % self.reg_num + reg_name = "$P%d" % self.reg_num self.reg_num = self.reg_num + 1 pir = "\n" + \ reg_name + " = new .Float\n" + \ @@ -431,7 +431,7 @@ class Walker(antlr.TreeParser): _t = _t117 _t = _t.getNextSibling() mod_AST = currentAST.root - reg_name = "P%d" % self.reg_num + reg_name = "$P%d" % self.reg_num self.reg_num = self.reg_num + 1 pir = "\n" + \ reg_name + " = new .Float\n" + \ @@ -472,7 +472,7 @@ class Walker(antlr.TreeParser): self.match(_t,NUMBER) _t = _t.getNextSibling() integer_AST = currentAST.root - reg_name = "P%d" % self.reg_num + reg_name = "$P%d" % self.reg_num self.reg_num = self.reg_num + 1 pir = "\n" + \ reg_name + " = new .Float\n" + \ @@ -587,11 +587,25 @@ class Walker(antlr.TreeParser): E = None try: ## for error handling pass + _t123 = _t + tmp7_AST = None + tmp7_AST_in = None + tmp7_AST = self.astFactory.create(_t) + tmp7_AST_in = _t + self.addASTChild(currentAST, tmp7_AST) + _currentAST123 = currentAST.copy() + currentAST.root = currentAST.child + currentAST.child = None + self.match(_t,PIR_PRINT) + _t = _t.getFirstChild() E = antlr.ifelse(_t == antlr.ASTNULL, None, _t) reg_name=self.expr(_t) _t = self._retTree E_AST = self.returnAST self.addASTChild(currentAST, self.returnAST) + currentAST = _currentAST123 + _t = _t123 + _t = _t.getNextSibling() expr = antlr.make(self.astFactory.create(PIR_NOOP,"noop"), E_AST, self.astFactory.create(PIR_OP,"\nprint "), self.astFactory.create(PIR_OP,reg_name), self.astFactory.create(PIR_NEWLINE,"\nprint \"\\n\" # ")) expr_line_AST = currentAST.root @@ -613,20 +627,20 @@ class Walker(antlr.TreeParser): expr_list_AST = None try: ## for error handling pass - _cnt125= 0 + _cnt126= 0 while True: if not _t: _t = antlr.ASTNULL - if (_tokenSet_0.member(_t.getType())): + if (_t.getType()==PIR_PRINT): pass - self.expr(_t) + self.expr_line(_t) _t = self._retTree self.addASTChild(currentAST, self.returnAST) else: break - _cnt125 += 1 - if _cnt125 < 1: + _cnt126 += 1 + if _cnt126 < 1: raise antlr.NoViableAltException(_t) expr_list_AST = currentAST.root @@ -650,23 +664,10 @@ class Walker(antlr.TreeParser): B = None try: ## for error handling pass - _t127 = _t - tmp7_AST = None - tmp7_AST_in = None - tmp7_AST = self.astFactory.create(_t) - tmp7_AST_in = _t - _currentAST127 = currentAST.copy() - currentAST.root = currentAST.child - currentAST.child = None - self.match(_t,PIR_PRINT) - _t = _t.getFirstChild() B = antlr.ifelse(_t == antlr.ASTNULL, None, _t) - self.expr_line(_t) + self.expr_list(_t) _t = self._retTree B_AST = self.returnAST - currentAST = _currentAST127 - _t = _t127 - _t = _t.getNextSibling() gen_pir_AST = currentAST.root gen_pir_AST = antlr.make(self.astFactory.create(PIR_HEADER,"pir header tree\n#"), B_AST, self.astFactory.create(PIR_FOOTER,"pir footer tree\nend\n#")); currentAST.root = gen_pir_AST @@ -748,10 +749,3 @@ _tokenNames = [ "PIR_NEWLINE" ] - -### generate bit set -def mk_tokenSet_0(): - ### var1 - data = [ 6274678816L, 0L] - return data -_tokenSet_0 = antlr.BitSet(mk_tokenSet_0()) Modified: branches/leo-ctx5/languages/bc/t/basic.t ============================================================================== --- branches/leo-ctx5/languages/bc/t/basic.t (original) +++ branches/leo-ctx5/languages/bc/t/basic.t Mon Aug 8 04:32:35 2005 @@ -16,7 +16,7 @@ use FindBin; use lib "$FindBin::Bin/../../lib", "$FindBin::Bin/../../../../lib"; use Test::More; -use Parrot::Test tests => 28; +use Parrot::Test tests => 30; sub run_tests { @@ -26,8 +26,15 @@ sub run_tests die "invalid test" unless ref( $test_case ) eq 'ARRAY'; die "invalid test" unless scalar(@$test_case) == 2 || scalar(@$test_case) == 3; - my ( $bc, $expected, $desc ) = @{$test_case}; - language_output_is( 'bc', "$bc\nquit\n", "$expected\n", $desc || "bc: $bc" ); + my $bc_code = $test_case->[0] . "\nquit\n"; + my $expected = ref($test_case->[1]) eq '' ? + $test_case->[1] + : + ref($test_case->[1]) eq 'ARRAY' ? + join( "\n", @{$test_case->[1]} ) : + die "expected ARRAY reference"; + my $desc = $test_case->[2] || "bc: $bc_code"; + language_output_is( 'bc', $bc_code, "$expected\n", $desc ); } } @@ -65,14 +72,16 @@ my @tests = [ '2 * 2 + .4', '4.4' ], [ '.1 - 6 / 2', '-2.9' ], [ '2 % 2 + 4', '4' ], - + # semicolons + [ '1; 2', [1, 2] ], + [ '1+1*1; 2+2*2', [2, 6] ], + [ '3-3/3; 4+4%4; 5-5+5', [2, 4, 5] ], ); + my @todo_tests = ( # floats [ '.1', '.1' ], [ '-.1', '-.1' ], - # semicolons - [ '1; 2', "1\n2" ], ); run_tests( [EMAIL PROTECTED] ); Modified: branches/leo-ctx5/languages/bc/t/harness ============================================================================== --- branches/leo-ctx5/languages/bc/t/harness (original) +++ branches/leo-ctx5/languages/bc/t/harness Mon Aug 8 04:32:35 2005 @@ -69,7 +69,7 @@ if ( grep { m/^--files$/ } @ARGV ) { }; if ( $use_gnu_bc ) { $ENV{PARROT_BC_TEST_PROG} = 'bc --standard --quiet'; - # Test::Harness::runtests( @files ) if scalar( @files ); + Test::Harness::runtests( @files ) if scalar( @files ); } } Modified: branches/leo-ctx5/languages/tcl/lib/commands/rename.pir ============================================================================== --- branches/leo-ctx5/languages/tcl/lib/commands/rename.pir (original) +++ branches/leo-ctx5/languages/tcl/lib/commands/rename.pir Mon Aug 8 04:32:35 2005 @@ -16,35 +16,48 @@ .local int return_type .local pmc retval - retval = new String + retval = new String return_type = TCL_OK retval = "" - .local pmc commands,theSub + .local string oldName + .local string newName + oldName = old_p + oldName = "&" . oldName + newName = new_p + newName = "&" . newName + + .local pmc theSub # If newName is empty, then just delete if newName == "" goto delete add: - # Grab the original sub - theSub = find_global "Tcl", oldName + # Grab the original sub + push_eh doesnt_exist + theSub = find_global "Tcl", oldName + clear_eh # Create the new sub store_global "Tcl", newName, theSub delete: - null theSub + null theSub store_global "Tcl", oldName, theSub + goto done - goto done +doesnt_exist: + return_type = TCL_ERROR + retval = "can't rename \"" + $S0 = old_p + retval .= $S0 + retval .= "\": command doesn't exist" + goto done error: return_type = TCL_ERROR retval = "wrong # args: should be \"rename oldName newName\"" done: - - store_global "commands", commands - .return(return_type,retval) .end Modified: branches/leo-ctx5/languages/tcl/lib/parser.pir ============================================================================== --- branches/leo-ctx5/languages/tcl/lib/parser.pir (original) +++ branches/leo-ctx5/languages/tcl/lib/parser.pir Mon Aug 8 04:32:35 2005 @@ -48,8 +48,15 @@ get_commands: next_command: # Do we have a comment? If so, skip to the next position where # We might have a command. - pos = skip_comment(tcl_code, pos) + .local int check_pos + check_pos = skip_comment(tcl_code, pos) + if check_pos == pos goto done_comment +found_comment: + pos = check_pos + goto next_command + +done_comment: .local pmc command (command, pos) = get_command(tcl_code, chars, pos) isnull command, done @@ -68,24 +75,27 @@ done: .local pmc chars chars = new Hash chars[10] = 1 # \n - .local int peek_pos -get: - .local pmc command - null command + + .local pmc word + .local int orig, len + orig = pos + len = length tcl_code +get: # try to get a command name - .local pmc word - (word, peek_pos) = get_word(tcl_code, chars, pos) - isnull word, check + if pos >= len goto check + (word, pos) = get_word(tcl_code, chars, pos) + inc pos + isnull word, get $S0 = word $I0 = ord $S0, 0 if $I0 == 35 goto got_comment check: - .return(pos) + .return(orig) got_comment: + dec pos .local int new_pos new_pos = index tcl_code, "\n", pos - inc new_pos .return (new_pos) .end Modified: branches/leo-ctx5/languages/tcl/lib/variables.pir ============================================================================== --- branches/leo-ctx5/languages/tcl/lib/variables.pir (original) +++ branches/leo-ctx5/languages/tcl/lib/variables.pir Mon Aug 8 04:32:35 2005 @@ -182,20 +182,25 @@ Gets the actual variable from memory and .sub __find_var .param string name + name = "$" . name .local pmc value null value + + push_eh done + $S0 = substr name, 1, 2 + if $S0 == "::" goto coloned .local int call_level $P1 = find_global "_Tcl", "call_level" call_level = $P1 - - push_eh done if call_level == 0 goto global_var lexical_var: value = find_lex call_level, name goto found +coloned: + substr name, 1, 2, "" global_var: value = find_global "Tcl", name # goto found @@ -218,16 +223,21 @@ Sets the actual variable from memory. .sub __store_var .param string name .param pmc value - + name = "$" . name + + $S0 = substr name, 1, 2 + if $S0 == "::" goto coloned + .local int call_level $P1 = find_global "_Tcl", "call_level" call_level = $P1 - if call_level == 0 goto global_var lexical_var: store_lex call_level, name, value .return() +coloned: + substr name, 1, 2, "" global_var: store_global "Tcl", name, value Modified: branches/leo-ctx5/languages/tcl/t/cmd_rename.t ============================================================================== --- branches/leo-ctx5/languages/tcl/t/cmd_rename.t (original) +++ branches/leo-ctx5/languages/tcl/t/cmd_rename.t Mon Aug 8 04:32:35 2005 @@ -2,7 +2,7 @@ use strict; use lib qw(tcl/t t . ../lib ../../lib ../../../lib); -use Parrot::Test tests => 2; +use Parrot::Test tests => 3; language_output_is("tcl",<<'TCL',<<OUT,"rename"); set a 2 @@ -18,3 +18,10 @@ language_output_is("tcl",<<'TCL',<<OUT," TCL invalid command name "puts" OUT + +language_output_is("tcl",<<'TCL',<<'OUT',"non-existant command") + rename foo blah +TCL +can't rename "foo": command doesn't exist +OUT + Modified: branches/leo-ctx5/languages/tcl/t/tcl_misc.t ============================================================================== --- branches/leo-ctx5/languages/tcl/t/tcl_misc.t (original) +++ branches/leo-ctx5/languages/tcl/t/tcl_misc.t Mon Aug 8 04:32:35 2005 @@ -2,7 +2,7 @@ use strict; use lib qw(tcl/t t . ../lib ../../lib ../../../lib); -use Parrot::Test tests => 16; +use Parrot::Test tests => 18; use Test::More; use vars qw($TODO); @@ -93,6 +93,15 @@ TCL 1 OUT +language_output_is("tcl",<<'TCL',<<'OUT',"comments with a blank line in between"); +#one + +#two +puts foo +TCL +foo +OUT + language_output_is("tcl",<<'TCL',<<'OUT',"comments must *start* commands (does), with whitespace"); # comment puts 1 @@ -105,6 +114,14 @@ language_output_is("tcl",<<'TCL',<<'OUT' puts 2 TCL 2 +OUT + +language_output_is("tcl",<<'TCL',<<'OUT',"two comments in a row should work"); + # comment1 + # comment2 + puts 2 +TCL +2 OUT TODO: { Modified: branches/leo-ctx5/languages/tcl/t/tcl_var_subst.t ============================================================================== --- branches/leo-ctx5/languages/tcl/t/tcl_var_subst.t (original) +++ branches/leo-ctx5/languages/tcl/t/tcl_var_subst.t Mon Aug 8 04:32:35 2005 @@ -2,7 +2,7 @@ use strict; use lib qw(tcl/t t . ../lib ../../lib ../../../lib); -use Parrot::Test tests => 8; +use Parrot::Test tests => 10; language_output_is("tcl",<<'TCL',<<OUT,"middle"); set a whee @@ -59,3 +59,18 @@ language_output_is("tcl",<<'TCL',<<'OUT' TCL 44 OUT + +language_output_is("tcl",<<'TCL',<<'OUT',"read global"); + set x foo + puts $::x +TCL +foo +OUT + +language_output_is("tcl",<<'TCL',<<'OUT',"write global"); + set ::x foo + puts $x +TCL +foo +OUT + Modified: branches/leo-ctx5/languages/tcl/tcl-test.pl ============================================================================== --- branches/leo-ctx5/languages/tcl/tcl-test.pl (original) +++ branches/leo-ctx5/languages/tcl/tcl-test.pl Mon Aug 8 04:32:35 2005 @@ -115,14 +115,14 @@ sub choose { sub extract_tests { my ($source) = @_; my %tests; - + my $regex = qr[ - test \s+ (\S+) - \s+ \{ ([^{]+) \} - \s+ \{ \n - ( (?:\s+ [^\n]+\n)+ ) + test \s+ (\S+) # test ident + \s+ \{ ([^}]+) \} # test description + \s+ (?:\S+ \s+)? \{ \n # optional test harness info (ignoring) + ( (?:\s+ [^\n]+\n)+ ) # test body \} \s+ - (?: \{ ([^\n]+) \} + (?: \{ ([^\n]+) \} # test result | " ((?:[^"\\]|\\.)+) " #" (keep my editor happy) | (\w+) ) ]sx; Modified: branches/leo-ctx5/t/pmc/timer.t ============================================================================== --- branches/leo-ctx5/t/pmc/timer.t (original) +++ branches/leo-ctx5/t/pmc/timer.t Mon Aug 8 04:32:35 2005 @@ -21,6 +21,7 @@ use Test::More; my %platforms = map {$_=>1} qw/ aix + cygwin darwin dec_osf freebsd Modified: branches/leo-ctx5/t/src/extend.t ============================================================================== --- branches/leo-ctx5/t/src/extend.t (original) +++ branches/leo-ctx5/t/src/extend.t Mon Aug 8 04:32:35 2005 @@ -388,7 +388,6 @@ Wibble OUTPUT my $temp = 'temp';; -SKIP: { skip("Hangs on cygwin", 1) if $^O eq 'cygwin'; open S, ">$temp.pasm" or die "Can't write $temp.pasm"; print S <<'EOF'; .pcc_sub _sub1: @@ -466,7 +465,6 @@ back hello in sub2 back OUTPUT -}; open S, ">$temp.pasm" or die "Can't write $temp.pasm"; print S <<'EOF';
