Deprecate above \xFF in bitwise string ops

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

diff --git a/t/op/loopctl.t b/t/op/loopctl.t
index 3a8fc9a..1bb3c9c 100644 (file)
--- a/t/op/loopctl.t
+++ b/t/op/loopctl.t
@@ -32,11 +32,11 @@
 #  -- .robin. <robin@kitsite.com>  2001-03-13
 BEGIN {
     chdir 't' if -d 't';
-    @INC = qw(. ../lib);
+    require "./test.pl";
+    set_up_inc(qw(. ../lib));
 }
 
-require "test.pl";
-plan( tests => 55 );
+plan( tests => 67 );
 
 my $ok;
 
@@ -975,7 +975,7 @@ cmp_ok($ok,'==',1,'dynamically scoped');
     for my $x (reverse @a37725) {
        $x = $i++;
     }
-    cmp_ok("@a37725",'eq',"5 4 3 2",'bug 27725: reverse with empty slots bug');
+    cmp_ok("@a37725",'eq',"5 4 3 2",'bug 37725: reverse with empty slots bug');
 }
 
 # [perl #21469] bad things happened with for $x (...) { *x = *y }
@@ -1006,3 +1006,115 @@ cmp_ok($ok,'==',1,'dynamically scoped');
     }
     ok(!$fail, "perl 112316: Labels with the same prefix don't get mixed up.");
 }
+
+# [perl #73618]
+{
+    sub foo_73618_0 {
+        while (0) { }
+    }
+    sub bar_73618_0 {
+        my $i = 0;
+        while ($i) { }
+    }
+    sub foo_73618_undef {
+        while (undef) { }
+    }
+    sub bar_73618_undef {
+        my $i = undef;
+        while ($i) { }
+    }
+    sub foo_73618_emptystring {
+        while ("") { }
+    }
+    sub bar_73618_emptystring {
+        my $i = "";
+        while ($i) { }
+    }
+    sub foo_73618_0float {
+        while (0.0) { }
+    }
+    sub bar_73618_0float {
+        my $i = 0.0;
+        while ($i) { }
+    }
+    sub foo_73618_0string {
+        while ("0") { }
+    }
+    sub bar_73618_0string {
+        my $i = "0";
+        while ($i) { }
+    }
+    sub foo_73618_until {
+        until (1) { }
+    }
+    sub bar_73618_until {
+        my $i = 1;
+        until ($i) { }
+    }
+
+    is(scalar(foo_73618_0()), scalar(bar_73618_0()),
+       "constant optimization doesn't change return value");
+    is(scalar(foo_73618_undef()), scalar(bar_73618_undef()),
+       "constant optimization doesn't change return value");
+    is(scalar(foo_73618_emptystring()), scalar(bar_73618_emptystring()),
+       "constant optimization doesn't change return value");
+    is(scalar(foo_73618_0float()), scalar(bar_73618_0float()),
+       "constant optimization doesn't change return value");
+    is(scalar(foo_73618_0string()), scalar(bar_73618_0string()),
+       "constant optimization doesn't change return value");
+    { local $TODO = "until is still wrongly optimized";
+    is(scalar(foo_73618_until()), scalar(bar_73618_until()),
+       "constant optimization doesn't change return value");
+    }
+}
+
+# [perl #113684]
+last_113684:
+{
+    label1:
+    {
+        my $label = "label1";
+        eval { last $label };
+        fail("last with non-constant label");
+        last last_113684;
+    }
+    pass("last with non-constant label");
+}
+next_113684:
+{
+    label2:
+    {
+        my $label = "label2";
+        eval { next $label };
+        fail("next with non-constant label");
+        next next_113684;
+    }
+    pass("next with non-constant label");
+}
+redo_113684:
+{
+    my $count;
+    label3:
+    {
+        if ($count++) {
+            pass("redo with non-constant label"); last redo_113684
+        }
+        my $label = "label3";
+        eval { redo $label };
+        fail("redo with non-constant label");
+    }
+}
+
+# [perl #3112]
+# The original report, which produced a Bizarre copy
+@a  = ();
+eval {
+    for (1) {
+        push @a, last;
+    }
+};
+is @a, 0, 'push @a, last;  does not push';
+is $@, "", 'no error, either';
+# And my japh, which relied on the misbehaviour
+is do{{&{sub{"Just another Perl hacker,\n"}},last}}, undef,
+  'last returns nothing';