Deprecate above \xFF in bitwise string ops

[perl5.git] / t / op / wantarray.t

diff --git a/t/op/wantarray.t b/t/op/wantarray.t
old mode 100755 (executable)
new mode 100644 (file)
index 28936f4..854cca6
--- a/t/op/wantarray.t
+++ b/t/op/wantarray.t
@@ -1,25 +1,32 @@
 #!./perl
 
-print "1..9\n";
+BEGIN {
+    chdir 't' if -d 't';
+    require './test.pl';
+    set_up_inc('../lib');
+}
+
+use strict;
+
+plan 28;
+
 sub context {
-  my ( $cona, $testnum ) = @_;
+  local $::Level = $::Level + 1;
+  my ( $cona, $name ) = @_;
   my $conb = (defined wantarray) ? ( wantarray ? 'A' : 'S' ) : 'V';
-  unless ( $cona eq $conb ) {
-       print "# Context $conb should be $cona\nnot ";
-  }
-  print "ok $testnum\n";
+  is $conb, $cona, $name;
 }
 
-context('V',1);
-$a = context('S',2);
-@a = context('A',3);
-scalar context('S',4);
-$a = scalar context('S',5);
-($a) = context('A',6);
-($a) = scalar context('S',7);
+context('V');
+my $a = context('S');
+my @a = context('A');
+scalar context('S');
+$a = scalar context('S');
+($a) = context('A');
+($a) = scalar context('S');
 
 {
-  # [ID 20020626.011] incorrect wantarray optimisation
+  # [ID 20020626.011 (#9998)] incorrect wantarray optimisation
   sub simple { wantarray ? 1 : 2 }
   sub inline {
     my $a = wantarray ? simple() : simple();
@@ -27,8 +34,47 @@ $a = scalar context('S',5);
   }
   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";
+  is @b, 1;
+  is "@b", "2";
+  is $c, 2;
 }
 
+my $q;
+
+my $qcontext = q{
+  $q = (defined wantarray) ? ( wantarray ? 'A' : 'S' ) : 'V';
+};
+eval $qcontext;
+is $q, 'V';
+$a = eval $qcontext;
+is $q, 'S';
+@a = eval $qcontext;
+is $q, 'A';
+
+# Test with various ops that the right context is used at the end of a sub-
+# routine (run-time context).
+$::t = 1;
+$::f = 0;
+$::u = undef;
+sub or_context { $::f || context(shift, "rhs of || at sub exit") }
+or_context('V');
+$_ = or_context('S');
+() = or_context('A');
+sub and_context { $::t && context(shift, "rhs of && at sub exit") }
+and_context('V');
+$_ = and_context('S');
+() = and_context('A');
+sub dor_context { $::u // context(shift, "rhs of // at sub exit") }
+dor_context('V');
+$_ = dor_context('S');
+() = dor_context('A');
+sub cond_middle_cx { $::t ? context(shift, "mid of ?: at sub exit") : 0 }
+cond_middle_cx('V');
+$_ = cond_middle_cx('S');
+() = cond_middle_cx('A');
+sub cond_rhs_cx { $::f ? 0 : context(shift, "rhs of ?: at sub exit") }
+cond_rhs_cx('V');
+$_ = cond_rhs_cx('S');
+() = cond_rhs_cx('A');
+
 1;