Implement correct deparse logic for try/catch/finally

Perl · Jan 20, 2022 · 2075f88 · 2075f88
1 parent e5e291f
commit 2075f88
Show file tree

Hide file tree

Showing 2 changed files with 35 additions and 5 deletions.
diff --git a/lib/B/Deparse.pm b/lib/B/Deparse.pm
@@ -21,7 +21,7 @@ use B qw(class main_root main_start main_cv svref_2object opnumber perlstring
          OPpPADHV_ISKEYS OPpRV2HV_ISKEYS
          OPpCONCAT_NESTED
          OPpMULTICONCAT_APPEND OPpMULTICONCAT_STRINGIFY OPpMULTICONCAT_FAKE
-         OPpTRUEBOOL OPpINDEX_BOOLNEG
+         OPpTRUEBOOL OPpINDEX_BOOLNEG OPpDEFER_FINALLY
 	 SVf_IOK SVf_NOK SVf_ROK SVf_POK SVpad_OUR SVf_FAKE SVs_RMG SVs_SMG
 	 SVs_PADTMP SVpad_TYPED
          CVf_METHOD CVf_LVALUE
@@ -272,7 +272,8 @@ BEGIN {
 
 BEGIN { for (qw[ const stringify rv2sv list glob pushmark null aelem
 		 kvaslice kvhslice padsv argcheck
-                 nextstate dbstate rv2av rv2hv helem custom ]) {
+                 nextstate dbstate rv2av rv2hv helem pushdefer leavetrycatch
+                 custom ]) {
     eval "sub OP_\U$_ () { " . opnumber($_) . "}"
 }}
 
@@ -1732,6 +1733,12 @@ sub scopeop {
 	    $body = $self->deparse($body, 1);
 	    return "$body $name $cond";
 	}
+        elsif($kid->type == OP_PUSHDEFER &&
+            $kid->private & OPpDEFER_FINALLY &&
+            $kid->sibling->type == OP_LEAVETRYCATCH &&
+            null($kid->sibling->sibling)) {
+            return $self->pp_leavetrycatch_with_finally($kid->sibling, $kid, $cx);
+        }
     } else {
 	$kid = $op->first;
     }
@@ -4070,9 +4077,9 @@ sub pp_leavetry {
     return "eval {\n\t" . $self->pp_leave(@_) . "\n\b}";
 }
 
-sub pp_leavetrycatch {
+sub pp_leavetrycatch_with_finally {
     my $self = shift;
-    my ($op) = @_;
+    my ($op, $finallyop) = @_;
 
     # Expect that the first three kids should be (entertrycatch, poptry, catch)
     my $entertrycatch = $op->first;
@@ -4095,8 +4102,20 @@ sub pp_leavetrycatch {
     my $catchcode = $name eq 'scope' ? scopeop(0, $self, $catchblock)
                                      : scopeop(1, $self, $catchblock);
 
+    my $finallycode = "";
+    if($finallyop) {
+        my $body = $self->deparse($finallyop->first->first);
+        $finallycode = "\nfinally {\n\t$body\n\b}";
+    }
+
     return "try {\n\t$trycode\n\b}\n" .
-           "catch($catchvar) {\n\t$catchcode\n\b}\cK";
+           "catch($catchvar) {\n\t$catchcode\n\b}$finallycode\cK";
+}
+
+sub pp_leavetrycatch {
+    my $self = shift;
+    my ($op, @args) = @_;
+    return $self->pp_leavetrycatch_with_finally($op, undef, @args);
 }
 
 sub _op_is_or_was {

diff --git a/lib/B/Deparse.t b/lib/B/Deparse.t
@@ -3192,6 +3192,17 @@ catch($var) {
     SECOND();
 }
 ####
+# CONTEXT use feature 'try'; no warnings 'experimental::try';
+try {
+    FIRST();
+}
+catch($var) {
+    SECOND();
+}
+finally {
+    THIRD();
+}
+####
 # defer blocks
 # CONTEXT use feature "defer"; no warnings 'experimental::defer';
 defer {