Permalink
Browse files

[PGE]: #40106: [PATCH] 15 more tests work for PGE::P5Regex

Courtesy of Kay-Uwe Huell <kiwi@franka.dyndns.org>
~ modified to work with HEAD and cleaned up code


git-svn-id: https://svn.parrot.org/parrot/trunk@14827 d31e2699-5ff4-0310-a27c-f18f2fbe73fe
  • Loading branch information...
1 parent 01c1b0a commit 1af8ba3143f1253174cb2fef3f7456742e29e617 @particle particle committed Oct 2, 2006
Showing with 37 additions and 11 deletions.
  1. +31 −6 compilers/pge/PGE/P5Regex.pir
  2. +6 −5 t/compilers/pge/p5regex/p5rx.t
@@ -111,13 +111,22 @@
optable.newtok('infix:|', 'looser'=>'infix:', 'left'=>1, 'nows'=>1, 'match'=>'PGE::Exp::Alt')
optable.newtok('close:}', 'looser'=>'infix:|', 'nows'=>1) # XXX: hack
- optable.newtok('close:]', 'equiv'=>'close:}', 'nows'=>1) # XXX: hack
$P0 = get_hll_global ["PGE::P5Regex"], "compile_p5regex"
compreg "PGE::P5Regex", $P0
.end
+.sub 'parse_error'
+ .param pmc mob
+ .param int pos
+ .param string message
+ print message
+ exit 1
+ .return ()
+.end
+
+
.sub "parse_lit"
.param pmc mob
.local pmc newfrom
@@ -130,24 +139,30 @@
pos = $P0
lastpos = length target
initchar = substr target, pos, 1
+ unless initchar == '*' goto initchar_ok
+ parse_error(mob, pos, "Quantifier follows nothing")
+
+ initchar_ok:
if initchar == ')' goto end
inc pos
if initchar != "\\" goto term_literal
-
term_backslash:
initchar = substr target, pos, 1
inc pos
+ if pos <= lastpos goto term_backslash_ok
+ parse_error(mob, pos, "Search pattern not terminated")
+ term_backslash_ok:
$I0 = index "nrteab", initchar
if $I0 < 0 goto term_literal
initchar = substr "\n\r\t\e\a\b", $I0, 1
-
term_literal:
litstart = pos
litlen = 0
term_literal_loop:
if pos >= lastpos goto term_literal_end
$S0 = substr target, pos, 1
$I0 = index "[](){}*?+\\|^$.", $S0
+ # if not in circumfix:( ) throw error on end paren
if $I0 >= 0 goto term_literal_end
inc pos
inc litlen
@@ -293,6 +308,7 @@
isrange = 0
$I2 = ord charlist, -1
$I0 = ord $S0
+ if $I0 < $I2 goto err_range
addrange_1:
inc $I2
if $I2 > $I0 goto scan
@@ -314,11 +330,20 @@
mpos = pos
mob.'result_object'(charlist)
.return (mob)
-
+
err_close:
- parse_error(mob, pos, "No closing ']' for enumerated character list")
+ parse_error(mob, pos, "Unmatched [")
+ err_range:
+ $S0 = 'Invalid [] range "'
+ $S1 = chr $I2
+ $S0 .= $S1
+ $S0 .= '-'
+ $S1 = chr $I0
+ $S0 .= $S1
+ $S0 .= '"'
+ parse_error(mob, pos, $S0)
.end
-
+
.namespace [ "PGE::Exp" ]
@@ -118,10 +118,11 @@ my @skip_tests = (
755 756 757 758 759 760 761 771 772 773 774 775 776 777 778 779 789
790 791 792 793 794 795 796 797 802 803 805 834 835 836 838 859 862
877 886>,
- q{bug or error} => qw<78 79 80 135 136 138 143 144 148 149 155 167
+ q{bug or error} => qw<143 144 148 149 155 167
248 249 252 308 309 310 322 323 325 330 331 336 347 408 436 487 488
- 489 490 492 531 532 563 564 566 593 594 598 599 944 945>,
- q{kills a parrot} => qw<81 129 130 131 139 140 141 491 493 556 557
+ 489 490 492 531 532 563 564 566 593 594 598 599 944 945>,
+ q{broken col 4?} => qw<139>,
+ q{kills a parrot} => qw<491 493 556 557
568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584
585 586 587 588 589 590 591 592 800 828 829 830 957 958>,
q{hangs a parrot} => qw<806 807 808 809 810 811 812 813 814 815 816
@@ -214,12 +215,12 @@ sub p5rx_template
.local string pattern
.local pmc rulesub
.local pmc match
- target = <<"TARGET"
+ target = <<'TARGET'
<<SUBJECT>>
TARGET
chopn target, 1
- pattern = <<"PATTERN"
+ pattern = <<'PATTERN'
<<PATTERN>>
PATTERN
chopn pattern, 1

0 comments on commit 1af8ba3

Please sign in to comment.