From: Hugo van der Sanden <hv@crypt.org>
Date: Mon, 8 Jul 2002 17:00:33 +0000 (+0100)
Subject: Re: [ID 20020626.011] wantarray() causes clobbering of unrelated vars outside the sub
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d2ccd3cbfc4a43ae3c17071c87b4d721f3560ad6;p=p5sagit%2Fp5-mst-13.2.git

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
--- 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
--- 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
--- 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;