1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
|
#!./perl -w
BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
require './test.pl';
}
plan( tests => 17 );
sub empty_sub {}
is(empty_sub,undef,"Is empty");
is(empty_sub(1,2,3),undef,"Is still empty");
@test = empty_sub();
is(scalar(@test), 0, 'Didnt return anything');
@test = empty_sub(1,2,3);
is(scalar(@test), 0, 'Didnt return anything');
# RT #63790: calling PL_sv_yes as a sub is special-cased to silently
# return (so Foo->import() silently fails if import() doesn't exist),
# But make sure it correctly pops the stack and mark stack before returning.
{
my @a;
push @a, 4, 5, main->import(6,7);
ok(eq_array(\@a, [4,5]), "import with args");
@a = ();
push @a, 14, 15, main->import;
ok(eq_array(\@a, [14,15]), "import without args");
my $x = 1;
@a = ();
push @a, 24, 25, &{$x == $x}(26,27);
ok(eq_array(\@a, [24,25]), "yes with args");
@a = ();
push @a, 34, 35, &{$x == $x};
ok(eq_array(\@a, [34,35]), "yes without args");
}
# [perl #81944] return should always copy
{
$foo{bar} = 7;
for my $x ($foo{bar}) {
# Pity test.pl doesnt have isn't.
isnt \sub { delete $foo{bar} }->(), \$x,
'result of delete(helem) is copied when returned';
}
$foo{bar} = 7;
for my $x ($foo{bar}) {
isnt \sub { return delete $foo{bar} }->(), \$x,
'result of delete(helem) is copied when explicitly returned';
}
my $x;
isnt \sub { delete $_[0] }->($x), \$x,
'result of delete(aelem) is copied when returned';
isnt \sub { return delete $_[0] }->($x), \$x,
'result of delete(aelem) is copied when explicitly returned';
isnt \sub { ()=\@_; shift }->($x), \$x,
'result of shift is copied when returned';
isnt \sub { ()=\@_; return shift }->($x), \$x,
'result of shift is copied when explicitly returned';
}
fresh_perl_is
<<'end', "main::foo\n", {}, 'sub redefinition sets CvGV';
*foo = \&baz;
*bar = *foo;
eval 'sub bar { print +(caller 0)[3], "\n" }';
bar();
end
fresh_perl_is
<<'end', "main::foo\nok\n", {}, 'no double free redefining anon stub';
my $sub = sub { 4 };
*foo = $sub;
*bar = *foo;
undef &$sub;
eval 'sub bar { print +(caller 0)[3], "\n" }';
&$sub;
undef *foo;
undef *bar;
print "ok\n";
end
# The outer call sets the scalar returned by ${\""}.${\""} to the current
# package name.
# The inner call sets it to "road".
# Each call records the value twice, the outer call surrounding the inner
# call. In 5.10-5.18 under ithreads, what gets pushed is
# qw(main road road road) because the inner call is clobbering the same
# scalar. If __PACKAGE__ is changed to "main", it works, the last element
# becoming "main".
my @scratch;
sub a {
for (${\""}.${\""}) {
$_ = $_[0];
push @scratch, $_;
a("road",1) unless $_[1];
push @scratch, $_;
}
}
a(__PACKAGE__);
require Config;
$::TODO = "not fixed yet" if $Config::Config{useithreads};
is "@scratch", "main road road main",
'recursive calls do not share shared-hash-key TARGs';
|
