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 }