[svn:parrot] r38379 - in trunk: compilers/pge/PGE t/compilers/pge/perl6regex

[pmichaud at svn.parrot.org]

Author: pmichaud
Date: Mon Apr 27 18:57:29 2009
New Revision: 38379
URL: https://trac.parrot.org/parrot/changeset/38379

Log:
[pge]:  underscore is considered a match for <alpha> (RT #65138).

Modified:
   trunk/compilers/pge/PGE/Regex.pir
   trunk/t/compilers/pge/perl6regex/rx_subrules

Modified: trunk/compilers/pge/PGE/Regex.pir
==============================================================================
--- trunk/compilers/pge/PGE/Regex.pir	Mon Apr 27 17:22:09 2009	(r38378)
+++ trunk/compilers/pge/PGE/Regex.pir	Mon Apr 27 18:57:29 2009	(r38379)
@@ -86,6 +86,34 @@
 .end
 
 
+=item C<alpha()>
+
+Match a single alphabetic character.
+
+=cut
+
+.sub 'alpha' :method
+    .param pmc adverbs         :slurpy :named
+    .local string target
+    .local pmc mob, mfrom, mpos
+    .local int pos, lastpos
+
+    $P0 = get_hll_global ['PGE'], 'Match'
+    (mob, pos, target) = $P0.'new'(self)
+
+    lastpos = length target
+    $S0 = substr target, pos, 1
+    if $S0 == '_' goto ident_1
+    $I0 = is_cclass .CCLASS_ALPHABETIC, target, pos
+    if $I0 == 0 goto end
+  ident_1:
+    inc pos
+    mob.'to'(pos)
+  end:
+    .return (mob)
+.end
+
+
 =item C<upper()>
 
 Match a single uppercase character.
@@ -108,16 +136,6 @@
 .end
 
 
-=item C<alpha()>
-
-Match a single alphabetic character.
-
-=cut
-
-.sub "alpha" :method
-    .tailcall '!cclass'(self, .CCLASS_ALPHABETIC)
-.end
-
 =item C<digit()>
 
 Match a single digit.

Modified: trunk/t/compilers/pge/perl6regex/rx_subrules
==============================================================================
--- trunk/t/compilers/pge/perl6regex/rx_subrules	Mon Apr 27 17:22:09 2009	(r38378)
+++ trunk/t/compilers/pge/perl6regex/rx_subrules	Mon Apr 27 18:57:29 2009	(r38379)
@@ -26,9 +26,9 @@
 <lower>		\t\n\r !"#$%&'()*+,-./:;<=>?@[\]^`_{|}0123456789ABCDEFGHIJabcdefghij	/mob<lower>: <a @ 55>/		<lower>
 <+lower>	\t\n\r !"#$%&'()*+,-./:;<=>?@[\]^`_{|}0123456789ABCDEFGHIJabcdefghij	/mob: <a @ 55>/			<+lower>
 <+lower>+	\t\n\r !"#$%&'()*+,-./:;<=>?@[\]^`_{|}0123456789ABCDEFGHIJabcdefghij	/mob: <abcdefghij @ 55>/	<+lower>+
-<alpha>		\t\n\r !"#$%&'()*+,-./:;<=>?@[\]^`_{|}0123456789ABCDEFGHIJabcdefghij	/mob<alpha>: <A @ 45>/		<alpha>
-<+alpha>	\t\n\r !"#$%&'()*+,-./:;<=>?@[\]^`_{|}0123456789ABCDEFGHIJabcdefghij	/mob: <A @ 45>/			<+alpha>
-<+alpha>+	\t\n\r !"#$%&'()*+,-./:;<=>?@[\]^`_{|}0123456789ABCDEFGHIJabcdefghij	/mob: <ABCDEFGHIJabcdefghij @ 45>/	<+alpha>+
+<alpha>		\t\n\r !"#$%&'()*+,-./:;<=>?@[\]^`_{|}0123456789ABCDEFGHIJabcdefghij	/mob<alpha>: <_ @ 31>/		<alpha>
+<+alpha>	\t\n\r !"#$%&'()*+,-./:;<=>?@[\]^`_{|}0123456789ABCDEFGHIJabcdefghij	/mob: <_ @ 31>/			<+alpha>
+<+alpha>+	\t\n\r !"#$%&'()*+,-./:;<=>?@[\]^`_{|}0123456789ABCDEFGHIJabcdefghij	/mob: <_ @ 31>/	<+alpha>+
 <digit>		\t\n\r !"#$%&'()*+,-./:;<=>?@[\]^`_{|}0123456789ABCDEFGHIJabcdefghij	/mob<digit>: <0 @ 35>/		<digit>
 <+digit>	\t\n\r !"#$%&'()*+,-./:;<=>?@[\]^`_{|}0123456789ABCDEFGHIJabcdefghij	/mob: <0 @ 35>/			<+digit>
 <+digit>+	\t\n\r !"#$%&'()*+,-./:;<=>?@[\]^`_{|}0123456789ABCDEFGHIJabcdefghij	/mob: <0123456789 @ 35>/	<+digit>+