Changeset 21619 for perl5

Timestamp:

07/30/08 00:04:19 (4 months ago)

Author:

fglock

Message:

[PCR] 0.36

Location:

perl5/Pugs-Compiler-Rule

Files:

• Changes (modified) (1 diff)
• lib/Pugs/Compiler/RegexPerl5.pm (modified) (4 diffs)
• lib/Pugs/Compiler/Rule.pm (modified) (1 diff)

perl5/Pugs-Compiler-Rule/Changes

@@ +1 @@
+0.36  2008-07-28
+- fixed quoting in perl 5 regex emitter
+
 0.35  2008-07-27
 - fixed var name mangler

perl5/Pugs-Compiler-Rule/lib/Pugs/Compiler/RegexPerl5.pm

@@ -14 +14 @@
 # http://www.foo.be/docs/tpj/issues/vol2_3/tpj0203-0002.html
 # is a good reference on the use of pos()
+
+sub _quote_rule {
+    my $rule_source = shift;
+    return 'm/' . $rule_source . '/' unless $rule_source =~ m{/};
+    return 'm{' . $rule_source . '}' unless $rule_source =~ m/{/ || $rule_source =~ m/}/;
+    return 'm!' . $rule_source . '!' unless $rule_source =~ m/!/;
+    return 'm[' . $rule_source . ']' unless $rule_source =~ m/\[/ || $rule_source =~ m/\]/;
+    return 'm^' . $rule_source . '^' unless $rule_source =~ m/^/;
+}
 
 sub compile {
@@ -44 +53 @@
       ';
     $self->{perl5} = 
-q(do {
+q!do {
   my $rule; 
   $rule = sub { # grammar, string, state, args
@@ -60 +69 @@
     pos(${$_[1]}) = $_[3]{p}
       if defined $_[3]{p};
-    $bool = \( ${$_[1]} =~ /) . $rule_source . q(/g \) ? 1 : 0; ) . 
-    $captures . q(
+    $bool = ( ${$_[1]} =~ !
+        . _quote_rule( $rule_source ) 
+        . q(g \) ? 1 : 0; ) 
+        . $captures 
+        . q!
   }
   
   if ( defined $_[3]{p} ) {
       pos(${$_[1]}) = $_[3]{p};
-      $bool = \( ${$_[1]} =~ /\G\(?:) . $rule_source . q(\)/ \) ? 1 : 0; ) . 
-      $captures . q(
+      $bool = ( ${$_[1]} =~ ! 
+        . _quote_rule( 
+                q(\\G\(?:) . $rule_source . ')' 
+          ) 
+        . ' ) ? 1 : 0; ' 
+        . $captures 
+        . q!
   }
   else {
-      $bool = \( ${$_[1]} =~ /) . $rule_source . q(/ \) ? 1 : 0; ) . 
-      $captures . q(
+      $bool = ( ${$_[1]} =~ !
+      . _quote_rule( $rule_source ) 
+      . q( \) ? 1 : 0; ) 
+      . $captures . q(
   }
 };
@@ -78 +97 @@
     # print 'rule perl5: ', do{use Data::Dumper; Dumper($self->{perl5})};
 
-    local $@;
-    $self->{code} = eval 
-        $self->{perl5};
-    die "Error in evaluation: $@\nSource:\n$self->{perl5}\n" if $@;
-
+    unless ( $param->{compile_only} ) {
+        local $@;
+        $self->{code} = eval 
+            $self->{perl5};
+        die "Error in evaluation: $@\nSource:\n$self->{perl5}\n" if $@;
+    }
+    
     bless $self, 'Pugs::Compiler::Regex';
 }

perl5/Pugs-Compiler-Rule/lib/Pugs/Compiler/Rule.pm

@@ -5 +5 @@
 package Pugs::Compiler::Rule;
 
-our $VERSION = '0.35';
+our $VERSION = '0.36';
 
 use base 'Pugs::Compiler::Regex';