# Feel free to add more here.
#
# -- .robin. <robin@kitsite.com> 2001-03-13
+BEGIN {
+ chdir 't' if -d 't';
+ require "./test.pl";
+ set_up_inc(qw(. ../lib));
+}
-print "1..47\n";
+plan( tests => 67 );
my $ok;
-## while() loop without a label
-
-TEST1: { # redo
+TEST1: {
$ok = 0;
}
$ok = 0;
}
-print ($ok ? "ok 1\n" : "not ok 1\n");
+cmp_ok($ok,'==',1,'no label on while()');
-TEST2: { # next (succesful)
+TEST2: {
$ok = 0;
}
$ok = 0;
}
-print ($ok ? "ok 2\n" : "not ok 2\n");
+cmp_ok($ok,'==',1,'no label on while() successful next');
-TEST3: { # next (unsuccesful)
+TEST3: {
$ok = 0;
}
$ok = $been_in_loop && $been_in_continue;
}
-print ($ok ? "ok 3\n" : "not ok 3\n");
+cmp_ok($ok,'==',1,'no label on while() unsuccessful next');
-TEST4: { # last
+TEST4: {
$ok = 0;
}
$ok = 1;
}
-print ($ok ? "ok 4\n" : "not ok 4\n");
-
-
-## until() loop without a label
+cmp_ok($ok,'==',1,'no label on while() last');
-TEST5: { # redo
+TEST5: {
$ok = 0;
}
$ok = 0;
}
-print ($ok ? "ok 5\n" : "not ok 5\n");
+cmp_ok($ok,'==',1,'no label on until()');
-TEST6: { # next (succesful)
+TEST6: {
$ok = 0;
}
$ok = 0;
}
-print ($ok ? "ok 6\n" : "not ok 6\n");
+cmp_ok($ok,'==',1,'no label on until() successful next');
-TEST7: { # next (unsuccesful)
+TEST7: {
$ok = 0;
}
$ok = $been_in_loop && $been_in_continue;
}
-print ($ok ? "ok 7\n" : "not ok 7\n");
+cmp_ok($ok,'==',1,'no label on until() unsuccessful next');
-TEST8: { # last
+TEST8: {
$ok = 0;
}
$ok = 1;
}
-print ($ok ? "ok 8\n" : "not ok 8\n");
+cmp_ok($ok,'==',1,'no label on until() last');
-## for(@array) loop without a label
-
-TEST9: { # redo
+TEST9: {
$ok = 0;
}
$ok = 0;
}
-print ($ok ? "ok 9\n" : "not ok 9\n");
+cmp_ok($ok,'==',1,'no label on for(@array)');
-TEST10: { # next (succesful)
+TEST10: {
$ok = 0;
}
$ok = 0;
}
-print ($ok ? "ok 10\n" : "not ok 10\n");
+cmp_ok($ok,'==',1,'no label on for(@array) successful next');
-TEST11: { # next (unsuccesful)
+TEST11: {
$ok = 0;
}
$ok = $been_in_loop && $been_in_continue;
}
-print ($ok ? "ok 11\n" : "not ok 11\n");
+cmp_ok($ok,'==',1,'no label on for(@array) unsuccessful next');
-TEST12: { # last
+TEST12: {
$ok = 0;
}
$ok = 1;
}
-print ($ok ? "ok 12\n" : "not ok 12\n");
-
-## for(;;) loop without a label
+cmp_ok($ok,'==',1,'no label on for(@array) last');
-TEST13: { # redo
+TEST13: {
$ok = 0;
}
$ok = 0;
}
-print ($ok ? "ok 13\n" : "not ok 13\n");
+cmp_ok($ok,'==',1,'no label on for(;;)');
-TEST14: { # next (successful)
+TEST14: {
$ok = 0;
}
$ok = 0;
}
-print ($ok ? "ok 14\n" : "not ok 14\n");
+cmp_ok($ok,'==',1,'no label on for(;;) successful next');
-TEST15: { # next (unsuccesful)
+TEST15: {
$ok = 0;
}
$ok = $been_in_loop;
}
-print ($ok ? "ok 15\n" : "not ok 15\n");
+cmp_ok($ok,'==',1,'no label on for(;;) unsuccessful next');
-TEST16: { # last
+TEST16: {
$ok = 0;
}
$ok = 1;
}
-print ($ok ? "ok 16\n" : "not ok 16\n");
+cmp_ok($ok,'==',1,'no label on for(;;) last');
-## bare block without a label
-
-TEST17: { # redo
+TEST17: {
$ok = 0;
my $first_time = 1;
}
$ok = 0;
}
-print ($ok ? "ok 17\n" : "not ok 17\n");
+cmp_ok($ok,'==',1,'no label on bare block');
-TEST18: { # next
+TEST18: {
$ok = 0;
{
}
$ok = 0;
}
-print ($ok ? "ok 18\n" : "not ok 18\n");
+cmp_ok($ok,'==',1,'no label on bare block next');
-TEST19: { # last
+TEST19: {
$ok = 0;
{
}
$ok = 1;
}
-print ($ok ? "ok 19\n" : "not ok 19\n");
-
+cmp_ok($ok,'==',1,'no label on bare block last');
### Now do it all again with labels
-## while() loop with a label
-
-TEST20: { # redo
+TEST20: {
$ok = 0;
}
$ok = 0;
}
-print ($ok ? "ok 20\n" : "not ok 20\n");
+cmp_ok($ok,'==',1,'label on while()');
-TEST21: { # next (succesful)
+TEST21: {
$ok = 0;
}
$ok = 0;
}
-print ($ok ? "ok 21\n" : "not ok 21\n");
+cmp_ok($ok,'==',1,'label on while() successful next');
-TEST22: { # next (unsuccesful)
+TEST22: {
$ok = 0;
}
$ok = $been_in_loop && $been_in_continue;
}
-print ($ok ? "ok 22\n" : "not ok 22\n");
+cmp_ok($ok,'==',1,'label on while() unsuccessful next');
-TEST23: { # last
+TEST23: {
$ok = 0;
}
$ok = 1;
}
-print ($ok ? "ok 23\n" : "not ok 23\n");
-
+cmp_ok($ok,'==',1,'label on while() last');
-## until() loop with a label
-
-TEST24: { # redo
+TEST24: {
$ok = 0;
}
$ok = 0;
}
-print ($ok ? "ok 24\n" : "not ok 24\n");
+cmp_ok($ok,'==',1,'label on until()');
-TEST25: { # next (succesful)
+TEST25: {
$ok = 0;
}
$ok = 0;
}
-print ($ok ? "ok 25\n" : "not ok 25\n");
+cmp_ok($ok,'==',1,'label on until() successful next');
-TEST26: { # next (unsuccesful)
+TEST26: {
$ok = 0;
}
$ok = $been_in_loop && $been_in_continue;
}
-print ($ok ? "ok 26\n" : "not ok 26\n");
+cmp_ok($ok,'==',1,'label on until() unsuccessful next');
-TEST27: { # last
+TEST27: {
$ok = 0;
}
$ok = 1;
}
-print ($ok ? "ok 27\n" : "not ok 27\n");
-
-## for(@array) loop with a label
+cmp_ok($ok,'==',1,'label on until() last');
-TEST28: { # redo
+TEST28: {
$ok = 0;
}
$ok = 0;
}
-print ($ok ? "ok 28\n" : "not ok 28\n");
+cmp_ok($ok,'==',1,'label on for(@array)');
-TEST29: { # next (succesful)
+TEST29: {
$ok = 0;
}
$ok = 0;
}
-print ($ok ? "ok 29\n" : "not ok 29\n");
+cmp_ok($ok,'==',1,'label on for(@array) successful next');
-TEST30: { # next (unsuccesful)
+TEST30: {
$ok = 0;
}
$ok = $been_in_loop && $been_in_continue;
}
-print ($ok ? "ok 30\n" : "not ok 30\n");
+cmp_ok($ok,'==',1,'label on for(@array) unsuccessful next');
-TEST31: { # last
+TEST31: {
$ok = 0;
}
$ok = 1;
}
-print ($ok ? "ok 31\n" : "not ok 31\n");
+cmp_ok($ok,'==',1,'label on for(@array) last');
-## for(;;) loop with a label
-
-TEST32: { # redo
+TEST32: {
$ok = 0;
}
$ok = 0;
}
-print ($ok ? "ok 32\n" : "not ok 32\n");
+cmp_ok($ok,'==',1,'label on for(;;)');
-TEST33: { # next (successful)
+TEST33: {
$ok = 0;
}
$ok = 0;
}
-print ($ok ? "ok 33\n" : "not ok 33\n");
+cmp_ok($ok,'==',1,'label on for(;;) successful next');
-TEST34: { # next (unsuccesful)
+TEST34: {
$ok = 0;
}
$ok = $been_in_loop;
}
-print ($ok ? "ok 34\n" : "not ok 34\n");
+cmp_ok($ok,'==',1,'label on for(;;) unsuccessful next');
-TEST35: { # last
+TEST35: {
$ok = 0;
}
$ok = 1;
}
-print ($ok ? "ok 35\n" : "not ok 35\n");
-
-## bare block with a label
+cmp_ok($ok,'==',1,'label on for(;;) last');
-TEST36: { # redo
+TEST36: {
$ok = 0;
my $first_time = 1;
}
$ok = 0;
}
-print ($ok ? "ok 36\n" : "not ok 36\n");
+cmp_ok($ok,'==',1,'label on bare block');
-TEST37: { # next
+TEST37: {
$ok = 0;
LABEL37: {
}
$ok = 0;
}
-print ($ok ? "ok 37\n" : "not ok 37\n");
+cmp_ok($ok,'==',1,'label on bare block next');
-TEST38: { # last
+TEST38: {
$ok = 0;
LABEL38: {
}
$ok = 1;
}
-print ($ok ? "ok 38\n" : "not ok 38\n");
-
-### Now test nested constructs
+cmp_ok($ok,'==',1,'label on bare block last');
TEST39: {
$ok = 0;
$ok = 0;
}
}
-print ($ok ? "ok 39\n" : "not ok 39\n");
-
-
-### Test that loop control is dynamicly scoped.
+cmp_ok($ok,'==',1,'nested constructs');
sub test_last_label { last TEST40 }
test_last_label();
$ok = 0;
}
-print ($ok ? "ok 40\n" : "not ok 40\n");
+cmp_ok($ok,'==',1,'dynamically scoped label');
sub test_last { last }
test_last();
$ok = 0;
}
-print ($ok ? "ok 41\n" : "not ok 41\n");
+cmp_ok($ok,'==',1,'dynamically scoped');
# [perl #27206] Memory leak in continue loop
{
($n-- && bless {}, 'X') && redo;
}
- print $late_free ? "not " : "", "ok 42 - redo memory leak\n";
+ cmp_ok($late_free,'==',0,"bug 27206: redo memory leak");
$n = 10; $late_free = 0;
{
($n-- && bless {}, 'X') && redo;
}
continue { }
- print $late_free ? "not " : "", "ok 43 - redo with continue memory leak\n";
+ cmp_ok($late_free,'==',0,"bug 27206: redo with continue memory leak");
}
-
-# ensure that redo doesn't clear a lexical delcared in the condition
+# ensure that redo doesn't clear a lexical declared in the condition
{
my $i = 1;
while (my $x = $i) {
$i++;
redo if $i == 2;
- print $x == 1 ? "" : "not ", "ok 44 - while/redo lexical life\n";
+ cmp_ok($x,'==',1,"while/redo lexical life");
last;
}
$i = 1;
until (! (my $x = $i)) {
$i++;
redo if $i == 2;
- print $x == 1 ? "" : "not ", "ok 45 - until/redo lexical life\n";
+ cmp_ok($x,'==',1,"until/redo lexical life");
last;
}
for ($i = 1; my $x = $i; ) {
$i++;
redo if $i == 2;
- print $x == 1 ? "" : "not ", "ok 46 - for/redo lexical life\n";
+ cmp_ok($x,'==',1,"for/redo lexical life");
last;
}
}
{
- # [perl #37725]
-
$a37725[3] = 1; # use package var
$i = 2;
for my $x (reverse @a37725) {
$x = $i++;
}
- print "@a37725" == "5 4 3 2" ? "" : "not ",
- "ok 47 - reverse with empty slots (@a37725)\n";
+ 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 }
+
+{
+ my $i = 1;
+ $x_21469 = 'X';
+ $y1_21469 = 'Y1';
+ $y2_21469 = 'Y2';
+ $y3_21469 = 'Y3';
+ for $x_21469 (1,2,3) {
+ is($x_21469, $i, "bug 21469: correct at start of loop $i");
+ *x_21469 = (*y1_21469, *y2_21469, *y3_21469)[$i-1];
+ is($x_21469, "Y$i", "bug 21469: correct at tail of loop $i");
+ $i++;
+ }
+ is($x_21469, 'X', "bug 21469: X okay at end of loop");
+}
+
+# [perl #112316] Wrong behavior regarding labels with same prefix
+{
+ my $fail;
+ CATCH: {
+ CATCHLOOP: {
+ last CATCH;
+ }
+ $fail = 1;
+ }
+ 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';