require './test.pl';
}
-plan( tests => 26 );
+plan( tests => 34 );
sub empty_sub {}
is $@, "", 'my sub (){42} returns a mutable value';
eval { ${\not_constantmr}++ };
is $@, "", 'my sub (){ return 42 } returns a mutable value';
+is eval {
+ sub Crunchy () { 1 }
+ sub Munchy { $_[0] = 2 }
+ eval "Crunchy"; # test that freeing this op does not turn off PADTMP
+ Munchy(Crunchy);
+} || $@, 2, 'freeing ops does not make sub(){42} immutable';
# [perl #79908]
{
my $x = 5;
*_79908 = sub (){$x};
$x = 7;
- is eval "_79908", 7, 'sub(){$x} does not break closures';
+ 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';
# Test another thing that was broken by $x inlinement
my $w;
local $SIG{__WARN__} = sub { $w .= shift };
eval "()=time";
- is $w, undef,
- '*keyword = sub():method{$y} does not cause ambiguity warnings';
+ 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 $w, undef,
+ '*keyword = sub():method{$y} does not cause ambiguity warnings';
+ }
+}
+
+# &xsub when @_ has nonexistent elements
+{
+ no warnings "uninitialized";
+ local @_ = ();
+ $#_++;
+ &utf8::encode;
+ is @_, 1, 'num of elems in @_ after &xsub with nonexistent $_[0]';
+ is $_[0], "", 'content of nonexistent $_[0] is modified by &xsub';
+}
+
+# &xsub when @_ itself does not exist
+undef *_;
+eval { &utf8::encode };
+# The main thing we are testing is that it did not crash. But make sure
+# *_{ARRAY} was untouched, too.
+is *_{ARRAY}, undef, 'goto &xsub when @_ does not exist';
+
+# We do not want re.pm loaded at this point. Move this test up or find
+# another XSUB if this fails.
+ok !exists $INC{"re.pm"}, 're.pm not loaded yet';
+{
+ sub re::regmust{}
+ bless \&re::regmust;
+ DESTROY {
+ no warnings 'redefine', 'prototype';
+ my $str1 = "$_[0]";
+ *re::regmust = sub{}; # GvSV had no refcount, so this freed it
+ my $str2 = "$_[0]"; # used to be UNKNOWN(0x7fdda29310e0)
+ @str = ($str1, $str2);
+ }
+ local $^W; # Suppress redef warnings in XSLoader
+ require re;
+ is $str[1], $str[0],
+ 'XSUB clobbering sub whose DESTROY assigns to the glob';
+}
+{
+ no warnings 'redefine';
+ sub foo {}
+ bless \&foo, 'newATTRSUBbug';
+ sub newATTRSUBbug::DESTROY {
+ my $str1 = "$_[0]";
+ *foo = sub{}; # GvSV had no refcount, so this freed it
+ my $str2 = "$_[0]"; # used to be UNKNOWN(0x7fdda29310e0)
+ @str = ($str1, $str2);
+ }
+ splice @str;
+ eval "sub foo{}";
+ is $str[1], $str[0],
+ 'Pure-Perl sub clobbering sub whose DESTROY assigns to the glob';
+}
+
+{ local $TODO = "fixed in next commit";
+# [perl #122107] previously this would return
+# Subroutine BEGIN redefined at (eval 2) line 2.
+fresh_perl_is(<<'EOS', "", { stderr => 1 },
+use strict; use warnings; eval q/use File::{Spec}/; eval q/use File::Spec/;
+EOS
+ "check special blocks are cleared on error");
}