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
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
|
#!/usr/bin/perl
# binary search maximum stack depth for arrays and hashes
# and report it to stdout as code to set the limits
use Config;
use Cwd;
use File::Spec;
use strict;
my $ptrsize = $Config{ptrsize};
my ($bad1, $bad2) = (65001, 25000);
sub QUIET () {
(defined $ENV{MAKEFLAGS} and $ENV{MAKEFLAGS} =~ /\b(s|silent|quiet)\b/
and !defined($ENV{TRAVIS})) || @ARGV && $ARGV[0] eq "-q"
? 1 : 0
}
sub PARALLEL () {
if (defined $ENV{MAKEFLAGS}
and $ENV{MAKEFLAGS} =~ /\bj\s*(\d+)\b/
and $1 > 1) {
return 1;
} else {
return 0;
}
}
sub is_miniperl {
return !defined &DynaLoader::boot_DynaLoader;
}
if (is_miniperl()) {
die "Should not run using miniperl\n";
}
my $prefix = "";
if ($^O eq "MSWin32") {
# prevent Windows popping up a dialog each time we overflow
# the stack
require Win32API::File;
Win32API::File->import(qw(SetErrorMode SEM_NOGPFAULTERRORBOX SEM_FAILCRITICALERRORS));
SetErrorMode(SEM_NOGPFAULTERRORBOX() | SEM_FAILCRITICALERRORS());
}
# the ; here is to ensure system() passes this to the shell
elsif (system("ulimit -c 0 ;") == 0) {
# try to prevent core dumps
$prefix = "ulimit -c 0 ; ";
}
my $PERL = $^X;
if ($^O eq "MSWin32") {
require Win32;
my ($str, $major, $minor) = Win32::GetOSVersion();
if ($major < 6 || $major == 6 && $minor < 1) {
print "# Using defaults for older Win32\n";
write_limits(500, 256);
exit;
}
}
my ($n, $good, $bad, $found) =
(65000, 100, $bad1, undef);
print "# probe for max. stack sizes...\n" unless QUIET;
# -I. since we're run before pm_to_blib (which is going to copy the
# file we create) and need to load our Storable.pm, not the already
# installed Storable.pm
my $mblib = '';
if (-d 'blib') {
$mblib = '-Mblib -I.';
}
elsif (-f "Configure") {
$mblib = '-Ilib';
}
sub cmd {
my ($i, $try, $limit_name) = @_;
die unless $i;
my $code = "my \$t; \$Storable::$limit_name = -1; $try for 1..$i;dclone(\$t); print qq/ok\n/";
my $q = ($^O eq 'MSWin32') ? '"' : "'";
"$prefix $PERL $mblib -MStorable=dclone -e$q$code$q"
}
# try more
sub good {
my $i = shift; # this passed
my $j = $i + abs(int(($bad - $i) / 2));
print "# Storable: determining recursion limit: $i passed, try more $j ...\n" unless QUIET;
$good = $i;
if ($j <= $i) {
$found++;
}
return $j;
}
# try less
sub bad {
my $i = shift; # this failed
my $j = $i - abs(int(($i - $good) / 2));
print "# Storable: determining recursion limit: $i too big, try less $j ...\n" unless QUIET;
$bad = $i;
if ($j >= $i) {
$j = $good;
$found++;
}
return $j;
}
sub array_cmd {
my $depth = shift;
return cmd($depth, '$t=[$t]', 'recursion_limit');
}
# first check we can successfully run with a minimum level
my $cmd = array_cmd(1);
unless ((my $output = `$cmd`) =~ /\bok\b/) {
die "Cannot run probe: '$output', aborting...\n";
}
unless ($ENV{STORABLE_NOISY}) {
# suppress Segmentation fault messages
open STDERR, ">", File::Spec->devnull;
}
while (!$found) {
my $cmd = array_cmd($n);
#print "$cmd\n" unless $QUIET;
if (`$cmd` =~ /\bok\b/) {
$n = good($n);
} else {
$n = bad($n);
}
}
print "# MAX_DEPTH = $n\n" unless QUIET;
my $max_depth = $n;
($n, $good, $bad, $found) =
(int($n/2), 50, $n, undef);
# pack j only since 5.8
my $max = ($] > 5.007 and length(pack "j", 0) < 8)
? ($^O eq 'MSWin32' ? 3000 : 8000)
: $max_depth;
$n = $max if $n > $max;
$bad = $max if $bad > $max;
while (!$found) {
my $cmd = cmd($n, '$t={1=>$t}', 'recursion_limit_hash');
#print "$cmd\n" unless $QUIET;
if (`$cmd` =~ /\bok\b/) {
$n = good($n);
} else {
$n = bad($n);
}
}
if ($max_depth == $bad1-1
and $n == $bad2-1)
{
# more likely the shell. travis docker ubuntu, mingw e.g.
print "# Apparently your system(SHELLSTRING) cannot catch stack overflows\n"
unless QUIET;
$max_depth = 512;
$n = 256;
print "MAX_DEPTH = $max_depth\n" unless QUIET;
}
print "# MAX_DEPTH_HASH = $n\n" unless QUIET;
my $max_depth_hash = $n;
# Previously this calculation was done in the macro, calculate it here
# instead so a user setting of either variable more closely matches
# the limits the use sees.
# be fairly aggressive in trimming this, smoke testing showed
# several apparently random failures here, eg. working in one
# configuration, but not in a very similar configuration.
$max_depth = int(0.6 * $max_depth);
$max_depth_hash = int(0.6 * $max_depth_hash);
my $stack_reserve = $^O eq "MSWin32" ? 32 : 16;
if ($] ge "5.016" && !($^O eq "cygwin" && $ptrsize == 8)) {
$max_depth -= $stack_reserve;
$max_depth_hash -= $stack_reserve;
}
else {
# within the exception we need another stack depth to recursively
# cleanup the hash
$max_depth = ($max_depth >> 1) - $stack_reserve;
$max_depth_hash = ($max_depth_hash >> 1) - $stack_reserve * 2;
}
write_limits($max_depth, $max_depth_hash);
sub write_limits {
my ($max_depth, $max_depth_hash) = @_;
print <<EOS;
# bisected by stacksize
\$Storable::recursion_limit = $max_depth
unless defined \$Storable::recursion_limit;
\$Storable::recursion_limit_hash = $max_depth_hash
unless defined \$Storable::recursion_limit_hash;
EOS
}
|
