From ca830eff807064b02de5c6918407f46b6231daa5 Mon Sep 17 00:00:00 2001
From: fglock <fglock@c213334d-75ef-0310-aa23-eaa082d1ae64>
Date: Thu, 31 Jul 2008 12:12:56 +0000
Subject: [PATCH] [v6.pm] more tests

git-svn-id: http://svn.pugscode.org/pugs@21650 c213334d-75ef-0310-aa23-eaa082d1ae64
---
 Pugs-Compiler-Perl6/MANIFEST                        |  1 +
 Pugs-Compiler-Perl6/Makefile.PL                     |  5 +++++
 Pugs-Compiler-Perl6/lib/Pugs/Emitter/Perl6/Perl5.pm | 11 ++++++++++-
 3 files changed, 16 insertions(+), 1 deletion(-)

diff --git a/Pugs-Compiler-Perl6/MANIFEST b/Pugs-Compiler-Perl6/MANIFEST
index 4598ec81..7ea6f4f3 100644
--- a/Pugs-Compiler-Perl6/MANIFEST
+++ b/Pugs-Compiler-Perl6/MANIFEST
@@ -163,6 +163,7 @@ t/regex/rx_perl5_escape.t
 t/regex/smartparse.t
 t/spec/S02-builtin_data_types/array_extending.t
 t/spec/S02-builtin_data_types/nested_arrays.t
+t/spec/S04-statements/do.t
 t/spec/S04-statements/until.t
 t/spec/S10-packages/import.t
 t/spec/S12-class/inheritance-class-methods.t
diff --git a/Pugs-Compiler-Perl6/Makefile.PL b/Pugs-Compiler-Perl6/Makefile.PL
index efe69734..be7c9c57 100644
--- a/Pugs-Compiler-Perl6/Makefile.PL
+++ b/Pugs-Compiler-Perl6/Makefile.PL
@@ -142,6 +142,11 @@ $rewrite_test = sub {
         $text =~ s/^\s*plan \d+;/plan 84;/m;
         $text =~ s/^\s*force_todo.*?\n/force_todo(18,34,40,51,57,66,67);\n/m;
     }
+    if ( $out eq 't/spec/S04-statements/do.t' ) {
+        $text = "force_todo(1..8,10..16,20..23);\n" . $text;
+        # redo works in perl5 blocks
+        $text =~ s/^([^\n]*?\; *redo\;)/ok( 0, "redo works in perl5 blocks", :todo ) ; # $1/mg;
+    }
     
     # add "use Test" to most files
     if ( $out ne 't/01-sanity/05-sub.t' ) {
diff --git a/Pugs-Compiler-Perl6/lib/Pugs/Emitter/Perl6/Perl5.pm b/Pugs-Compiler-Perl6/lib/Pugs/Emitter/Perl6/Perl5.pm
index e1cbc8d8..32666235 100644
--- a/Pugs-Compiler-Perl6/lib/Pugs/Emitter/Perl6/Perl5.pm
+++ b/Pugs-Compiler-Perl6/lib/Pugs/Emitter/Perl6/Perl5.pm
@@ -835,6 +835,15 @@ sub default {
         # TODO - other builtins
         my $subname = $n->{sub}{bareword};
         if ( $subname ) {
+            if ($subname eq 'next') {
+                my $param = $n->{param} ? _emit( $n->{param} ) : '';
+                return " next $param ";
+            }
+            if ($subname eq 'redo') {
+                my $param = $n->{param} ? _emit( $n->{param} ) : '';
+                return " redo $param ";
+            }
+
             if ($subname eq 'defined') {
                 my $param = _emit( $n->{param} );
                 # when testing defined-ness of $!, it is testing the emptiness of $@ in perl5.
@@ -1116,7 +1125,7 @@ sub statement {
     }
 
     if ( $n->{statement} eq 'do' ) {
-        return 'do ' . emit_block( $n->{exp1} );
+        return 'do { for($_) ' . emit_block( $n->{exp1} ) . ' }';
     }
     if ( $n->{statement} eq 'given' ) {
         return  'for (1) { local $_ = ' . _emit( $n->{exp1} ) . '; ' .