Re: [ID 20020626.011] wantarray() causes clobbering of unrelated vars outside the sub

Message-Id: <200207081600.g68G0Xw07553@crypt.compulink.co.uk>

p4raw-id: //depot/perl@17423

diff --git a/lib/File/Basename.pm b/lib/File/Basename.pm
index b2ab469..f2ef495 100644 (file)
--- a/lib/File/Basename.pm
+++ b/lib/File/Basename.pm
@@ -226,7 +226,7 @@ sub fileparse {
 
   $tail .= $taint if defined $tail; # avoid warning if $tail == undef
   wantarray ? ($basename .= $taint, $dirpath .= $taint, $tail)
-            : $basename .= $taint;
+            : ($basename .= $taint);
 }
 
 

diff --git a/op.c b/op.c
index 850983b..0a8c0a2 100644 (file)
--- a/op.c
+++ b/op.c
@@ -3899,14 +3899,6 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
            return first;
        }
     }
-    else if (first->op_type == OP_WANTARRAY) {
-       /* XXX true only if this result will be returned, else should
-          propagate outer context */
-       if (type == OP_AND)
-           list(other);
-       else
-           scalar(other);
-    }
     else if (ckWARN(WARN_MISC) && (first->op_flags & OPf_KIDS)) {
        OP *k1 = ((UNOP*)first)->op_first;
        OP *k2 = k1->op_sibling;
@@ -3996,12 +3988,6 @@ Perl_newCONDOP(pTHX_ I32 flags, OP *first, OP *trueop, OP *falseop)
            return falseop;
        }
     }
-    else if (first->op_type == OP_WANTARRAY) {
-       /* XXX true only if this result will be returned, else should
-          propagate outer context */
-       list(trueop);
-       scalar(falseop);
-    }
     NewOp(1101, logop, 1, LOGOP);
     logop->op_type = OP_COND_EXPR;
     logop->op_ppaddr = PL_ppaddr[OP_COND_EXPR];

diff --git a/t/op/wantarray.t b/t/op/wantarray.t
index 4b6f37c..28936f4 100755 (executable)
--- a/t/op/wantarray.t
+++ b/t/op/wantarray.t
@@ -1,6 +1,6 @@
 #!./perl
 
-print "1..7\n";
+print "1..9\n";
 sub context {
   my ( $cona, $testnum ) = @_;
   my $conb = (defined wantarray) ? ( wantarray ? 'A' : 'S' ) : 'V';
@@ -17,4 +17,18 @@ scalar context('S',4);
 $a = scalar context('S',5);
 ($a) = context('A',6);
 ($a) = scalar context('S',7);
+
+{
+  # [ID 20020626.011] incorrect wantarray optimisation
+  sub simple { wantarray ? 1 : 2 }
+  sub inline {
+    my $a = wantarray ? simple() : simple();
+    $a;
+  }
+  my @b = inline();
+  my $c = inline();
+  print +(@b == 1 && "@b" eq "2") ? "ok 8\n" : "not ok 8\t# <@b>\n";
+  print +($c == 2) ? "ok 9\n" : "not ok 9\t# <$c>\n";
+}
+
 1;