Author: bernhard
Date: Mon Oct 10 11:45:10 2005
New Revision: 9438
Modified:
trunk/languages/m4/src/m4.pir
trunk/languages/m4/t/regex/002_tokens.t
trunk/languages/m4/t/regex/004_pge.t
Log:
Tidy up 002_tokens.t
Try extraction captures in 004_pge.t
Modified: trunk/languages/m4/src/m4.pir
==============================================================================
--- trunk/languages/m4/src/m4.pir (original)
+++ trunk/languages/m4/src/m4.pir Mon Oct 10 11:45:10 2005
@@ -48,6 +48,8 @@ Load needed libraries
.sub "__onload" @LOAD
+ # load_bytecode "PGE.pbc" # Loaded by Getopt/Long.pbc
+ #load_bytecode "Getopt/Long.pbc" # This also loads PGE
.end
@@ -58,11 +60,10 @@ Looks at the command line arguments and
=cut
-.sub m4 @MAIN
+.sub 'm4' @MAIN
.param pmc argv
- # TODO: put this into __onload
- # load_bytecode "PGE.pbc" # Loaded by Getopt/Long.pbc
+ # TODO: put this into '__onload'
load_bytecode "Getopt/Long.pbc" # This also loads PGE
.local pmc get_options
Modified: trunk/languages/m4/t/regex/002_tokens.t
==============================================================================
--- trunk/languages/m4/t/regex/002_tokens.t (original)
+++ trunk/languages/m4/t/regex/002_tokens.t Mon Oct 10 11:45:10 2005
@@ -1,5 +1,11 @@
# $Id$
+=head1 NAME
+
+t/regex/002_tokens.t - Test the PGE rules used by Parrot m4
+
+=cut
+
use strict;
use FindBin;
use lib "$FindBin::Bin/../../lib", "$FindBin::Bin/../../../../lib";
@@ -8,45 +14,43 @@ use Parrot::Test tests => 22;
use Parrot::Test::PGE;
# Tests for PGE
+my %regex = ( word => q{^<[_a..zA..Z]><[_a..zA..Z0..9]>*},
+ string => q{^`<-[`]>*'},
+ simple => q{^<-[`#_a..zA..Z]>},
+ comment => q{^\#\N*\n},
+ );
+foreach my $target ( qw{ foo Korrekturfluid _Gebietsverkaufsleiter a1 b2_c3_ }
)
+{
+ p6rule_is( $target, $regex{word}, "q{$target} is a word" );
+}
+foreach my $target ( qw{ 1a +a1 }, " with_leading_space" )
+{
+ p6rule_isnt( $target, $regex{word}, "q{$target} is not a word" );
+}
+
+foreach my $target ( qw{ `Korrekturfluid' `' } )
+{
+ p6rule_is( $target, $regex{string}, "q{$target} is a quoted string" );
+}
+foreach my $target ( qw{ 1a +a1 `asdf asdf' } )
+{
+ p6rule_isnt( $target, $regex{string}, "q{$target} is not a quoted string" );
+}
+
+foreach my $target ( "+# asdf", "'", '123', '0' )
+{
+ p6rule_is( $target, $regex{simple}, "q{$target} is passed through" );
+}
+foreach my $target ( "# asdf\n", '_x' )
+{
+ p6rule_isnt( $target, $regex{simple}, "q{$target} is not passed through" );
+}
+
+foreach my $target ( "# asdf\n" )
+{
+ p6rule_is( $target, $regex{comment}, "q{$target} is a comment" );
+}
+foreach my $target ( " # asdf\n" )
{
- my %regex = ( word => q{^<[_a..zA..Z]><[_a..zA..Z0..9]>*},
- string => q{^`<-[`]>*'},
- simple => q{^<-[`#_a..zA..Z]>},
- comment => q{^\#\N*\n},
- );
- foreach my $target ( qw{ foo Korrekturfluid _Gebietsverkaufsleiter a1 b2_c3_
} )
- {
- p6rule_is( $target, $regex{word}, "q{$target} is a word" );
- }
- foreach my $target ( qw{ 1a +a1 }, " with_leading_space" )
- {
- p6rule_isnt( $target, $regex{word}, "q{$target} is not a word" );
- }
-
- foreach my $target ( qw{ `Korrekturfluid' `' } )
- {
- p6rule_is( $target, $regex{string}, "q{$target} is a quoted string" );
- }
- foreach my $target ( qw{ 1a +a1 `asdf asdf' } )
- {
- p6rule_isnt( $target, $regex{string}, "q{$target} is not a quoted string"
);
- }
-
- foreach my $target ( "+# asdf", "'", '123', '0' )
- {
- p6rule_is( $target, $regex{simple}, "q{$target} is passed through" );
- }
- foreach my $target ( "# asdf\n", '_x' )
- {
- p6rule_isnt( $target, $regex{simple}, "q{$target} is not passed through" );
- }
-
- foreach my $target ( "# asdf\n" )
- {
- p6rule_is( $target, $regex{comment}, "q{$target} is a comment" );
- }
- foreach my $target ( " # asdf\n" )
- {
- p6rule_isnt( $target, $regex{comment}, "q{$target} is not a comment" );
- }
+ p6rule_isnt( $target, $regex{comment}, "q{$target} is not a comment" );
}
Modified: trunk/languages/m4/t/regex/004_pge.t
==============================================================================
--- trunk/languages/m4/t/regex/004_pge.t (original)
+++ trunk/languages/m4/t/regex/004_pge.t Mon Oct 10 11:45:10 2005
@@ -6,52 +6,61 @@ use lib "$FindBin::Bin/../../lib", "$Fin
use Parrot::Test tests => 1;
-# Check the functionality of the Parrot Grammat Engine needed by Parrot m4
+# Check the functionality of the Parrot Grammar Engine needed by Parrot m4
-# Use the example in 'compilers/pge/README' wether PGE works at all
-{
- pir_output_is( << 'END_PIR', << 'OUTPUT', "check whether PGE is there" );
-.sub test @MAIN
+# Use the example in 'compilers/pge/README' to see whether PGE works at all
+pir_output_is( << 'END_PIR', << 'END_OUT', "check whether PGE is there" );
+
+.sub 'test' :main
load_bytecode "PGE.pbc"
+
.local pmc p6rule
- p6rule = find_global "PGE", "p6rule" # get the compiler
+ p6rule = find_global "PGE", "p6rule" # get the compiler
.local string pattern
- pattern = "^<[_a..zA..Z]><[_a..zA..Z0..9]>*" # pattern to compile
+ pattern = "^(<[_a..zA..Z]><[_a..zA..Z0..9]>*)" # capture the complete id
- .local pmc state
- state = new Hash
- .local pmc rulesub
- rulesub = p6rule(pattern) # compile it to rulesub
- state['word_rulesub'] = rulesub
+ .local pmc word_rulesub
+ word_rulesub = p6rule(pattern) # compile the pattern to a
rulesub
.local string target
- target = "Hello World" # target string
+ target = "Hello World" # target string
.local pmc match
+ .local pmc captures
+ captures = new .Undef
+
.local pmc word_rulesub
- word_rulesub = state['word_rulesub']
- match = word_rulesub(target) # execute rule on target string
+ match = word_rulesub(target) # execute rule on target
string
-match_loop:
- if_null match, match_fail # if match fails stop
- unless match goto match_fail # if match fails stop
+ if_null match, match_fail # if match fails stop
+ unless match goto match_fail # if match fails stop
+
+match_success:
print "match succeeded\n"
- match."dump"() # display captures ($0, $1, etc.)
+ match."dump"() # display captures ($0,
$1, etc.)
+
+ .local pmc captures
+ ( captures ) = match."get_array"()
+
+ .local pmc captures_0_0
+ captures_0_0 = captures[0;0] # TODO will the blow up
when the match failed?
+ print "The first capture is: "
+ print captures_0_0
+ print "\n"
- match."next"() # find the next match
- goto match_loop
+ goto end_main
match_fail:
print "match failed\n"
+ goto e_mainnd
+
+end_main:
.end
+
END_PIR
match succeeded
: <Hello @ 0> 0
-match succeeded
-: <Hello @ 0> 0
-match succeeded
-: <Hello @ 0> 0
-match failed
-OUTPUT
-}
+[0]: <Hello @ 0> 0
+The first capture is: Hello
+END_OUT
