[svn:parrot] r41608 - in branches/pct-rx: compilers/pct/src/Regex t/compilers/pct/regex

[pmichaud at svn.parrot.org]

Author: pmichaud
Date: Fri Oct  2 04:18:49 2009
New Revision: 41608
URL: https://trac.parrot.org/parrot/changeset/41608

Log:
[pct-rx]:  Initial protoregex tests and implementation.

Added:
   branches/pct-rx/t/compilers/pct/regex/04-protoregex.t
Modified:
   branches/pct-rx/compilers/pct/src/Regex/Cursor.pir

Modified: branches/pct-rx/compilers/pct/src/Regex/Cursor.pir
==============================================================================
--- branches/pct-rx/compilers/pct/src/Regex/Cursor.pir	Fri Oct  2 00:01:45 2009	(r41607)
+++ branches/pct-rx/compilers/pct/src/Regex/Cursor.pir	Fri Oct  2 04:18:49 2009	(r41608)
@@ -20,6 +20,8 @@
     .local pmc p6meta
     p6meta = new 'P6metaclass'
     $P0 = p6meta.'new_class'('Regex::Cursor', 'attr'=>'$!target $!from $!pos $!match @!bstack @!mstack')
+    $P0 = box 0
+    set_global '$!generation', $P0
     .return ()
 .end
 
@@ -107,7 +109,6 @@
 .end
 
 
-
 =item !mark_push(rep, pos, mark)
 
 Push a new backtracking point onto the cursor with the given
@@ -303,6 +304,21 @@
 .end
 
 
+=item !protoregex_generation()
+
+Set the C<$!generation> flag to indicate that protoregexes need to
+be recalculated.
+
+=cut
+
+.sub '!protoregex_generation' :method
+    $P0 = get_global '$!generation'
+    # don't change this to 'inc' -- we want to ensure new PMC
+    $P1 = add $P0, 1
+    set_global '$!generation', $P1
+    .return ($P1)
+.end
+
 =item !protoregex_gen_table(parrotclass)
 
 Generate a new protoregex table for C<parrotclass>.  This involves
@@ -458,7 +474,7 @@
     $P0 = self.'HOW'()
     $P0.'add_method'(self, name, symtoken)
 
-    # self.'!regenerate'()
+    self.'!protoregex_generation'()
 .end
 
 .sub '' :method :subid('symtoken')

Added: branches/pct-rx/t/compilers/pct/regex/04-protoregex.t
==============================================================================
--- /dev/null	00:00:00 1970	(empty, because file is newly added)
+++ branches/pct-rx/t/compilers/pct/regex/04-protoregex.t	Fri Oct  2 04:18:49 2009	(r41608)
@@ -0,0 +1,82 @@
+#! parrot
+# Copyright (C) 2009, Patrick R. Michaud
+# $Id$
+
+=head1 NAME
+
+t/compilers/pct/regex/04-protoregex.t -- basic protoregex tests
+
+=head1 SYNOPSIS
+
+    % prove t/compilers/pct/regex/04-protoregex.t
+
+=cut
+
+.sub 'main' :main
+    load_bytecode 'Test/More.pbc'
+
+    .local pmc exports, curr_namespace, test_namespace
+    curr_namespace = get_namespace
+    test_namespace = get_namespace ['Test';'More']
+    exports        = split ' ', 'plan diag ok nok is todo'
+    test_namespace.'export_to'(curr_namespace, exports)
+
+    load_bytecode 'PCT/Regex.pbc'
+
+    # create a grammar for us to test
+    .local pmc p6meta, xyz
+    p6meta = get_hll_global 'P6metaclass'
+    xyz = p6meta.'new_class'('XYZ', 'parent'=>'Regex::Cursor')
+
+    # add some symtokens
+    xyz.'!symtoken_add'('term:sym<abc>', 'abc')
+    xyz.'!symtoken_add'('infix:sym<+>', '+')
+    xyz.'!symtoken_add'('infix:sym<->', '-')
+    xyz.'!symtoken_add'('infix:sym<++>', '++')
+    xyz.'!symtoken_add'('infix:sym<+->', '+-')
+    xyz.'!symtoken_add'('term:sym<ab>', 'ab')
+    xyz.'!symtoken_add'('term:sym<foo>', 'foo')
+
+    # create a cursor for matching
+    .local pmc cur
+    cur = xyz.'!cursor_init'('abc++-')
+
+    $I0 = p6meta.'isa'(cur, xyz)
+    ok($I0, 'match cursor isa XYZ')
+
+    .local pmc abc, match
+    abc = cur.'term'()
+    ok(abc, 'Matched initial abc')
+    match = abc.'MATCH'()
+    ok(match, '?$/')
+    $I0 = match.'from'()
+    is($I0, 0, "$/.from")
+    $I0 = match.'to'()
+    is($I0, 3, "$/.to")
+    $S0 = match['sym']
+    is($S0, 'abc', "$<sym>")
+
+    .local pmc op
+    op = abc.'infix'()
+    ok(op, 'Matched operator after abc')
+    match = op.'MATCH'()
+    ok(match, '?$/')
+    $I0 = match.'from'()
+    is($I0, 3, "$/.from")
+    $I0 = match.'to'()
+    is($I0, 5, "$/.to")
+    $S0 = match['sym']
+    is($S0, '++', "$<sym>")
+.end
+
+
+.namespace ['XYZ']
+
+.sub 'term' :method
+    .tailcall self.'!protoregex'('term')
+.end
+
+.sub 'infix' :method
+    .tailcall self.'!protoregex'('infix')
+.end
+