(perl #133708) remove build-time probing for stack limits for Storable
[perl.git] / dist / Storable / stacksize
1 #!/usr/bin/perl
2 # binary search maximum stack depth for arrays and hashes
3 # and report it to stdout as code to set the limits
4
5 use Config;
6 use Cwd;
7 use File::Spec;
8 use strict;
9
10 my $ptrsize = $Config{ptrsize};
11 my ($bad1, $bad2) = (65001, 25000);
12 sub QUIET () {
13     (defined $ENV{MAKEFLAGS} and $ENV{MAKEFLAGS} =~ /\b(s|silent|quiet)\b/
14      and !defined($ENV{TRAVIS})) || @ARGV && $ARGV[0] eq "-q"
15       ? 1 : 0
16 }
17 sub PARALLEL () {
18     if (defined $ENV{MAKEFLAGS}
19         and $ENV{MAKEFLAGS} =~ /\bj\s*(\d+)\b/
20         and $1 > 1) {
21         return 1;
22     } else {
23         return 0;
24     }
25 }
26 sub is_miniperl {
27     return !defined &DynaLoader::boot_DynaLoader;
28 }
29
30 if (is_miniperl()) {
31     die "Should not run using miniperl\n";
32 }
33 my $prefix = "";
34 if ($^O eq "MSWin32") {
35     # prevent Windows popping up a dialog each time we overflow
36     # the stack
37     require Win32API::File;
38     Win32API::File->import(qw(SetErrorMode SEM_NOGPFAULTERRORBOX SEM_FAILCRITICALERRORS));
39     SetErrorMode(SEM_NOGPFAULTERRORBOX() | SEM_FAILCRITICALERRORS());
40 }
41 # the ; here is to ensure system() passes this to the shell
42 elsif (system("ulimit -c 0 ;") == 0) {
43     # try to prevent core dumps
44     $prefix = "ulimit -c 0 ; ";
45 }
46 my $PERL = $^X;
47 if ($^O eq "MSWin32") {
48     require Win32;
49     my ($str, $major, $minor) = Win32::GetOSVersion();
50     if ($major < 6 || $major == 6 && $minor < 1) {
51         print "# Using defaults for older Win32\n";
52         write_limits(500, 256);
53         exit;
54     }
55 }
56 my ($n, $good, $bad, $found) =
57     (65000, 100, $bad1, undef);
58 print "# probe for max. stack sizes...\n" unless QUIET;
59 # -I. since we're run before pm_to_blib (which is going to copy the
60 # file we create) and need to load our Storable.pm, not the already
61 # installed Storable.pm
62 my $mblib = '';
63 if (-d 'blib') {
64     $mblib = '-Mblib -I.';
65 }
66 elsif (-f "Configure") {
67     $mblib = '-Ilib';
68 }
69
70 sub cmd {
71     my ($i, $try, $limit_name) = @_;
72     die unless $i;
73     my $code = "my \$t; \$Storable::$limit_name = -1; $try for 1..$i;dclone(\$t); print qq/ok\n/";
74     my $q = ($^O eq 'MSWin32') ? '"' : "'";
75
76     "$prefix $PERL $mblib -MStorable=dclone -e$q$code$q"
77 }
78 # try more
79 sub good {
80     my $i = shift; # this passed
81     my $j = $i + abs(int(($bad - $i) / 2));
82     print "# Storable: determining recursion limit: $i passed, try more $j ...\n" unless QUIET;
83     $good = $i;
84     if ($j <= $i) {
85         $found++;
86     }
87     return $j;
88 }
89 # try less
90 sub bad {
91     my $i = shift; # this failed
92     my $j = $i - abs(int(($i - $good) / 2));
93     print "# Storable: determining recursion limit: $i too big, try less $j ...\n" unless QUIET;
94     $bad = $i;
95     if ($j >= $i) {
96         $j = $good;
97         $found++;
98     }
99     return $j;
100 }
101
102 sub array_cmd {
103     my $depth = shift;
104     return cmd($depth, '$t=[$t]', 'recursion_limit');
105 }
106
107 # first check we can successfully run with a minimum level
108 my $cmd = array_cmd(1);
109 unless ((my $output = `$cmd`) =~ /\bok\b/) {
110     die "Cannot run probe: '$output', aborting...\n";
111 }
112
113 unless ($ENV{STORABLE_NOISY}) {
114     # suppress Segmentation fault messages
115     open STDERR, ">", File::Spec->devnull;
116 }
117
118 while (!$found) {
119     my $cmd = array_cmd($n);
120     #print "$cmd\n" unless $QUIET;
121     if (`$cmd` =~ /\bok\b/) {
122         $n = good($n);
123     } else {
124         $n = bad($n);
125     }
126 }
127 print "# MAX_DEPTH = $n\n" unless QUIET;
128 my $max_depth = $n;
129
130 ($n, $good, $bad, $found) =
131   (int($n/2), 50, $n, undef);
132 # pack j only since 5.8
133 my $max = ($] > 5.007 and length(pack "j", 0) < 8)
134   ? ($^O eq 'MSWin32' ? 3000 : 8000)
135   : $max_depth;
136 $n = $max if $n > $max;
137 $bad = $max if $bad > $max;
138 while (!$found) {
139     my $cmd = cmd($n, '$t={1=>$t}', 'recursion_limit_hash');
140     #print "$cmd\n" unless $QUIET;
141     if (`$cmd` =~ /\bok\b/) {
142         $n = good($n);
143     } else {
144         $n = bad($n);
145     }
146 }
147 if ($max_depth == $bad1-1
148     and $n == $bad2-1)
149 {
150     # more likely the shell. travis docker ubuntu, mingw e.g.
151     print "# Apparently your system(SHELLSTRING) cannot catch stack overflows\n"
152       unless QUIET;
153     $max_depth = 512;
154     $n = 256;
155     print "MAX_DEPTH = $max_depth\n" unless QUIET;
156 }
157 print "# MAX_DEPTH_HASH = $n\n" unless QUIET;
158 my $max_depth_hash = $n;
159
160 # Previously this calculation was done in the macro, calculate it here
161 # instead so a user setting of either variable more closely matches
162 # the limits the use sees.
163
164 # be fairly aggressive in trimming this, smoke testing showed several
165 # several apparently random failures here, eg. working in one
166 # configuration, but not in a very similar configuration.
167 $max_depth = int(0.6 * $max_depth);
168 $max_depth_hash = int(0.6 * $max_depth_hash);
169
170 my $stack_reserve = $^O eq "MSWin32" ? 32 : 16;
171 if ($] ge "5.016" && !($^O eq "cygwin" && $ptrsize == 8)) {
172     $max_depth -= $stack_reserve;
173     $max_depth_hash -= $stack_reserve;
174 }
175 else {
176     # within the exception we need another stack depth to recursively
177     # cleanup the hash
178     $max_depth = ($max_depth >> 1) - $stack_reserve;
179     $max_depth_hash = ($max_depth_hash >> 1) - $stack_reserve * 2;
180 }
181
182 write_limits($max_depth, $max_depth_hash);
183
184 sub write_limits {
185     my ($max_depth, $max_depth_hash) = @_;
186     print <<EOS;
187 # bisected by stacksize
188 \$Storable::recursion_limit = $max_depth
189   unless defined \$Storable::recursion_limit;
190 \$Storable::recursion_limit_hash = $max_depth_hash
191   unless defined \$Storable::recursion_limit_hash;
192 EOS
193 }