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