diff options
| -rw-r--r-- | MANIFEST | 1 | ||||
| -rw-r--r-- | t/op/closure.t | 14 | ||||
| -rw-r--r-- | t/op/const-optree.t | 48 | ||||
| -rw-r--r-- | t/op/sub.t | 25 |
4 files changed, 50 insertions, 38 deletions
@@ -5179,6 +5179,7 @@ t/op/closure.t See if closures work t/op/closure_test.pl Extra file for closure.t t/op/concat2.t Tests too complex for concat.t t/op/cond.t See if conditional expressions work +t/op/const-optree.t Tests for sub(){...} becoming constant t/op/context.t See if context propagation works t/op/coreamp.t Test &foo() calls for CORE subs t/op/coresubs.t Generic tests for CORE subs diff --git a/t/op/closure.t b/t/op/closure.t index 9a4e50dc2a..42453f4928 100644 --- a/t/op/closure.t +++ b/t/op/closure.t @@ -671,20 +671,6 @@ $r = \$x "don't copy a stale lexical; create a fresh undef one instead"); } -# [perl #63540] Don’t treat sub { if(){.....}; "constant" } as a constant - -BEGIN { - my $x = 7; - *baz = sub() { if($x){ () = "tralala"; blonk() }; 0 } -} -{ - my $blonk_was_called; - *blonk = sub { ++$blonk_was_called }; - my $ret = baz(); - is($ret, 0, 'RT #63540'); - is($blonk_was_called, 1, 'RT #63540'); -} - # test PL_cv_has_eval. Any anon sub that could conceivably contain an # eval, should be marked as cloneable diff --git a/t/op/const-optree.t b/t/op/const-optree.t new file mode 100644 index 0000000000..3807b2ea97 --- /dev/null +++ b/t/op/const-optree.t @@ -0,0 +1,48 @@ +#!perl + +# Test the various op trees that turn sub () { ... } into a constant, and +# some variants that don’t. + +BEGIN { + chdir 't'; + require './test.pl'; + @INC = '../lib'; +} +plan 6; + +# [perl #63540] Don’t treat sub { if(){.....}; "constant" } as a constant + +BEGIN { + my $x = 7; + *baz = sub() { if($x){ () = "tralala"; blonk() }; 0 } +} +{ + my $blonk_was_called; + *blonk = sub { ++$blonk_was_called }; + my $ret = baz(); + is($ret, 0, 'RT #63540'); + is($blonk_was_called, 1, 'RT #63540'); +} + +# [perl #79908] +{ + my $x = 5; + *_79908 = sub (){$x}; + $x = 7; + TODO: { + local $TODO = "Should be fixed with a deprecation cycle, see 'How about having a recommended way to add constant subs dynamically?' on p5p"; + is eval "_79908", 7, 'sub(){$x} does not break closures'; + } + isnt eval '\_79908', \$x, 'sub(){$x} returns a copy'; + ok eval '\_79908 != \_79908', 'sub(){$x} returns a copy each time'; + + # Test another thing that was broken by $x inlinement + my $y; + local *time = sub():method{$y}; + my $w; + local $SIG{__WARN__} = sub { $w .= shift }; + eval "()=time"; + is $w, undef, + '*keyword = sub():method{$y} does not cause ambiguity warnings'; +} + diff --git a/t/op/sub.t b/t/op/sub.t index dd264ca603..db61ac2e02 100644 --- a/t/op/sub.t +++ b/t/op/sub.t @@ -6,7 +6,7 @@ BEGIN { set_up_inc('../lib'); } -plan( tests => 39 ); +plan( tests => 35 ); sub empty_sub {} @@ -147,29 +147,6 @@ is eval { Munchy(Crunchy); } || $@, 2, 'freeing ops does not make sub(){42} immutable'; -# [perl #79908] -{ - my $x = 5; - *_79908 = sub (){$x}; - $x = 7; - TODO: { - local $TODO = "Should be fixed with a deprecation cycle, see 'How about having a recommended way to add constant subs dynamically?' on p5p"; - is eval "_79908", 7, 'sub(){$x} does not break closures'; - } - isnt eval '\_79908', \$x, 'sub(){$x} returns a copy'; - ok eval '\_79908 != \_79908', 'sub(){$x} returns a copy each time'; - - # Test another thing that was broken by $x inlinement - my $y; - no warnings 'once'; - local *time = sub():method{$y}; - my $w; - local $SIG{__WARN__} = sub { $w .= shift }; - eval "()=time"; - is $w, undef, - '*keyword = sub():method{$y} does not cause ambiguity warnings'; -} - # &xsub when @_ has nonexistent elements { no warnings "uninitialized"; |