Author: leo
Date: Thu Aug 11 04:08:19 2005
New Revision: 8912
Modified:
branches/leo-ctx5/config/gen/makefiles/bc.in
branches/leo-ctx5/config/gen/makefiles/languages.in
branches/leo-ctx5/languages/m4/t/freezing/001_freeze.t
branches/leo-ctx5/languages/tcl/lib/commands/namespace.pir
branches/leo-ctx5/languages/tcl/lib/commands/string.pir
branches/leo-ctx5/languages/tcl/t/cmd_namespace.t
branches/leo-ctx5/languages/tcl/t/cmd_string.t
branches/leo-ctx5/runtime/parrot/library/PGE/Glob.pir
Log:
merge -r8900:8911 from trunk
Modified: branches/leo-ctx5/config/gen/makefiles/bc.in
==============================================================================
--- branches/leo-ctx5/config/gen/makefiles/bc.in (original)
+++ branches/leo-ctx5/config/gen/makefiles/bc.in Thu Aug 11 04:08:19 2005
@@ -5,6 +5,12 @@
PERL = ${perl}
RM_RF = ${rm_rf}
+# The runtime files are also in SVN, need to be generated only by maintainer
+PYTHON_RUNTIME_FILES = \
+ python/lib/bc/BcLexer.py \
+ python/lib/bc/BcParser.py \
+ python/lib/bc/BcTreeWalker.py
+
# the default target
all: build
@@ -15,6 +21,10 @@ help:
@echo ""
@echo " all: BcLexer.py and BcParser.py"
@echo " This is the default."
+ @echo ""
+ @echo " maintain: Generate Python runtime files"
+ @echo " Needs ANTLR and Python"
+ @echo ""
@echo "Testing:"
@echo " test: Run the test suite."
@echo ""
@@ -29,10 +39,13 @@ help:
test: build
cd .. && $(PERL) -I../lib -I bc/lib bc/t/harness --use-gnu-bc
-build: python/lib/bc/BcParser.py
+build:
+# Nothing to do
+
+maintain: $(PYTHON_RUNTIME_FILES)
# BcLexer.py will be created too
-python/lib/bc/BcParser.py: grammar/bc_python.g
+$(PYTHON_RUNTIME_FILES): grammar/bc_python.g
antlr -o python/lib/bc grammar/bc_python.g
clean:
Modified: branches/leo-ctx5/config/gen/makefiles/languages.in
==============================================================================
--- branches/leo-ctx5/config/gen/makefiles/languages.in (original)
+++ branches/leo-ctx5/config/gen/makefiles/languages.in Thu Aug 11 04:08:19 2005
@@ -92,11 +92,11 @@ BASIC.clean:
bc : bc.dummy
bc.dummy:
- $(MAKE_C) bc
+ - $(MAKE_C) bc
bc.test:
- $(MAKE_C) bc test
+ - $(MAKE_C) bc test
bc.clean:
- $(MAKE_C) bc clean
+ - $(MAKE_C) bc clean
befunge : befunge.dummy
befunge.dummy:
Modified: branches/leo-ctx5/languages/m4/t/freezing/001_freeze.t
==============================================================================
--- branches/leo-ctx5/languages/m4/t/freezing/001_freeze.t (original)
+++ branches/leo-ctx5/languages/m4/t/freezing/001_freeze.t Thu Aug 11
04:08:19 2005
@@ -4,14 +4,14 @@ use strict;
use FindBin;
use lib "$FindBin::Bin/../../lib", "$FindBin::Bin/../../../../lib";
+use Parrot::Config;
use Test::More tests => 1;
-my $real_out;
-my $parrot_m4 = 'cd .. && ./parrot languages/m4/m4.pbc';
+my $parrot_m4 = "cd .. && .$PConfig{slash_exec}parrot$PConfig{exe}
languages/m4/m4.pbc";
#--------------------------------------------
-$real_out = `$parrot_m4
--reload-state=languages/m4/examples/only_builtin.frozen
--freeze-state=languages/m4/examples/hello.frozen
languages/m4/examples/hello.m4; cat languages/m4/examples/hello.frozen; rm
languages/m4/examples/hello.frozen`;
+my $real_out = `$parrot_m4
--reload-state=languages/m4/examples/only_builtin.frozen
--freeze-state=languages/m4/examples/hello.frozen
languages/m4/examples/hello.m4; cat languages/m4/examples/hello.frozen; rm
languages/m4/examples/hello.frozen`;
is( $real_out, << 'END_OUT', '1 file' );
Hello
T8,8
Modified: branches/leo-ctx5/languages/tcl/lib/commands/namespace.pir
==============================================================================
--- branches/leo-ctx5/languages/tcl/lib/commands/namespace.pir (original)
+++ branches/leo-ctx5/languages/tcl/lib/commands/namespace.pir Thu Aug 11
04:08:19 2005
@@ -89,8 +89,44 @@ not_done:
.sub "exists" # XXX
.param pmc argv
+
+ .local int argc
+ argc = argv
+ if argc != 1 goto bad_args
# canonicalize namespace.
$P1 = new TclInt
$P1 = 0
.return(TCL_OK,$P1)
+
+bad_args:
+ $P1 = new TclString
+ $P1 = "wrong # args: should be \"namespace exists name\""
+ .return(TCL_ERROR, $P1)
+.end
+
+.sub "qualifiers"
+ .param pmc argv
+
+ .local int argc
+ if argc != 1 goto bad_args
+
+ bad_args:
+ $P1 = new String
+ $P1 = "wrong # args: should be \"namespace qualifiers string\""
+ .return (TCL_ERROR,$P1)
+
.end
+
+.sub "tail"
+ .param pmc argv
+
+ .local int argc
+ if argc != 1 goto bad_args
+
+ bad_args:
+ $P1 = new String
+ $P1 = "wrong # args: should be \"namespace tail string\""
+ .return (TCL_ERROR,$P1)
+
+.end
+
Modified: branches/leo-ctx5/languages/tcl/lib/commands/string.pir
==============================================================================
--- branches/leo-ctx5/languages/tcl/lib/commands/string.pir (original)
+++ branches/leo-ctx5/languages/tcl/lib/commands/string.pir Thu Aug 11
04:08:19 2005
@@ -120,7 +120,6 @@ done:
.return (return_type, retval)
.end
-.include "stringinfo.pasm"
.sub "bytelength"
.param pmc argv
@@ -129,7 +128,7 @@ done:
argc = argv
if argc != 1 goto bad_length
$S0 = argv[0]
- $I0 = stringinfo $S0, .STRINGINFO_BUFUSED
+ $I0 = bytelength $S0
retval = new Integer
retval = $I0
.return(TCL_OK, retval)
Modified: branches/leo-ctx5/languages/tcl/t/cmd_namespace.t
==============================================================================
--- branches/leo-ctx5/languages/tcl/t/cmd_namespace.t (original)
+++ branches/leo-ctx5/languages/tcl/t/cmd_namespace.t Thu Aug 11 04:08:19 2005
@@ -18,9 +18,6 @@ TCL
bad option "asdf": must be children, code, current, delete, eval, exists,
export, forget, import, inscope, origin, parent, qualifiers, tail, or which
OUT
-TODO: {
- local $TODO = "unimplemented";
-
language_output_is("tcl",<<'TCL',<<OUT,"namespace qualifiers: no args");
namespace qualifiers
TCL
@@ -33,6 +30,8 @@ TCL
wrong # args: should be "namespace qualifiers string"
OUT
+TODO: {
+ local $TODO = "unimplemented";
language_output_is("tcl",<<'TCL',<<OUT,"namespace qualifiers: simple");
puts [namespace qualifiers ::a::b::c]
TCL
@@ -44,6 +43,7 @@ language_output_is("tcl",<<'TCL',<<OUT,"
TCL
::a::b
OUT
+}
language_output_is("tcl",<<'TCL',<<OUT,"namespace tail: no args");
namespace tail
@@ -57,6 +57,8 @@ TCL
wrong # args: should be "namespace tail string"
OUT
+TODO: {
+ local $TODO = "unimplemented";
language_output_is("tcl",<<'TCL',<<OUT,"namespace tail: simple");
puts [namespace tail ::a::b::c]
TCL
@@ -77,15 +79,13 @@ wrong # args: should be "namespace curre
OUT
# TODO : more tests once we can *change* the namespace
+
language_output_is("tcl",<<'TCL',<<OUT,"namespace current: too many args");
puts [namespace current]
TCL
::
OUT
-TODO: {
- local $TODO = "unimplemented";
-
language_output_is("tcl",<<'TCL',<<OUT,"namespace exists: no args");
namespace exists
TCL
@@ -97,7 +97,6 @@ language_output_is("tcl",<<'TCL',<<OUT,"
TCL
wrong # args: should be "namespace exists name"
OUT
-}
language_output_is("tcl",<<'TCL',<<OUT,"namespace exists: failure");
puts [namespace exists a]
@@ -106,8 +105,7 @@ TCL
OUT
TODO: {
- local $TODO = "unimplemented";
-
+ local $TODO = "unimplemented";
language_output_is("tcl",<<'TCL',<<OUT,"namespace exists: global implicit");
puts [namespace exists {}]
TCL
@@ -119,5 +117,4 @@ language_output_is("tcl",<<'TCL',<<OUT,"
TCL
1
OUT
-
}
Modified: branches/leo-ctx5/languages/tcl/t/cmd_string.t
==============================================================================
--- branches/leo-ctx5/languages/tcl/t/cmd_string.t (original)
+++ branches/leo-ctx5/languages/tcl/t/cmd_string.t Thu Aug 11 04:08:19 2005
@@ -2,7 +2,7 @@
use strict;
use lib qw(tcl/t t . ../lib ../../lib ../../../lib);
-use Parrot::Test tests => 44;
+use Parrot::Test tests => 46;
use vars qw($TODO);
language_output_is("tcl",<<TCL,<<OUT,"first, initial");
@@ -220,21 +220,29 @@ TCL
1
OUT
-TODO: {
-local $TODO = "PGE Globbing doesn't do backslash escaping [#36820]";
-
-language_output_is("tcl",<<TCL,<<OUT,"string match \[");
+language_output_is("tcl",<<'TCL',<<OUT,"string match \[");
puts [string match {\[} {[}]
TCL
1
OUT
-language_output_is("tcl",<<TCL,<<OUT,"string match \]");
+language_output_is("tcl",<<'TCL',<<OUT,"string match \]");
puts [string match {\]} {]}]
TCL
1
OUT
-}
+
+language_output_is("tcl",<<'TCL',<<OUT,"string match \*");
+ puts [string match {\*} {*}]
+TCL
+1
+OUT
+
+language_output_is("tcl",<<'TCL',<<OUT,"string match \?");
+ puts [string match {\?} {?}]
+TCL
+1
+OUT
language_output_is("tcl",<<TCL,<<OUT,"string repeat: simple");
puts [string repeat a 5]
Modified: branches/leo-ctx5/runtime/parrot/library/PGE/Glob.pir
==============================================================================
--- branches/leo-ctx5/runtime/parrot/library/PGE/Glob.pir (original)
+++ branches/leo-ctx5/runtime/parrot/library/PGE/Glob.pir Thu Aug 11
04:08:19 2005
@@ -112,11 +112,18 @@ Parse alternations of the form {a,b,c} w
next_char:
unless $I0 < $I1 goto lit_end
c = substr pattern, $I0, 1
+ if c == "\\" goto backslash
$I2 = index STOPCHARS, c
if $I2 >= 0 goto lit_end
inc $I0
concat lit,c
goto next_char
+ backslash:
+ inc $I0
+ c = substr pattern, $I0, 1
+ inc $I0
+ concat lit, c
+ goto next_char
lit_end:
lex['pos'] = $I0
$P0 = find_global "PGE::Exp", "new"
