Perlito5 - js - do-while rewrite

fglock · Oct 1, 2015 · 2a1bbab · 2a1bbab
1 parent b77a11f
commit 2a1bbab
Show file tree

Hide file tree

Showing 3 changed files with 48 additions and 14 deletions.
diff --git a/perlito5.pl b/perlito5.pl
@@ -10450,8 +10450,6 @@
             sub Perlito5::AST::While::emit_javascript2 {
                 my($self, $level, $wantarray) = @_;
                 my $cond = $self->{'cond'};
-                my $do_at_least_once = ref($self->{'body'}) eq 'Perlito5::AST::Apply' && $self->{'body'}->{'code'} eq 'do' ? 1 : 0;
-                my $body = ref($self->{'body'}) ne 'Perlito5::AST::Block' ? [$self->{'body'}] : $self->{'body'}->{'stmts'};
                 my @str;
                 my $old_level = $level;
                 if ($cond) {
@@ -10461,7 +10459,13 @@
                         push(@str, $arg->emit_javascript2_init($level, $wantarray))
                     }
                 }
-                push(@str, 'p5while(' . 'function () {' . chr(10) . Perlito5::Javascript2::tab($level + 2) . (Perlito5::Javascript2::LexicalBlock::->new('block' => $body))->emit_javascript2($level + 2, $wantarray) . chr(10) . Perlito5::Javascript2::tab($level + 1) . '}, ' . Perlito5::Javascript2::emit_function_javascript2($level + 1, 'scalar', $cond) . ', ' . Perlito5::AST::Block::emit_javascript2_continue($self, $level, $wantarray) . ', ' . Perlito5::Javascript2::escape_string($self->{'label'} || '') . ', ' . $do_at_least_once . ')');
+                if (ref($self->{'body'}) eq 'Perlito5::AST::Apply' && $self->{'body'}->{'code'} eq 'do') {
+                    push(@str, 'do {' . $self->{'body'}->emit_javascript2($level + 2, $wantarray) . chr(10) . Perlito5::Javascript2::tab($level + 1) . '} while (' . Perlito5::Javascript2::to_bool($cond, $level + 2) . ')')
+                }
+                else {
+                    my $body = ref($self->{'body'}) ne 'Perlito5::AST::Block' ? [$self->{'body'}] : $self->{'body'}->{'stmts'};
+                    push(@str, 'p5while(' . 'function () {' . chr(10) . Perlito5::Javascript2::tab($level + 2) . (Perlito5::Javascript2::LexicalBlock::->new('block' => $body))->emit_javascript2($level + 2, $wantarray) . chr(10) . Perlito5::Javascript2::tab($level + 1) . '}, ' . Perlito5::Javascript2::emit_function_javascript2($level + 1, 'scalar', $cond) . ', ' . Perlito5::AST::Block::emit_javascript2_continue($self, $level, $wantarray) . ', ' . Perlito5::Javascript2::escape_string($self->{'label'} || '') . ', ' . 0 . ')')
+                }
                 if (@str) {
                     $level = $old_level;
                     return Perlito5::Javascript2::emit_wrap_javascript2($level, $wantarray, @str)

diff --git a/src5/lib/Perlito5/Javascript2/Emitter.pm b/src5/lib/Perlito5/Javascript2/Emitter.pm
@@ -2976,15 +2976,6 @@ package Perlito5::AST::While;
         my ($self, $level, $wantarray) = @_;
         my $cond = $self->{cond};
 
-        # body is 'Perlito5::AST::Apply' in this construct:
-        #   do { ... } while ...;
-        my $do_at_least_once = ref($self->{body}) eq 'Perlito5::AST::Apply' && $self->{body}{code} eq 'do' ? 1 : 0;
-
-        my $body =
-              ref($self->{body}) ne 'Perlito5::AST::Block'
-            ? [ $self->{body} ]
-            : $self->{body}{stmts};
-
         # extract declarations from 'cond'
         my @str;
         my $old_level = $level;
@@ -2998,15 +2989,31 @@ package Perlito5::AST::While;
             }
         }
 
-        push @str, 'p5while('
+        # body is 'Perlito5::AST::Apply' in this construct:
+        #   do { ... } while ...;
+        if ( ref($self->{body}) eq 'Perlito5::AST::Apply' && $self->{body}{code} eq 'do' ) {
+            push @str,
+                  'do {'
+                .   $self->{body}->emit_javascript2($level + 2, $wantarray) . "\n"
+                . Perlito5::Javascript2::tab($level + 1) . '} while ('
+                .   Perlito5::Javascript2::to_bool($cond, $level + 2)
+                . ')';
+        }
+        else {
+            my $body =
+                  ref($self->{body}) ne 'Perlito5::AST::Block'
+                ? [ $self->{body} ]
+                : $self->{body}{stmts};
+            push @str, 'p5while('
                     . "function () {\n"
                     . Perlito5::Javascript2::tab($level + 2) .   (Perlito5::Javascript2::LexicalBlock->new( block => $body ))->emit_javascript2($level + 2, $wantarray) . "\n"
                     . Perlito5::Javascript2::tab($level + 1) . '}, '
                     . Perlito5::Javascript2::emit_function_javascript2($level + 1, 'scalar', $cond) . ', '
                     . Perlito5::AST::Block::emit_javascript2_continue($self, $level, $wantarray) . ', '
                     . Perlito5::Javascript2::escape_string($self->{label} || "") . ', '
-                    . $do_at_least_once
+                    . '0'
                     . ')';
+        }
 
         if (@str) {
             $level = $old_level;

diff --git a/t5/unit/do_while.t b/t5/unit/do_while.t
@@ -0,0 +1,23 @@
+use feature 'say';
+
+say '1..5';
+
+$_ = 1;
+{
+    say "ok 1 - inside block";
+    do {
+        $_++;
+        next if $_ == 1 || $_ == 3;
+        say "ok $_ - next in do-while goes to outer block";
+    } while ( $_ < 5 );
+}
+
+say "ok 3 - outside block";
+do {
+    {
+        $_++;
+        next if $_ == 1 || $_ == 3;
+        say "ok $_ - next in do-while in inner block";
+    }
+} while ( $_ < 5 );
+