Author: pmichaud
Date: Sat Apr 14 09:52:28 2007
New Revision: 18199
Modified:
trunk/compilers/pge/PGE/P6Regex.pir
trunk/compilers/pge/PGE/Perl6Regex.pir
trunk/t/compilers/pge/perl6regex/01-regex.t
trunk/t/compilers/pge/perl6regex/rx_syntax
Log:
[pge]: Resolve RT#40053
* P6Regex and Perl6Regex throw exception when given a null pattern as input
* Added test
Modified: trunk/compilers/pge/PGE/P6Regex.pir
==============================================================================
--- trunk/compilers/pge/PGE/P6Regex.pir (original)
+++ trunk/compilers/pge/PGE/P6Regex.pir Sat Apr 14 09:52:28 2007
@@ -93,6 +93,7 @@
## Let's parse the source as a regex
$P0 = get_hll_global ['PGE::Grammar'], 'regex'
match = $P0(source, adverbs :flat :named)
+ if source == '' goto err_null
if target != 'parse' goto check
.return (match)
@@ -112,8 +113,12 @@
$P0 = new .Hash
pad['lexscope'] = $P0
exp = exp.'p6exp'(pad)
-
+ if null exp goto err_null
.return exp.'compile'(adverbs :flat :named)
+
+ err_null:
+ $I0 = match.'from'()
+ 'parse_error'(match, $I0, 'Null pattern illegal')
.end
Modified: trunk/compilers/pge/PGE/Perl6Regex.pir
==============================================================================
--- trunk/compilers/pge/PGE/Perl6Regex.pir (original)
+++ trunk/compilers/pge/PGE/Perl6Regex.pir Sat Apr 14 09:52:28 2007
@@ -93,6 +93,7 @@
## Let's parse the source as a regex
$P0 = get_global 'regex'
match = $P0(source, adverbs :flat :named)
+ if source == '' goto err_null
if target != 'parse' goto check
.return (match)
@@ -112,8 +113,12 @@
$P0 = new .Hash
pad['lexscope'] = $P0
exp = exp.'perl6exp'(pad)
-
+ if null exp goto err_null
.return exp.'compile'(adverbs :flat :named)
+
+ err_null:
+ $I0 = match.'from'()
+ 'parse_error'(match, $I0, 'Null pattern illegal')
.end
Modified: trunk/t/compilers/pge/perl6regex/01-regex.t
==============================================================================
--- trunk/t/compilers/pge/perl6regex/01-regex.t (original)
+++ trunk/t/compilers/pge/perl6regex/01-regex.t Sat Apr 14 09:52:28 2007
@@ -320,7 +320,6 @@
if tab_number >= $I0 goto bad_line
pattern = $P1[tab_number]
inc tab_number
- if pattern == '' goto get_pattern
get_target:
if tab_number >= $I0 goto bad_line
target = $P1[tab_number]
Modified: trunk/t/compilers/pge/perl6regex/rx_syntax
==============================================================================
--- trunk/t/compilers/pge/perl6regex/rx_syntax (original)
+++ trunk/t/compilers/pge/perl6regex/rx_syntax Sat Apr 14 09:52:28 2007
@@ -26,3 +26,5 @@
[a|?] abcdef /Quantifier follows nothing/ bare ? after |
[a| ?] abcdef /Quantifier follows nothing/ bare ? after
|+sp
+ abcdef /Null pattern illegal/ null pattern
+ abcdef /Null pattern illegal/ ws null pattern
