Changeset 21569 for perl5/Pugs-Compiler-Perl6/lib/Pugs/Emitter/Perl6/Perl5.pm

Timestamp:

07/27/08 16:19:34 (6 months ago)

Author:

fglock

Message:

[v6.pm] smartmatch fixes

Files:

• perl5/Pugs-Compiler-Perl6/lib/Pugs/Emitter/Perl6/Perl5.pm (modified) (5 diffs)

perl5/Pugs-Compiler-Perl6/lib/Pugs/Emitter/Perl6/Perl5.pm

@@ -27 +27 @@
         $s = $n->{$_} if exists $n->{$_};
     }
-
+    
     #print "get: $s\n";
-
+    
     if  (  defined $s
         && $s =~ /\$\? .* POSITION $/x
@@ -174 +174 @@
     return "q!$n!" unless $n =~ /[!]/;
     return "q^$n^" unless $n =~ /[\^]/;
+    die "can't quote string [$n]";
+}
+
+sub _emit_qr {
+    my $n = $_[0];
+    return "qr($n)" unless $n =~ /[()]/;
+    return "qr{$n}" unless $n =~ /[{}]/;
+    return "qr[$n]" unless $n =~ /[\[\]]/;
+    return "qr!$n!" unless $n =~ /[!]/;
+    return "qr^$n^" unless $n =~ /[\^]/;
     die "can't quote string [$n]";
 }
@@ -1021 +1031 @@
 
     if ( exists $n->{rx} ) {
-        return 'qr{'.$n->{rx}{rx}.'}' if $n->{rx}{options}{perl5};
+        return _emit_qr( $n->{rx}{rx} ) if $n->{rx}{options}{perl5};
+        return _emit_qr( $n->{rx}{rx} )  # TODO: perl6rx\n";
     }
 
@@ -1068 +1079 @@
                     exp1 => { scalar => '$_' },
                     exp2 => $n->{exp1},
-                    op1   => { op => '~~' },
+                    op1   => '~~',
                     fixity => 'infix',
                 }
@@ -1459 +1470 @@
         }
         if ( my $rx = $n->{exp2}{rx} ) {
-            if ( !$rx->{options}{perl5} ) {
+            if ( !$rx->{options}{perl5} && !$rx->{options}{p5} ) {
                 my $regex = $rx->{rx};
                 # XXX: hack for /$pattern/