#! /usr/bin/perl
eval '(exit $?0)' && eval 'exec perl -w -S $0 ${1+"$@"}'
    & eval 'exec perl -w -S $0 $argv:q'
    if 0;

# ******************************************************************
#      Author: Chad Elliott
#        Date: 9/13/2007
# Description: Generate a base project based on a library project
# ******************************************************************

# ******************************************************************
# Pragma Section
# ******************************************************************

use strict;
use FindBin;
use FileHandle;
use File::Spec;
use File::Basename;

my $basePath = $FindBin::Bin;
if ($^O eq 'VMS') {
  $basePath = File::Spec->rel2abs(dirname($0)) if ($basePath eq '');
    $basePath = VMS::Filespec::unixify($basePath);
}
unshift(@INC, $basePath . '/modules');

require Creator;

# ******************************************************************
# Data Section
# ******************************************************************

my $version = '0.1';

# ******************************************************************
# Subroutine Section
# ******************************************************************

sub gather_info {
  my $name = shift;
  my $fh = new FileHandle();

  if (open($fh, $name)) {
    my @lines = ();
    my $pname = undef;
    while(<$fh>) {
      ## Get the line a remove leading and trailing white space
      my $line = $_;
      $line =~ s/^\s+//;
      $line =~ s/\s+$//;

      ## Look for the project declaration and pull out the name and any
      ## parents.
      if ($line =~ /^project\s*(\(([^\)]+)\))?\s*(:.+)?\s*{$/) {
        $pname = $2;
        my $parents = $3 || '';

        ## Create the default project name by removing the extension and
        ## converting back-slashes, spaces and dashes to underscores.
        ## This needs to be done regardless of whether the project name
        ## was provided or not since it's used below in the
        ## fill_type_name call.
        my $def = basename($name);
        $def =~ s/\.[^\.]+$//;
        $def =~ s/\\/_/g;
        $def =~ s/[\s\-]/_/g;

        if (!defined $pname || $pname eq '') {
          ## Take the default project name since one wasn't provided.
          $pname = $def;
        }
        else {
          ## Convert back-slashes, spaces and dashes to underscores.
          $pname =~ s/\\/_/g;
          $pname =~ s/[\s\-]/_/g;
        }

        ## If the project has a '*' we need to have MPC fix that up for
        ## us.
        $pname = Creator::fill_type_name(undef, $pname, $def);
        push(@lines, "project$parents {");
      }
      elsif ($line =~ /^(shared|static)name\s*=\s*(.+)$/) {
        ## Add in the libs and after settings.
        my $lib = $2;
        if (defined $pname && $lib ne '') {
          push(@lines, "  libs  += $2",
                       "  after += $pname",
                       "}");
        }
        last;
      }
    }
    close($fh);

    ## Only return the lines if there is more than one line.  It is
    ## possible (and likely) that we've read in the project declaration,
    ## but the project did not contain a sharedname or staticname
    ## setting.
    return @lines if ($#lines > 0);
  }

  return ();
}

sub write_base {
  my($in, $out) = @_;
  my @lines = gather_info($in);

  if ($#lines >= 0) {
    if (-r $out) {
      print STDERR "ERROR: $out already exists\n";
    }
    else {
      my $fh = new FileHandle();
      if (open($fh, ">$out")) {
        foreach my $line (@lines) {
          print $fh "$line\n";
        }
        close($fh);

        ## Everything was ok, return zero.
        return 0;
      }
      else {
        print STDERR "ERROR: Unable to write to $out\n";
      }
    }
  }
  else {
    if (-r $in) {
      print STDERR "ERROR: $in is not a valid MPC file\n";
    }
    else {
      print STDERR "ERROR: Unable to read from $in\n";
    }
  }

  ## Non-zero indicates an error (as in the shell $? value).
  return 1;
}

sub usageAndExit {
  my $str = shift;
  print STDERR "$str\n" if (defined $str);
  print STDERR "Create Base Project v$version\n",
               "Usage: ", basename($0), " <mpc files> <output file or ",
               "directory>\n\nThis script will create a base project ",
               "based on the contents of the\nsupplied MPC file.  ",
               "This is only useful if the project ",
               "explictly sets\nsharedname or staticname.\n";
  exit(0);
}

# ******************************************************************
# Main Section
# ******************************************************************

if ($#ARGV > 1) {
  ## Get the last argument and make sure it's a directory.
  my $dir = pop(@ARGV);
  if (!-d $dir) {
    usageAndExit("Creating multiple base projects, but the " .
                 "last argument, $dir, is not a directory");
  }

  ## Process each input file and create the base project with an implicit
  ## base project file name.
  my $status = 0;
  foreach my $input (@ARGV) {
    my $output = $dir . '/' . lc(basename($input));
    $output =~ s/mpc$/mpb/;
    $status += write_base($input, $output);
  }
  exit($status);
}
else {
  my $input  = shift;
  my $output = shift;

  ## Print the usage and exit if there is no input, output or the input
  ## file looks like an option.
  usageAndExit() if (!defined $output ||
                     !defined $input  || index($input, '-') == 0);

  ## If the output file is a directory, we will create the output file
  ## name based on the input file.
  if (-d $output) {
    $output .= '/' . lc(basename($input));
    $output =~ s/mpc$/mpb/;
  }

  ## Create the base project and return the status to the caller of the
  ## script.
  exit(write_base($input, $output));
}


#! /usr/bin/perl
eval '(exit $?0)' && eval 'exec perl -w -S $0 ${1+"$@"}'
    & eval 'exec perl -w -S $0 $argv:q'
    if 0;

# ******************************************************************
#      Author: Chad Elliott
#        Date: 6/17/2002
# ******************************************************************

# ******************************************************************
# Pragma Section
# ******************************************************************

require 5.006;

use strict;
use FindBin;
use File::Spec;
use File::Basename;

## Sometimes $FindBin::RealBin will end up undefined.  If it is, we need
## to use the directory of the built-in script name.  And, for VMS, we
## have to convert that into a UNIX path so that Perl can use it
## internally.
my $basePath = (defined $FindBin::RealBin && $FindBin::RealBin ne '' ?
                  $FindBin::RealBin : File::Spec->rel2abs(dirname($0)));
$basePath = VMS::Filespec::unixify($basePath) if ($^O eq 'VMS');

## Add the full path to the MPC modules to the Perl include path
my $mpcpath = $basePath;
unshift(@INC, $mpcpath . '/modules');

## If the ACE_ROOT environment variable is defined and this version of
## MPC is located inside the directory to which ACE_ROOT points, we will
## assume that the user wanted the ACE specific version of this script.
## We will change the $basePath to what it would have been had the user
## run this script out of $ACE_ROOT/bin.
my $aceroot = $ENV{ACE_ROOT};
$aceroot =~ s!\\!/!g if (defined $aceroot);
$basePath = $aceroot . '/bin/MakeProjectCreator'
               if (defined $aceroot && $aceroot eq dirname($basePath));

require Driver;

# ************************************************************
# Subroutine Section
# ************************************************************

sub getBasePath {
  return $mpcpath;
}

# ************************************************************
# Main Section
# ************************************************************

my $driver = new Driver($basePath, Driver::projects());
exit($driver->run(@ARGV));


#! /usr/bin/perl
eval '(exit $?0)' && eval 'exec perl -w -S $0 ${1+"$@"}'
    & eval 'exec perl -w -S $0 $argv:q'
    if 0;

# ******************************************************************
#      Author: Chad Elliott
#        Date: 6/17/2002
# ******************************************************************

# ******************************************************************
# Pragma Section
# ******************************************************************

require 5.006;

use strict;
use FindBin;
use File::Spec;
use File::Basename;

## Sometimes $FindBin::RealBin will end up undefined.  If it is, we need
## to use the directory of the built-in script name.  And, for VMS, we
## have to convert that into a UNIX path so that Perl can use it
## internally.
my $basePath = (defined $FindBin::RealBin && $FindBin::RealBin ne '' ?
                  $FindBin::RealBin : File::Spec->rel2abs(dirname($0)));
$basePath = VMS::Filespec::unixify($basePath) if ($^O eq 'VMS');

## Add the full path to the MPC modules to the Perl include path
my $mpcpath = $basePath;
unshift(@INC, $mpcpath . '/modules');

# Has to be a require because it's in the modules directory.
require mpc_debug;

## If the ACE_ROOT environment variable is defined and this version of
## MPC is located inside the directory to which ACE_ROOT points, we will
## assume that the user wanted the ACE specific version of this script.
## We will change the $basePath to what it would have been had the user
## run this script out of $ACE_ROOT/bin.
my $aceroot = $ENV{ACE_ROOT};
$aceroot =~ s!\\!/!g if (defined $aceroot);
$basePath = $aceroot . '/bin/MakeProjectCreator'
               if (defined $aceroot && $aceroot eq dirname($basePath));

require Driver;

# ************************************************************
# Subroutine Section
# ************************************************************

sub getBasePath {
  return $mpcpath;
}

# ************************************************************
# Main Section
# ************************************************************

my $driver = new Driver($basePath, Driver::workspaces());
exit($driver->run(@ARGV));


#! /usr/bin/perl
eval '(exit $?0)' && eval 'exec perl -w -S $0 ${1+"$@"}'
    & eval 'exec perl -w -S $0 $argv:q'
    if 0;

# ******************************************************************
#      Author: Chad Elliott
#        Date: 7/12/2006
# ******************************************************************

# ******************************************************************
# Pragma Section
# ******************************************************************

use strict;
use FileHandle;
use FindBin;
use File::Spec;
use File::Basename;

my $basePath = $FindBin::Bin;
if ($^O eq 'VMS') {
  $basePath = File::Spec->rel2abs(dirname($0)) if ($basePath eq '');
  $basePath = VMS::Filespec::unixify($basePath);
}
$basePath = dirname($basePath);
unshift(@INC, $basePath . '/modules');

require ProjectCreator;
require TemplateParser;
require ConfigParser;
require StringProcessor;

# ******************************************************************
# Data Section
# ******************************************************************

my %keywords;
my %arrow_op;
my $doc_ext  = '.txt';
my $version  = '1.4';

# ******************************************************************
# Subroutine Section
# ******************************************************************

sub setup_keywords {
  my $language = shift;

  ## Get the main MPC keywords
  my $keywords = ProjectCreator::getKeywords();
  foreach my $key (keys %$keywords) {
    $keywords{$key} = 1;
  }

  ## Get the MPC valid components
  $keywords = ProjectCreator::getValidComponents($language);
  foreach my $key (keys %$keywords) {
    $keywords{lc($key)} = 1;
  }

  ## Get the pseudo template variables
  my $pjc = new ProjectCreator();
  $keywords = $pjc->get_command_subs();
  foreach my $key (keys %$keywords) {
    $keywords{$key} = 1;
  }

  ## Get the template function names
  $keywords = TemplateParser::getKeywords();
  foreach my $key (keys %$keywords) {
    $keywords{$key} = 1;
  }

  ## Get the template parser arrow operator keys
  $keywords = TemplateParser::getArrowOp();
  foreach my $key (keys %$keywords) {
    $arrow_op{$key} = 1;
  }
}

sub display_template {
  my($fh, $common_cp, $template_cp, $input, $tkeys, $oformat) = @_;

  my $html = ($oformat eq 'html') ? 1 : 0;

  if ($html) {
    print $fh '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">', "\n",
            "\n",
            "  <title>$input</title>\n",
            "  \n",
            "\n",
            "\n",
            "
$input
\n",
            "
\n",
            "
\n",
            "      Template Variable	\n",
            "      Default Value	\n",
            "      Description	\n",
            "
\n";
  }
  else {
    print $fh "//\n// Document template variables for templates $input.\n// Please try to keep this alphabetically sorted.\n//\n";
  }

  foreach my $key (sort keys %$tkeys) {
    # For text output, we only want to dump out the variables that are only
    # specific to the template being documented and not the common variables.
    # So, we check to see if the key has a value in the common config and, if
    # it does, skip.  We can't check to see if it has a value in the template
    # config because this script may be the thing that's creating the stub
    # for that template.
    next if (!$html && $common_cp->get_value($key));

    my $desc = '';
    if ($html) {
      $desc = $template_cp->get_value($key) || $common_cp->get_value($key) || ' ';
    }
    else {
      $desc = $common_cp->get_value($key) || '<none>';
    }

    my $def;
    if (defined $$tkeys{$key}) {
      foreach my $ikey (sort keys %{$$tkeys{$key}}) {
        if (defined $def) {
          $def .= $html ? ' or ' : ' OR ';
        }
        else {
          $def = '';
        }
        $def .= StringProcessor::process_special(undef, $ikey);
      }
    }

    ## Convert < and > to html friendly codes
    if ($html) {
      $desc =~ s/</</g;
      $desc =~ s/>/>/g;
    }

    if ($html) {
      print $fh "
\n",
              "      $key	\n",
              "      ", (defined $def ? $def : '&nbsp'), "	\n",
              "      $desc	\n",
              "
\n";
    }
    else {
      print $fh "$key = $desc\n";
    }
  }
  print $fh "
\n\n" if ($html);
}

sub usageAndExit {
  print "document_template.pl v$version\n",
        "Usage: ", basename($0), " <template> [<outputfile> [language]]\n\n",
        "template    - .mpd file to document.  Certain MPC types don't use a template,\n",
        "              in that case this argument can be the Perl module.\n",
        "outputfile  - This defaults to the name of the template file with the .mpd\n",
        "              extension replaced with '.html'  If <outputfile> ends in '.txt',\n",
        "              the output is in text format similar to what is found in\n",
        "              .../docs/templates.\n",
        "language    - This defaults to the language for which the template is designed.\n",
        "              It can be any of the valid language settings for MPC:\n",
        "              ", join(' ', sort(Creator::validLanguages())), "\n";
  exit(0);
}

# ******************************************************************
# Main Section
# ******************************************************************

my $status   = 0;
my $fh       = new FileHandle();
my $input    = $ARGV[0];
my $output   = $ARGV[1];
my $language = $ARGV[2];
my $oformat  = 'html'; # dump out html by default

usageAndExit() if (!defined $input || $input =~ /^-/);

if (!defined $output) {
  $output = $input;
  $output =~ s/\.mpd$//;
  $output =~ s/(\w+)(Project|Workspace)Creator\.pm$/lc $1/e;
  $output .= '.html';
}
elsif ($output =~ /\.txt$/) {
  $oformat = 'txt';
}

if (open($fh, $input)) {
  if (!defined $language) {
    if (index($input, 'vb') != -1) {
      $language = Creator::vb();
    }
    elsif (index($input, 'csharp') != -1 || index($input, '.net') != -1) {
      $language = Creator::csharp();
    }
    elsif (index($input, 'java') != -1) {
      $language = Creator::java();
    }
    else {
      $language = Creator::cplusplus();
    }
  }

  my %template_keys;
  my @foreach;
  my $findex  = -1;

  my $inputIsPerl = ($input =~ /\.pm$/);
  my ($startPattern, $endPattern);
  if ($inputIsPerl) {
    my $pkg = basename($input);
    $pkg =~ s/\.pm$//e;
    require $input;
    ($startPattern, $endPattern) = $pkg->documentation_info(\%keywords);
  }
  else {
    setup_keywords($language);
  }
  my $skip = $inputIsPerl;

  while(<$fh>) {
    if ($inputIsPerl) {
      $skip = 0 if ($skip && /$startPattern/);
      $skip = 1 if (!$skip && /$endPattern/);
      next if $skip;
    }

    my $len = length($_);
    for(my $start = 0; $start < $len;) {
      my $sindex = index($_, '<%', $start);
      if ($sindex >= 0) {
        my $eindex = index($_, '%>', $sindex);
        if ($eindex >= $sindex) {
          $eindex += 2;
        }
        else {
          $eindex = $len;
        }

        my $part  = substr($_, $sindex, $eindex - $sindex);
        my $key   = substr($part, 2, length($part) - 4);
        my $name  = lc($key);
        my $tvar;
        my $def;
        if ($key =~ /^([^\(]+)\((.*)\)/) {
          $name = lc($1);
          my $vname = $2;

          if (defined $keywords{$name}) {
            $tvar = 1;
            if ($name eq 'foreach') {
              ++$findex;

              ## Remove the functions inside the foreach
              foreach my $keyword (keys %keywords) {
                $vname =~ s/$keyword\(([^\)]+)\)/$1/gi;
              }

              my $remove_s = 1;
              if ($vname =~ /([^,]*),(.*)/) {
                my $n = $1;
                my $v = $2;
                $n =~ s/^\s+//;
                $n =~ s/\s+$//;
                $v =~ s/^\s+//;
                $v =~ s/\s+$//;

                if ($n =~ /^\d+$/) {
                  $n = $v;
                }
                else {
                  $remove_s = undef;
                }
                $vname = $n;
              }

              $name = lc($vname);

              $key = lc($vname);
              $vname =~ s/\s.*//;
              $vname =~ s/s$// if ($remove_s);

              $foreach[$findex] = lc($vname);
              $tvar = undef;
            }
            elsif ($name eq 'if') {
              $vname =~ s/(!|&&|\|\|)//g;

              ## Keep pulling off keyword functions until we get down to
              ## the actual template variable used in the function call.
              my $retry;
              do {
                $retry = undef;
                foreach my $keyword (keys %keywords) {
                  if ($vname =~ s/$keyword\((.*)[\)]?/$1/g) {
                    $retry = 1 if ($vname ne '');
                    last;
                  }
                }
              } while($retry);
              $vname =~ s/\s*,.*//;
              $vname =~ s/\)//g;

              if ($vname !~ /^\s*$/) {
                $name = lc($vname);
                $key  = lc($vname);
                $tvar = undef;
              }
            }
            elsif (UNIVERSAL::isa($keywords{$name}, 'CODE')) {
              ($name, $key, $vname, $tvar) = &{$keywords{$name}}($vname);
            }
          }
          else {
            $def = $2;
          }
        }
        else {
          $key = lc($key);
        }

        my $otvar = $tvar;
        foreach my $k (split(/\s+/, $key)) {
          $tvar = $otvar;
          if (defined $keywords{$k}) {
            $tvar = 1;
            if ($k eq 'endfor') {
              $foreach[$findex] = undef;
              --$findex;
            }
          }
          else {
            if ($k =~ /^\w+\->/) {
              $tvar = 1;
            }
            else {
              foreach my $ao (keys %arrow_op) {
                if ($k =~ /^$ao/) {
                  $tvar = 1;
                  last;
                }
              }
            }
          }

          if (!$tvar) {
            for(my $index = 0; $index <= $findex; $index++) {
              if ($foreach[$index] eq $k) {
                $tvar = 1;
                last;
              }
            }
          }

          if (!$tvar) {
            foreach my $n (split(/\s+/, $name)) {
              $tvar = undef;
              if (defined $keywords{$n}) {
              }
              else {
                if ($n =~ /^\w+\->/) {
                  $tvar = 1;
                }
                else {
                  foreach my $ao (keys %arrow_op) {
                    if ($n =~ /^$ao/) {
                      $tvar = 1;
                      last;
                    }
                  }
                }
                if (!$tvar) {
                  if (defined $template_keys{$n}) {
                    if (defined $def) {
                      $template_keys{$n}->{$def} = 1;
                    }
                  }
                  else {
                    $template_keys{$n} = {};
                    $template_keys{$n}->{$def} = 1 if (defined $def);
                  }
                }
              }
            }
          }
        }
        $start = $eindex;
      }
      else {
        $start += ($len - $start);
      }
    }
  }
  close($fh);

  my $common_cp = new ConfigParser();
  my $template_cp = new ConfigParser();
  $common_cp->read_file("$basePath/docs/templates/common$doc_ext");

  my $doc = $input;
  $doc =~ s/\.[^\.]+$/$doc_ext/;
  if ($inputIsPerl) {
    $doc =~ s/modules/docs\/templates/;
    $doc =~ s/(\w+)(Project|Workspace)Creator$doc_ext$/lc($1) . $doc_ext/e;
  }
  else {
    $doc =~ s/templates/docs\/templates/;
  }

  if (-r $doc) {
    $template_cp->read_file($doc);
  }
  else {
    $template_cp->read_file("$basePath/docs/templates/" . basename($doc));
  }

  if (open($fh, ">$output")) {
    display_template($fh, $common_cp, $template_cp, $input, \%template_keys, $oformat);
    close($fh);
  }
  else {
    print STDERR "ERROR: Unable to open $output for writing\n";
    ++$status;
  }
}
else {
  print STDERR "ERROR: Unable to open $input for reading\n";
  ++$status;
}

exit($status);


eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}'
     & eval 'exec perl -S $0 $argv:q'
     if 0;

# -*- perl -*-

use lib "$ENV{ACE_ROOT}/bin";
use PerlACE::Run_Test;

$SV = new PerlACE::Process ("server");
$CL = new PerlACE::Process ("client", "-i 10000 -h localhost");

$status = 0;

$SV->Spawn ();

sleep 5;

$client = $CL->SpawnWaitKill (60);

$server = $SV->WaitKill (5);

if ($server != 0) {
    print "ERROR: server returned $server\n";
    $status = 1;
}

if ($client != 0) {
    print "ERROR: client returned $client\n";
    $status = 1;
}

exit $status;


eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}'
    & eval 'exec perl -S $0 $argv:q'
    if 0;

use warnings;
use strict;

use lib "$ENV{ACE_ROOT}/bin";
use PerlACE::Run_Test;
use Getopt::Long;
use Pod::Usage;

#### Program Documentation ####

=head1 NAME

run_spectrum.pl - Run a spectrum of performance tests.

=head1 SYNOPSIS

 run_spectrum.pl [ --help ]
                 [ --manual ]
                 [ --service (STREAM|SEQPACK) ]
                 [ --protocol (TCP|SCTP) ]
                 [ --config_file filename ]

=head1 OPTIONS

=over 8

=item B<--help, -h>

Print this help message and exit.

=item B<--manual, -m>

Print full documentation and exit.

=item B<--service, -s> (STREAM|SEQPACK)

Select SOCK_STREAM or SOCK_SEQPACK service respectively.  The default
is SOCK_STREAM.

=item B<--protocol, -p> (TCP|SCTP)

Select TCP or SCTP transport protocol.  The default is TCP.  Note that
TCP cannot be used together with the SEQPACK service.

=item B<--config_file, -c> filename

Read configuration parameters from the nominated file.  By default,
parameters are read from C<run_spectrum.config> in the current
directory.

=back

=head1 DESCRIPTION

This directory contains performance tests for measuring round-trip
latency statistics of ACE synchronous messaging using unmarshalled
ACE_CDR::Octet.

The SOCK_STREAM performance test comprises SOCK_STREAM_clt on the
client side and SOCK_STREAM_srv on the server side.  The SOCK_SEQPACK
performance test comprises SOCK_SEQPACK_clt on the client side and
SOCK_SEQPACK_srv on the server side.

People who are interested in round-trip latency often want to see a
I<spectrum> of statistics for a range of payload sizes.  The job of
this script, B<run_spectrum.pl>, is to run the client-side
performance-test program repeatedly, so as to generate a spectrum of
statistics.

The script supports two types of services (SOCK_STREAM and
SOCK_SEQPACK) and two protocols (TCP and UDP).  All combinations are
valid except TCP over SOCK_SEQPACK.  Please see L<"OPTIONS"> for
information about the command-line options that specify the service
and the protocol.

By default, B<run_spectrum.pl> will execute SOCK_STREAM_clt (or
SOCK_SEQPACK_clt) with a minimal set of command-line options.  You can
specify additional options in an external configuration file.  By
default, the configuration file is called C<run_spectrum.config>.  You
may name an alternate configuration file using the B<--config_file>
option.

The configuration file should contain the options that you would
ordinarly give to SOCK_STREAM_clt or SOCK_SEQPACK_clt on the command
line.  To see the command-line options available for these programs,
please run C<SOCK_STREAM_clt --help> or C<SOCK_SEQPACK_clt --help>.
Note that the options B<-s> and B<-t> are used by this script when it
launches the client.  An occurrence of either of these options in the
configuration file will be ignored as redundant.

The client is executed 15 times: once for each payload size from 2^2
bytes to 2^16 bytes.  (SCTP tests only go up to 2^15 bytes because of
limitations in our SCTP implementation.)  Histograms summarizing the
round-trip latency performance are dumped to a file called
C<TIMESTAMP.spectrum> where C<TIMESTAMP> is the current time in
hyphen-delimited form.

=head1 EXAMPLES

B<Example 1>: Run a spectrum of TCP performance tests using
SOCK_STREAM with both endpoints on the local machine.  Each test in
the spectrum should have 10,000 data points.

=over 4

=item 1.

Start the SOCK_STREAM server on the local machine with the S<C<-t
tcp>> option:

    % ./SOCK_STREAM_srv -t tcp

=item 2.

Configure the client to run 10,000 individual trials:

    % echo '"-c 10000"' > run_spectrum.config

=item 3.

Execute B<run_spectrum.pl>:

    % ./run_spectrum.pl

(The script uses TCP and SOCK_STREAM by default.)

=back

B<Example 2>: Run a spectrum of SCTP performance tests using
SOCK_SEQPACK with one endpoint on the local machine and one endpoint
on a remote machine that happens to be named oneida.  Each test in the
spectrum should have 50,000 data points.

=over 4

=item 1.

On the remote host oneida, start the SOCK_SEQPACK server:

    % ./SOCK_SEQPACK_srv

=item 2.

On the local host, configure the client to run 50,000 individual
trials and to look for the server on oneida:

    % echo '"-c 50000 -H oneida"' > run_spectrum.config

=item 3.

On the local host, execute B<run_spectrum.pl>:

    % ./run_spectrum.pl --service SEQPACK --protocol SCTP

=back

=cut

# Global variable declarations
my $help        = 0;
my $manual      = 0;
my $service     = "stream";
my $protocol    = "tcp";
my $config_file = "run_spectrum.config";
my $options     = "";
my $output_file;

# Map from services to client programs
my %client_programs = (stream  => "SOCK_STREAM_clt",
                       seqpack => "SOCK_SEQPACK_clt");

#### MAIN PROGRAM ####

# Canonicalize arguments to lower-case
tr/A-Z/a-z/ for @ARGV;

# Use Getopt::Long to parse options
GetOptions ("help" => \$help,
            "manual" => \$manual,
            "service=s" => \$service,
            "protocol=s" => \$protocol,
            "config_file=s" => \$config_file
            );

# Show help if requested
pod2usage(1) if $help;

# Show manual if requested
pod2usage(-verbose => 2) if $manual;

# Validate service option
$service =~ s/seqpacket/seqpack/;    # Accept "seqpacket" as synonym for "seqpack"
$service =~ /^(stream|seqpack)$/
    or pod2usage("Service must be STREAM or SEQPACK\n");

$protocol =~ /^(tcp|sctp)$/
    or pod2usage("Protocol must be TCP or SCTP\n");

$service eq "seqpack" and $protocol eq "tcp"
    and pod2usage("Cannot use SEQPACK service with TCP\n");

# Open config file
open CONFIG, "< $config_file"
    or die "cannot open file: $config_file\n";

# Read options from the config file.  The options are defined as the
# first double-quoted string that is not to the right of a pound sign.
# (Pound signs and quotes cannot be escaped.)

while (<CONFIG>) {
    chomp;
    if (/^[^\#]*?\"(.*?)\"/) {
        $options = $1;
        last;
    }
}

# Close config file
close CONFIG;

# Print options
print "Read options from $config_file: \"$options\"\n\n";

# Name a unique file to store the results in.
($output_file = localtime() . ".spectrum") =~ tr/ /-/;

# Run the test for message sizes ranging from 2^2 bytes to 2^16 bytes
# (SCTP tests only go up to 2^15 bytes because of limitations in our
#  SCTP implementation)
my $max_size = 16;
$max_size = 15 if $protocol eq "sctp";
for (my $i = 2; $i <= $max_size; ++$i) {

    # Assemble client parameters and print out the command line
    my $client_params = "-t $protocol -s $i $options >> $output_file";
    print "$client_programs{$service} $client_params\n";

    # Configure client
    my $client =
        new PerlACE::Process($client_programs{$service}, $client_params);

    # Spawn client
    $client->Spawn();

    # Wait for client to finish
    $client->Wait();

    # Remind the client that it's finished running
    $client->{RUNNING} = 0;

    # Sleep for a while
    sleep 5;
}


eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}'
    & eval 'exec perl -S $0 $argv:q'
    if 0;

$EXE = "synch_driver";
$Win32 = 0;
if ($^O eq "MSWin32")
{
    $Win32 = 1;
}

$debug = 0;
$name = "release";
$result_dir = "results";
$svcconf_dir = "svcconf";
$conf_ext = ".conf";

@Null_List = ();

# This is called "baseline"
@Baseline_List = ("base_acquire",
                  "base_tryacquire",
                  "base_acquire_read",
                  "base_tryacquire_read",
                  "base_acquire_write",
                  "base_tryacquire_write");

# this is called "perf_thrno"
@Perf_Thr_Number_List = ("perf_t1",
                         "perf_t2",
                         "perf_t4",
                         "perf_t8",
                         "perf_t16",
                         "perf_t32",
                         "perf_t64");

@Target = @Null_List;

while ( $#ARGV >= 0  &&  $ARGV[0] =~ /^-/ )
{
    if ($ARGV[0] eq '-d')       # Run debug mode
    {
        $name = "debug";
    }
    elsif ($ARGV[0] eq '-p')    # Debug perl script
    {
        $debug = 1;
        print "debug perl scirpt\n";
    }
    elsif ($ARGV[0] eq '-D')    # Subdir name to put the result
    {
        shift;
        $result_dir = $ARGV[0];
    }
    elsif ($ARGV[0] eq '-S')    # Subdir to svc.conf files.
    {
        shift;
        $svcconf_dir = $ARGV[0];
    }
    elsif ($ARGV[0] eq '-N')    # Specify test name.
    {
        shift;
        if ($ARGV[0] eq "baseline")
        {
            @Target = @Baseline_List;
        }
        elsif ($ARGV[0] eq "perf_thrno")
        {
            @Target = @Perf_Thr_Number_List;
        }
        else
        {
            die "Unknown test \"$ARGV[0]\"\n";
        }
    }
    else
    {
        warn "$0:  unknown option $ARGV[0]\n";
        die $usage;
    }
    shift;
}

die "You must specify a test to run\n" if (scalar (@Target) == 0);

if ($Win32 != 0)
{
    $execname = "$name\\$EXE";
    $DIR_SEPARATOR = '\\';
}
else
{
    $execname = "./$EXE";       # Notice that on UNIX, you much build
                                # Debug/Release program explicitly
                                # before running the script.
    $DIR_SEPARATOR = '/';
}

for ($Cntr = 0; $Cntr < scalar (@Target); $Cntr++)
{
    $Redirect_Output = "$result_dir$DIR_SEPARATOR$Target[$Cntr].$name";
    if ($debug != 0)             # Only redirect output in actual run
    {
        print "Redirecting output to $Redirect_Output\n";
    }
    else
    {
        open STDOUT, "> $Redirect_Output";
        open STDERR, ">&STDOUT";
    }

    @args = ("$execname",
             "-f",
             "$svcconf_dir$DIR_SEPARATOR$Target[$Cntr]$conf_ext");

    if ($debug != 0)
    {
        print "Debug mode: Executing -- ";
        for ($args_c = 0; $args_c < scalar (@args); $args_c ++)
        {
            print "$args[$args_c] ";
        }
        print "\n";
    }
    else
    {
        system (@args);
    }
}


eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}'
     & eval 'exec perl -S $0 $argv:q'
     if 0;

# -*- perl -*-

use lib "$ENV{ACE_ROOT}/bin";
use PerlACE::TestTarget;

$SV = new PerlACE::Process ("tcp_test", "-s");
$CL = new PerlACE::Process ("tcp_test", "-c localhost -i 50000 -b 64");

$status = 0;

$SV->Spawn ();

sleep 5;

$client = $CL->SpawnWaitKill (60);

$server = $SV->WaitKill (5);

if ($server != 0) {
    print "ERROR: server returned $server\n";
    $status = 1;
}

if ($client != 0) {
    print "ERROR: client returned $client\n";
    $status = 1;
}

exit $status;


eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}'
     & eval 'exec perl -S $0 $argv:q'
     if 0;

# -*- perl -*-

use lib "$ENV{ACE_ROOT}/bin";
use PerlACE::TestTarget;

$SV = new PerlACE::Process ("udp_test", "-r");
$CL = new PerlACE::Process ("udp_test", "-t -n 10000 localhost");

$status = 0;

$SV->Spawn ();

sleep 5;

$client = $CL->SpawnWaitKill (60);

$server = $SV->WaitKill (5);

if ($server != 0) {
    print "ERROR: server returned $server\n";
    $status = 1;
}

if ($client != 0) {
    print "ERROR: client returned $client\n";
    $status = 1;
}

exit $status;


eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}'
     & eval 'exec perl -S $0 $argv:q'
     if 0;

# -*- perl -*-

use lib "$ENV{ACE_ROOT}/bin";
use PerlACE::TestTarget;

$status = 0;
$synchbase = "ready";
my $target1 = PerlACE::TestTarget::create_target (1) || die "Create target 1 failed\n";
my $target2 = PerlACE::TestTarget::create_target (2) || die "Create target 2 failed\n";
$synchfile = $target1->LocalFile ("$synchbase");
my $port = $target1->RandomPort ();
my $host = $target1->HostName();

print "port = $port\n";

my $SV = $target1->CreateProcess("server", "-p $port -o $synchfile");
my $CL = $target2->CreateProcess ("client", " -h $host -p $port");

$target1->DeleteFile ($synchbase);
$target2->DeleteFile ($synchbase);

$server_status = $SV->Spawn ();

if ($server_status != 0) {
    print STDERR "ERROR: server returned $server_status\n";
    exit 1;
}

if ($target1->WaitForFileTimed ($synchbase,
                                $target1->ProcessStartWaitInterval()) == -1) {
    print STDERR "ERROR: cannot find file <$synchfile>\n";
    $SV->Kill (); $SV->TimedWait (1);
    exit 1;
}

$target1->DeleteFile ($synchbase);

$client = $CL->SpawnWaitKill ($target2->ProcessStartWaitInterval() + 285);

if ($client != 0) {
    print STDERR "ERROR: client returned $client\n";
    $status = 1;
}

$server = $SV->WaitKill ($target1->ProcessStopWaitInterval());

if ($server != 0) {
    print STDERR "ERROR: server returned $server\n";
    $status = 1;
}

$target1->GetStderrLog();
$target2->GetStderrLog();

$target1->DeleteFile ($synchbase);
$target2->DeleteFile ($synchbase);

exit $status;


eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}'
     & eval 'exec perl -S $0 $argv:q'
     if 0;

# -*- perl -*-

use lib "$ENV{ACE_ROOT}/bin";
use PerlACE::TestTarget;

$status = 0;

$synchbase = "ready";
my $target1 = PerlACE::TestTarget::create_target (1) || die "Create target 1 failed\n";
my $target2 = PerlACE::TestTarget::create_target (2) || die "Create target 2 failed\n";
my $host = $target1->HostName();
my $port = $target1->RandomPort ();
$synchfile = $target1->LocalFile ("$synchbase");

my $SV = $target1->CreateProcess("server", "-p $port -o $synchfile");

$target1->DeleteFile ($synchbase);
$target2->DeleteFile ($synchbase);

$server_status = $SV->Spawn ();

if ($server_status != 0) {
    print STDERR "ERROR: server returned $server_status\n";
    exit 1;
}

if ($target1->WaitForFileTimed ($synchbase,
                                $target1->ProcessStartWaitInterval()) == -1) {
    print STDERR "ERROR: cannot find file <$synchfile>\n";
    $SV->Kill (); $SV->TimedWait (1);
    exit 1;
}

$target1->DeleteFile ($synchbase);

my $CL = $target2->CreateProcess ("client", " -h $host -p $port");

$client = $CL->SpawnWaitKill ($target2->ProcessStartWaitInterval() + 285);

if ($client != 0) {
    print STDERR "ERROR: client returned $client\n";
    $status = 1;
}

$server = $SV->WaitKill ($target1->ProcessStopWaitInterval());

if ($server != 0) {
    print STDERR "ERROR: server returned $server\n";
    $status = 1;
}

$target1->GetStderrLog();
$target2->GetStderrLog();

$target1->DeleteFile ($synchbase);
$target2->DeleteFile ($synchbase);

exit $status;


eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}'
     & eval 'exec perl -S $0 $argv:q'
     if 0;

# -*- perl -*-

use lib "$ENV{ACE_ROOT}/bin";
use PerlACE::TestTarget;

$status = 0;

$synchbase = "ready";
my $target1 = PerlACE::TestTarget::create_target (1) || die "Create target 1 failed\n";
my $target2 = PerlACE::TestTarget::create_target (2) || die "Create target 2 failed\n";
$synchfile = $target1->LocalFile ("$synchbase");
my $port = $target1->RandomPort ();
my $host = $target1->HostName();

my $SV = $target1->CreateProcess ("server", "-p $port -o $synchfile");
my $CL = $target2->CreateProcess ("client", " -h $host -p $port");

$target1->DeleteFile ($synchbase);
$target2->DeleteFile ($synchbase);

$server_status = $SV->Spawn ();

if ($server_status != 0) {
    print STDERR "ERROR: server returned $server_status\n";
    exit 1;
}

if ($target1->WaitForFileTimed ($synchbase,
                                $target1->ProcessStartWaitInterval()) == -1) {
    print STDERR "ERROR: cannot find file <$synchfile>\n";
    $SV->Kill (); $SV->TimedWait (1);
    exit 1;
}

$target1->DeleteFile ($synchbase);

$client = $CL->SpawnWaitKill ($target2->ProcessStartWaitInterval() + 285);

if ($client != 0) {
    print STDERR "ERROR: client returned $client\n";
    $status = 1;
}

$server = $SV->WaitKill ($target1->ProcessStopWaitInterval());

if ($server != 0) {
    print STDERR "ERROR: server returned $server\n";
    $status = 1;
}

$target1->GetStderrLog();
$target2->GetStderrLog();

$target1->DeleteFile ($synchbase);
$target2->DeleteFile ($synchbase);

exit $status;


eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}'
     & eval 'exec perl -S $0 $argv:q'
     if 0;

# -*- perl -*-

use lib "$ENV{ACE_ROOT}/bin";
use PerlACE::TestTarget;

$status = 0;

$synchbase = "ready";
my $target1 = PerlACE::TestTarget::create_target (1) || die "Create target 1 failed\n";
my $target2 = PerlACE::TestTarget::create_target (2) || die "Create target 2 failed\n";
$synchfile = $target1->LocalFile ("$synchbase");
my $port = $target1->RandomPort ();
my $host = $target1->HostName();

my $SV = $target1->CreateProcess("server", "-p $port -o $synchfile");
my $CL = $target2->CreateProcess ("client", " -h $host -p $port");

$target1->DeleteFile ($synchbase);
$target2->DeleteFile ($synchbase);

$server_status = $SV->Spawn ();

if ($server_status != 0) {
    print STDERR "ERROR: server returned $server_status\n";
    exit 1;
}

if ($target1->WaitForFileTimed ($synchbase,
                                $target1->ProcessStartWaitInterval()) == -1) {
    print STDERR "ERROR: cannot find file <$synchfile>\n";
    $SV->Kill (); $SV->TimedWait (1);
    exit 1;
}
$target1->DeleteFile ($synchbase);

$client = $CL->SpawnWaitKill ($target2->ProcessStartWaitInterval() + 285);

if ($client != 0) {
    print STDERR "ERROR: client returned $client\n";
    $status = 1;
}

$server = $SV->WaitKill ($target1->ProcessStopWaitInterval());

if ($server != 0) {
    print STDERR "ERROR: server returned $server\n";
    $status = 1;
}

$target1->GetStderrLog();
$target2->GetStderrLog();

$target1->DeleteFile ($synchbase);
$target2->DeleteFile ($synchbase);

exit $status;


eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}'
    & eval 'exec perl -S $0 $argv:q'
    if 0;

# -*- perl -*-

use lib "$ENV{ACE_ROOT}/bin";
use PerlACE::TestTarget;

$status = 0;

my $target1 = PerlACE::TestTarget::create_target (1);
my $target2 = PerlACE::TestTarget::create_target (1);

my $sender = $target1->CreateProcess("sender", "224.1.2.3:12345");
my $receiver = $target2->CreateProcess("receiver", "224.1.2.3:12345");

$receiver->Spawn ();

# Wait for receiver to start.
#
sleep ($target1->ProcessStartWaitInterval());

$sender->Spawn ();

$status = $receiver->WaitKill ($target2->ProcessStopWaitInterval() + 30);

if ($status != 0) {
    print STDERR "ERROR: receiver returned $status\n";
    $status = 1;
}

$sender->Kill ();

$target1->GetStderrLog();
$target2->GetStderrLog();

exit $status;


eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}'
    & eval 'exec perl -S $0 $argv:q'
    if 0;

# -*- perl -*-
# This file is for running the tests in the ACE tests directory.
# It is usually used for auto_compiles.

if (defined $ENV{ACE_ROOT}) {
  use lib "$ENV{ACE_ROOT}/bin";
} else {
  use lib '../bin';
}
if (defined $ENV{top_srcdir}) {
  use lib "$ENV{top_srcdir}/bin";
}

use PerlACE::TestTarget;

use Cwd;
use English;
use Getopt::Std;
use FileHandle;
use File::Basename;

$config_list = new PerlACE::ConfigList;

if (grep(($_ eq 'ARCH'), @PerlACE::ConfigList::Configs)) {
  my $subdir = $PerlACE::Process::ExeSubDir;
  $subdir =~ s/\/$//;
  $ENV{'ACE_EXE_SUB_DIR'} = $subdir;
}

################################################################################

sub check_for_more_configs ()
{
    my $fh = new FileHandle;

    if ($fh->open ("< ../ace/ACE_COMPONENTS.list")) {
        while (<$fh>) {
            if (m/ Other /) {
                print "Adding 'Other' as my config\n" if defined $opt_d;
                $config_list->add_one_config ('OTHER');
            }
            if (m/ Token /) {
                print "Adding 'Token' as my config\n" if defined $opt_d;
                $config_list->add_one_config ('TOKEN');
            }
        }

        $fh->close ();
    }
    elsif (defined $opt_d) {
       print "Could not open ACE_COMPONENTS.list file\n" if defined $opt_d;
       print "Assuming TOKEN and OTHER subsets are included\n" if defined $opt_d;
       $config_list->add_one_config ('OTHER');
       $config_list->add_one_config ('TOKEN');
    }

    my $P = new PerlACE::Process ("../netsvcs/servers/main");

    if (!-x $P->Executable ()) {
        $config_list->add_one_config ('missing_netsvcs');
    }
}

################################################################################

sub record_resources ()
{
    if ($config_list->check_config ('CHECK_RESOURCES')) {
        if (!defined $ENV{'LOGNAME'}) {
            $user=`whoami`;
        }
        else {
            $user = $ENV{'LOGNAME'};
        }

        $start_test_resources=`ipcs | egrep $user`;
    }
}

################################################################################

sub check_resources
{
    my($oh) = shift;
    if ($config_list->check_config ('CHECK_RESOURCES')) {
        $end_test_resources=`ipcs | egrep $user`;
         if ("$start_test_resources" ne "$end_test_resources") {
            print STDERR "Warning: the ACE tests _may_ have leaked OS ".
                         "resources!\n";
            print STDERR "Warning: Before: $start_test_resources\n";
            print STDERR "Warning: After:  $end_test_resources\n";
        }
    }
}

################################################################################

sub run_program ($@)
{
    my $target = shift;
    my $path = shift;
    my $arguments = shift;
    if ($path =~ /^(\S*)\s*(.*)/ ) {
        $path = $1;
        $arguments = $2 . $arguments;
    }

    ## Print it out before we check for the executable
    ## if the executable doesn't exist, the error will show
    ## up as part of the previous test.
    print "auto_run_tests: tests/$path $arguments\n";
    if ($config_list->check_config ('Coverity')) {
      $ENV{COVERITY_TEST_NAME} = "tests/$path";
    }

    my ($program, $dir, $suffix) = fileparse($path);
    my $start_dir = getcwd ();
    if ($dir ne "" && !chdir $dir) {
        print STDERR "Error: Can\'t chdir to $dir for $path\n";
        return;
    }

    unlink <log/$program*.log>;
    unlink "core";

    my $P = $target->CreateProcess($program, $arguments);
    if ($config_list->check_config ('Valgrind')) {
      $P->IgnoreExeSubDir(1);
    }
    else {
      ### Try to run the program
      if (! -e $P->Executable ()) {
          print STDERR "Error: " . $P->Executable () .
                       " does not exist or is not runnable\n";
          chdir $start_dir;
          return;
       }
    }

    my $start_time = time();
    $status = $P->SpawnWaitKill (300 + $target->ProcessStartWaitInterval());
    my $time = time() - $start_time;

    ### Check for problems

    if ($status == -1) {
        print STDERR "Error: $program FAILED (time out after Time:$time"."s)\n";
        $P->Kill ();
        $P->TimedWait (1);
    }
    elsif ($status != 0) {
        print STDERR "Error: $program $arguments FAILED with exit status $status after Time:$time"."s\n";
    }

    print "\nauto_run_tests_finished: tests/$program $arguments Time:$time"."s Result:$status\n";

    check_log ($target, $program);

    if ($config_list->check_config ('Codeguard')) {
        check_codeguard_log ($program);
    }
    chdir $start_dir;
}

################################################################################

sub purify_program ($)
{
    ### @todo

    my $program = shift;

    $program_exe = $program;

    print STDERR "Purifying $program\n";

    system ("purify ".
            "/run ".
            "/save-data=purify_results\$program.pfy ".
            "/save-text-data=purify_results\$program.txt ".
            "/AllocCallStackLength=20 ".
            "/ErrorCallStackLength=20 ".
            "/HandlesInUseAtExit ".
            "/InUseAtExit ".
            "/LeaksAtExit ".
            "$program_exe");
}

################################################################################

sub check_log ($)
{
    my $target = shift;
    my $program = shift;

    ### Check the logs
    local $log_suffix = ".log";

    # Support logs generated by tests in subdirectories, such as tests
    # found in the SSL subdirectory.
    local $the_program = basename($program);
    local $log = "log/".$the_program.$log_suffix;

    if ($target->GetFile ($log, $log) == -1) {
        print STDERR "ERROR: cannot retrieve file <$log>\n";
    }

    if (-e "core") {
        print STDERR "Error: $program dumped core\n";
        unlink "core";
    }

    if (! -e $log ) {
        print STDERR "Error: No log file ($log) is present\n";
    }
    else {
        if (open (LOG, "<".$log) == 0) {
            print STDERR "Error: Cannot open log file $log\n";
        }
        else {
            my $print_log = 0;
            my $starting_matched = 0;
            my $ending_matched = 0;

            while (<LOG>) {
                chomp;

                if (m/Starting/) {
                    $starting_matched = 1;
                }

                if (m/Ending/) {
                    $ending_matched = 1;
                }

                if (/LM\_ERROR\@(.*)$/) {
                    print STDERR "Error: ($log): $1\n";
                    $print_log = 1;
                }
                if (/LM\_WARNING\@(.*)$/) {
                    print STDERR "Warning: ($log): $1\n";
                    $print_log = 1;
                }
            }

            close (LOG); # ignore errors

            if ($starting_matched == 0) {
                print STDERR "Error ($log): no line with 'Starting'\n";
                $print_log = 1;
            }

            if ($ending_matched == 0) {
                print STDERR "Error ($log): no line with 'Ending'\n";
                $print_log = 1;
            }

            if ($print_log == 1) {
                print STDERR "======= Begin Log File \n";
                if (open (LOG, "<".$log) == 0) {
                    print STDERR "Error: Cannot open log file $log\n";
                }
                else {
                    my @log = <LOG>;
                    print STDERR @log;
                    close (LOG);
                }
                print STDERR "======= End Log File \n";
            }

            # Now check for any sub-logs. If either the main log or a
            # sub-log has an error, print the sub-log.
            opendir (THISDIR, "log");
            local $sublognames = "$program\-.*".$log_suffix;
            @sublogs = grep (/^$sublognames/, readdir (THISDIR));
            closedir (THISDIR);
            my $saw_short_process_manager_child_log = 0;
            foreach $log (@sublogs) {
                # Just like the main log, but note that Process_Manager_Test
                # kills (signal 9) one of its children so the log may get
                # deleted, or it may be incomplete. So let this one go, but
                # only once per Process_Manager_Test.
                if (open (LOG, "<log/".$log) == 0) {
                    print STDERR "Error: Cannot open sublog file $log\n";
                }
                else {
                    my $number_starting = 0;
                    my $number_ending = 0;
                    while (<LOG>) {
                        chomp;
                        if (m/Starting/) {
                            $number_starting++;
                        }
                        if (m/Ending/) {
                            $number_ending++;
                        }
                        if (/LM\_ERROR\@(.*)$/) {
                            print STDERR "Error: ($log): $1\n";
                            $print_log = 1;
                        }
                        if (/LM\_WARNING\@(.*)$/) {
                            print STDERR "Warning: ($log): $1\n";
                            $print_log = 1;
                        }
                    }

                    if ($number_starting == 0) {
                       print STDERR "Error ($log): no line with 'Starting'\n";
                       $print_log = 1;
                    }

                    if ($number_ending == 0) {
                       if ($program eq 'Process_Manager_Test' &&
                           $saw_short_process_manager_child_log == 0) {
                           $saw_short_process_manager_child_log = 1;
                           $number_ending = 1;
                       }
                       else {
                           print STDERR "Error ($log): no line with 'Ending'\n";
                           $print_log = 1;
                       }
                    }

                    if ($number_starting != $number_ending) {
                       print STDERR "Error ($log): Number of 'Starting' does not match number of 'Ending' ($number_starting != $number_ending)\n";
                       $print_log = 1;
                    }

                    close (LOG); # ignore errors
                    if ($print_log == 1) {
                        print STDERR "======= Begin Sublog File ".$log."\n";
                        if (open (LOG, "<log/".$log) == 0) {
                            print STDERR "Error: Cannot open sublog file $log\n";
                        }
                        else {
                            my @log = <LOG>;
                            print STDERR @log;
                            close (LOG);
                        }
                        print STDERR "======= End Sublog File \n";
                    }
                }
            }
        }
    }
}

sub check_codeguard_log ($)
{
    my $program = shift;

    ### Check the logs

    local $log = $program.".cgl";

    if (-e $log ) {
       print STDERR "======= Begin Codeguard Log File \n";
       if (open (LOG, "<".$log) == 0) {
           print STDERR "Error: Cannot open codeguard log file $log\n";
       }
       else {
           my @log = <LOG>;
           print STDERR @log;
           close (LOG);
       }
       print STDERR "======= End Codeguard Log File \n";
    }
}

################################################################################

sub delete_temp_files ()
{
    my @files = ('ace_pipe_name', 'pattern');
    my $file = '';

    if (!opendir (DIR, $tmp)) {
        warn "Cannot open temp directory $tmp\n";
        return;
    }

    foreach $file (readdir (DIR)) {
      if ($file =~ /^ace_temp_file/ || $file =~ /^Naming_Test/) {
          push @files, $tmp . '/' . $file;
      }
    }
    closedir (DIR);

    PerlACE::check_n_cleanup_files ('MEM_Acceptor_*');
    PerlACE::check_n_cleanup_files ('backing_store_*');
}

################################################################################

if (!getopts ('dhtvo:l:') || $opt_h) {
    print "run_test.pl [-h] [-v] [-o <output file>] [-t file1 file2 ...]\n";
    print "\n";
    print "Runs the tests listed in run_test.lst\n";
    print "\n";
    print "Options:\n";
    print "    -d         Debug mode (do not run tests)\n";
    print "    -h         Display this help\n";
    print "    -t         Runs all the tests passed via the cmd line\n";
    print "    -l list    Load the list and run only those tests\n";
    print "\n";
    print "Pass in configs using \"-Config XXXXX\"\n";
    print "\n";
    print "Possible Configs: CHECK_RESOURCES Purify Codeguard Valgrind Coverity ",
           $config_list->list_configs (), "\n";
    exit (1);
}

## since we can't use "our" to get rid of warnings.
$opt_h = $opt_h if (defined $opt_h);
$opt_t = $opt_t if (defined $opt_t);
$opt_g = $opt_g if (defined $opt_g);

if (!($tmp = $ENV{TMP}) && !($tmp = $ENV{TEMP})) {
    $tmp="/tmp";
}

check_for_more_configs ();

@tests = ();

if (defined $opt_t) {
    @tests = @ARGV;
}
elsif (defined $opt_l) {
    $config_list->load ("$opt_l");
    @tests = $config_list->valid_entries ();
}
else {
    $config_list->load ("run_test.lst");
    @tests = $config_list->valid_entries ();
}

if (defined $opt_d) {
    $config_list->dump ();
}

record_resources () if (!defined $opt_d);

my($oh) = \*STDOUT;

my $target = PerlACE::TestTarget::create_target (1);

$target->AddLibPath("$ENV{ACE_ROOT}/tests");

# Put needed files in place for targets that require them.
# Service_Config_Test needs service config file.
my $svc_conf_file = "Service_Config_Test.conf";
if ($target->PutFile ($svc_conf_file) == -1) {
    print STDERR "WARNING: Cannot send $svc_conf_file to target\n";
}
# Config_Test needs config ini file.
my $conf_ini_file = "Config_Test_Import_1.ini";
if ($target->PutFile ($conf_ini_file) == -1) {
    print STDERR "WARNING: Cannot send $conf_ini_file to target\n";
}
# Service_Config_Stream_Test needs service config file.
$svc_conf_file = "Service_Config_Stream_Test.conf";
if ($target->PutFile ($svc_conf_file) == -1) {
    print STDERR "WARNING: Cannot send $svc_conf_file to target\n";
}
# Bug_3334_Regression_Test needs service config file.
$svc_conf_file = "Bug_3334_Regression_Test.conf";
if ($target->PutFile ($svc_conf_file) == -1) {
    print STDERR "WARNING: Cannot send $svc_conf_file to target\n";
}
# Bug_3912_Regression_Test needs service config file.
$svc_conf_file = "Bug_3912_Regression_Test.conf";
if ($target->PutFile ($svc_conf_file) == -1) {
    print STDERR "WARNING: Cannot send $svc_conf_file to target\n";
}

foreach $test (@tests) {

    if (defined $opt_d) {
        print "Would run test $test now\n";
    }
    elsif ($config_list->check_config ('Purify')) {
        purify_program ($test);
    }
    else {
        run_program ($target, $test);
    }
    $target->GetStderrLog();
}

check_resources ($oh) if (!defined $opt_d);

delete_temp_files ();


eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}'
    & eval 'exec perl -S $0 $argv:q'
    if 0;

# -*- perl -*-

use lib "$ENV{ACE_ROOT}/bin";

# This test can't run on Win32
exit if ($^O eq 'MSWin32');

# This test can't be run if "make" is not in the path or if it resolves to
# a non-GNU version of make.

exit unless (`make --version` =~ /^GNU Make/);

print "Running non_mpc_makefile test:\n";
system "make -f CustomMakefile";
print "ERROR: libfoo.a not made\n" unless -r 'libfoo.a';
system "make -f CustomMakefile realclean";


#!/usr/bin/perl -w
#
# Boost.Function library
#
# Copyright Douglas Gregor 2001-2003. Use, modification and
# distribution is subject to the Boost Software License, Version
# 1.0. (See accompanying file LICENSE_1_0.txt or copy at
# http://www.boost.org/LICENSE_1_0.txt)
#
# For more information, see http://www.boost.org
use English;

if ($#ARGV < 0) {
  print "Usage: perl gen_function_N <number of arguments>\n";
  exit;
}

$totalNumArgs = $ARGV[0];
for ($numArgs = 0; $numArgs <= $totalNumArgs; ++$numArgs) {
  open OUT, ">function$numArgs.hpp";
  print OUT "#define BOOST_FUNCTION_NUM_ARGS $numArgs\n";
  print OUT "#include <boost/function/detail/maybe_include.hpp>\n";
  print OUT "#undef BOOST_FUNCTION_NUM_ARGS\n";
  close OUT;
}


#!/usr/bin/perl -w
#
# Boost.Function library
#
# Copyright (C) 2001-2003 Douglas Gregor (gregod@cs.rpi.edu)
#
# Permission to copy, use, sell and distribute this software is granted
# provided this copyright notice appears in all copies.
# Permission to modify the code and to distribute modified code is granted
# provided this copyright notice appears in all copies, and a notice
# that the code was modified is included with the copyright notice.
#
# This software is provided "as is" without express or implied warranty,
# and with no claim as to its suitability for any purpose.
#
# For more information, see http://www.boost.org
use English;

$max_args = $ARGV[0];

open (OUT, ">maybe_include.hpp") or die("Cannot write to maybe_include.hpp");
for($on_arg = 0; $on_arg <= $max_args; ++$on_arg) {
    if ($on_arg == 0) {
	print OUT "#if";
    }
    else {
	print OUT "#elif";
    }
    print OUT " BOOST_FUNCTION_NUM_ARGS == $on_arg\n";
    print OUT "#  undef BOOST_FUNCTION_MAX_ARGS_DEFINED\n";
    print OUT "#  define BOOST_FUNCTION_MAX_ARGS_DEFINED $on_arg\n";
    print OUT "#  ifndef BOOST_FUNCTION_$on_arg\n";
    print OUT "#    define BOOST_FUNCTION_$on_arg\n";
    print OUT "#    include <boost/function/function_template.hpp>\n";
    print OUT "#  endif\n";
}
print OUT "#else\n";
print OUT "#  error Cannot handle Boost.Function objects that accept more than $max_args arguments!\n";
print OUT "#endif\n";


#!/usr/bin/perl -w

# Copyright (c) 2003-2021 Christopher M. Kohlhoff (chris at kohlhoff dot com)
#
# Distributed under the Boost Software License, Version 1.0. (See accompanying
# file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)

use strict;

system("doxygen reference.dox");
chdir("xml");
system("xsltproc combine.xslt index.xml > all.xml");
chdir("..");
system("xsltproc reference.xsl xml/all.xml > reference.qbk");
system("rm -rf xml");

system("doxygen tutorial.dox");
chdir("xml");
system("xsltproc combine.xslt index.xml > all.xml");
chdir("..");
system("xsltproc tutorial.xsl xml/all.xml > tutorial.qbk");
system("rm -rf xml reference.tags");


#!/usr/bin/perl -w

# Copyright (c) 2003-2021 Christopher M. Kohlhoff (chris at kohlhoff dot com)
#
# Distributed under the Boost Software License, Version 1.0. (See accompanying
# file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)

use strict;

open(my $fh, "<../include/boost/asio/detail/config.hpp") or die("can't open config.hpp");

my $current_comment = "";
my %has_macros = ();
my %disable_macros = ();

while (my $line = <$fh>)
{
  chomp($line);
  if ($line =~ /^$/)
  {
    $current_comment = "";
  }
  elsif ($line =~ /^\/\/ (.*)$/)
  {
    $current_comment = $current_comment . $1 . "\n";
  }
  elsif ($line =~ /^# *define *BOOST_ASIO_HAS_([A-Z-0-9_]*) 1/)
  {
    if (not defined($has_macros{$1}))
    {
      $has_macros{$1} = $current_comment;
    }
  }
  elsif ($line =~ /BOOST_ASIO_DISABLE_([A-Z-0-9_]*)/)
  {
    $disable_macros{$1} = 1;
  }
}

my $intro = <<EOF;
[/
 / Copyright (c) 2003-2021 Christopher M. Kohlhoff (chris at kohlhoff dot com)
 /
 / Distributed under the Boost Software License, Version 1.0. (See accompanying
 / file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
 /]

[heading Compiler/platform feature detection macros]

Asio automatically defines preprocessor macros corresponding to the detected
available features on a particular compiler and target platform. These macros
are named with the prefix `BOOST_ASIO_HAS_`, and are listed in the table below.

Many of these macros also have a corresponding `BOOST_ASIO_DISABLE_` macro that
may be used to explicitly disable the feature.

In general, `BOOST_ASIO_HAS_` macros should not be explicitly defined by the
user, except when absolutely required as a workaround for the latest version of
a compiler or platform. For older compiler/platform combinations where a
specific `BOOST_ASIO_HAS_` macro is not automatically defined, testing may have
shown that a claimed feature isn't sufficiently conformant to be compatible
with Boost.Asio's needs.
EOF

print("$intro\n");
print("[table\n");
print("  [[Macro][Description][Macro to disable feature]]\n");
for my $macro (sort keys %has_macros)
{
  print("  [\n");
  print("    [`BOOST_ASIO_HAS_$macro`]\n");
  print("    [\n");
  my $description = $has_macros{$macro};
  chomp($description);
  $description =~ s/\n/\n      /g;
  print("      $description\n");
  print("    ]\n");
  if (defined $disable_macros{$macro})
  {
    print("    [`BOOST_ASIO_DISABLE_$macro`]\n");
  }
  else
  {
    print("    []\n");
  }
  print("  ]\n");
}
print("]\n");


#!/usr/bin/perl -w
#
# handlerlive.pl
# ~~~~~~~~~~~~~~
#
# A tool for post-processing the debug output generated by Asio-based programs
# to print a list of "live" handlers. These are handlers that are associated
# with operations that have not yet completed, or running handlers that have
# not yet finished their execution. Programs write this output to the standard
# error stream when compiled with the define `BOOST_ASIO_ENABLE_HANDLER_TRACKING'.
#
# Copyright (c) 2003-2021 Christopher M. Kohlhoff (chris at kohlhoff dot com)
#
# Distributed under the Boost Software License, Version 1.0. (See accompanying
# file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
#

use strict;

my %pending_handlers = ();
my %running_handlers = ();

#-------------------------------------------------------------------------------
# Parse the debugging output and update the set of pending handlers.

sub parse_debug_output()
{
  while (my $line = <>)
  {
    chomp($line);

    if ($line =~ /\@asio\|([^|]*)\|([^|]*)\|(.*)$/)
    {
      my $action = $2;

      # Handler creation.
      if ($action =~ /^([0-9]+)\*([0-9]+)$/)
      {
        $pending_handlers{$2} = 1;
      }

      # Begin handler invocation.
      elsif ($action =~ /^>([0-9]+)$/)
      {
        delete($pending_handlers{$1});
        $running_handlers{$1} = 1;
      }

      # End handler invocation.
      elsif ($action =~ /^<([0-9]+)$/)
      {
        delete($running_handlers{$1});
      }

      # Handler threw exception.
      elsif ($action =~ /^!([0-9]+)$/)
      {
        delete($running_handlers{$1});
      }

      # Handler was destroyed without being invoked.
      elsif ($action =~ /^~([0-9]+)$/)
      {
        delete($pending_handlers{$1});
      }
    }
  }
}

#-------------------------------------------------------------------------------
# Print a list of incompleted handers, on a single line delimited by spaces.

sub print_handlers($)
{
  my $handlers = shift;
  my $prefix = "";
  foreach my $handler (sort { $a <=> $b } keys %{$handlers})
  {
    print("$prefix$handler");
    $prefix = " ";
  }
  print("\n") if ($prefix ne "");
}

#-------------------------------------------------------------------------------

parse_debug_output();
print_handlers(\%running_handlers);
print_handlers(\%pending_handlers);


#!/usr/bin/perl -w
#
# handlertree.pl
# ~~~~~~~~~~~~~~
# A tool for post-processing the debug output generated by Asio-based programs
# to print the tree of handlers that resulted in some specified handler ids.
# Programs write this output to the standard error stream when compiled with
# the define `BOOST_ASIO_ENABLE_HANDLER_TRACKING'.
#
# Copyright (c) 2003-2021 Christopher M. Kohlhoff (chris at kohlhoff dot com)
#
# Distributed under the Boost Software License, Version 1.0. (See accompanying
# file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
#

use strict;

my %target_handlers = ();
my @cached_output = ();
my %outstanding_handlers = ();
my %running_handlers = ();

#-------------------------------------------------------------------------------
# Build the initial list of target handlers from the command line arguments.

sub build_initial_target_handlers()
{
  for my $handler (@ARGV)
  {
    $target_handlers{$handler} = 1;
  }
}

#-------------------------------------------------------------------------------
# Parse the debugging output and cache the handler tracking lines.

sub parse_debug_output()
{
  while (my $line = <STDIN>)
  {
    chomp($line);

    if ($line =~ /\@asio\|([^|]*)\|([^|]*)\|(.*)$/)
    {
      push(@cached_output, $line);
    }
  }
}

#-------------------------------------------------------------------------------
# Iterate over the cached output in revese and build a hash of all target
# handlers' ancestors.

sub build_target_handler_tree()
{
  my $i = scalar(@cached_output) - 1;
  while ($i >= 0)
  {
    my $line = $cached_output[$i];

    if ($line =~ /\@asio\|([^|]*)\|([^|]*)\|(.*)$/)
    {
      my $action = $2;

      # Handler creation.
      if ($action =~ /^([0-9]+)\*([0-9]+)$/)
      {
        if ($1 ne "0" and exists($target_handlers{$2}))
        {
          $target_handlers{$1} = 1;
        }
      }
    }

    --$i;
  }
}

#-------------------------------------------------------------------------------
# Print out all handler tracking records associated with the target handlers.

sub print_target_handler_records()
{
  for my $line (@cached_output)
  {
    if ($line =~ /\@asio\|([^|]*)\|([^|]*)\|(.*)$/)
    {
      my $action = $2;

      # Handler location.
      if ($action =~ /^([0-9]+)\^([0-9]+)$/)
      {
        print("$line\n") if ($1 eq "0" or exists($target_handlers{$1})) and exists($target_handlers{$2});
      }

      # Handler creation.
      if ($action =~ /^([0-9]+)\*([0-9]+)$/)
      {
        print("$1, $2, $line\n") if ($1 eq "0" or exists($target_handlers{$1})) and exists($target_handlers{$2});
      }

      # Begin handler invocation.
      elsif ($action =~ /^>([0-9]+)$/)
      {
        print("$line\n") if (exists($target_handlers{$1}));
      }

      # End handler invocation.
      elsif ($action =~ /^<([0-9]+)$/)
      {
        print("$line\n") if (exists($target_handlers{$1}));
      }

      # Handler threw exception.
      elsif ($action =~ /^!([0-9]+)$/)
      {
        print("$line\n") if (exists($target_handlers{$1}));
      }

      # Handler was destroyed without being invoked.
      elsif ($action =~ /^~([0-9]+)$/)
      {
        print("$line\n") if (exists($target_handlers{$1}));
      }

      # Operation associated with a handler.
      elsif ($action =~ /^\.([0-9]+)$/)
      {
        print("$line\n") if (exists($target_handlers{$1}));
      }
    }
  }
}

#-------------------------------------------------------------------------------

build_initial_target_handlers();
parse_debug_output();
build_target_handler_tree();
print_target_handler_records();


#!/usr/bin/perl -w
#
# handlerviz.pl
# ~~~~~~~~~~~~~
#
# A visualisation tool for post-processing the debug output generated by
# Asio-based programs. Programs write this output to the standard error stream
# when compiled with the define `BOOST_ASIO_ENABLE_HANDLER_TRACKING'.
#
# This tool generates output intended for use with the GraphViz tool `dot'. For
# example, to convert output to a PNG image, use:
#
#   perl handlerviz.pl < output.txt | dot -Tpng > output.png
#
# To convert to a PDF file, use:
#
#   perl handlerviz.pl < output.txt | dot -Tpdf > output.pdf
#
# Copyright (c) 2003-2021 Christopher M. Kohlhoff (chris at kohlhoff dot com)
#
# Distributed under the Boost Software License, Version 1.0. (See accompanying
# file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
#

use strict;

my %nodes = ();
my @edges = ();
my %locations = ();
my %anon_nodes = ();
my $anon_id = 0;
my %all_nodes = ();
my %pending_nodes = ();

#-------------------------------------------------------------------------------
# Parse the debugging output and populate the nodes and edges.

sub parse_debug_output()
{
  while (my $line = <>)
  {
    chomp($line);

    if ($line =~ /\@asio\|([^|]*)\|([^|]*)\|(.*)$/)
    {
      my $timestamp = $1;
      my $action = $2;
      my $description = $3;

      # Handler creation.
      if ($action =~ /^([0-9]+)\*([0-9]+)$/)
      {
        my $begin = $1;
        my $end = $2;
        my $label = $description;
        $label =~ s/\./\\n/g;

        if ($begin eq "0")
        {
          $begin = "a" . $anon_id++;
          $anon_nodes{$begin} = $timestamp;
          $all_nodes{"$timestamp-$begin"} = $begin;
        }

        my %edge = ( begin=>$begin, end=>$end, label=>$label );
        push(@edges, \%edge);

        $pending_nodes{$end} = 1;
      }

      # Handler location.
      elsif ($action =~ /^([0-9]+)\^([0-9]+)$/)
      {
        if ($1 ne "0")
        {
          if (not exists($locations{($1,$2)}))
          {
            $locations{($1,$2)} = ();
          }
          push(@{$locations{($1,$2)}}, $description);
        }
      }

      # Begin handler invocation.
      elsif ($action =~ /^>([0-9]+)$/)
      {
        my %new_node = ( label=>$description, entry=>$timestamp );
        $new_node{content} = ();
        $nodes{$1} = \%new_node;
        $all_nodes{"$timestamp-$1"} = $1;
        delete($pending_nodes{$1});
      }

      # End handler invocation.
      elsif ($action =~ /^<([0-9]+)$/)
      {
        $nodes{$1}->{exit} = $timestamp;
      }

      # Handler threw exception.
      elsif ($action =~ /^!([0-9]+)$/)
      {
        push(@{$nodes{$1}->{content}}, "exception");
      }

      # Handler was destroyed without being invoked.
      elsif ($action =~ /^~([0-9]+)$/)
      {
        my %new_node = ( label=>"$timestamp destroyed" );
        $new_node{content} = ();
        $nodes{$1} = \%new_node;
        $all_nodes{"$timestamp-$1"} = $1;
        delete($pending_nodes{$1});
      }

      # Handler performed some operation.
      elsif ($action =~ /^([0-9]+)$/)
      {
        if ($1 eq "0")
        {
          my $id = "a" . $anon_id++;
          $anon_nodes{$id} = "$timestamp\\l$description";
          $all_nodes{"$timestamp-$id"} = $id;
        }
        else
        {
          push(@{$nodes{$1}->{content}}, "$description");
        }
      }
    }
  }
}

#-------------------------------------------------------------------------------
# Helper function to convert a string to escaped HTML text.

sub escape($)
{
  my $text = shift;
  $text =~ s/&/\&amp\;/g;
  $text =~ s/</\&lt\;/g;
  $text =~ s/>/\&gt\;/g;
  $text =~ s/\t/    /g;
  return $text;
}

#-------------------------------------------------------------------------------
# Templates for dot output.

my $graph_header = <<"EOF";
/* Generated by handlerviz.pl */
digraph "handlerviz output"
{
graph [ nodesep="1" ];
node [ shape="box", fontsize="9" ];
edge [ arrowtail="dot", fontsize="9" ];
EOF

my $graph_footer = <<"EOF";
}
EOF

my $node_header = <<"EOF";
"%name%"
[
label=<

%label%

EOF

my $node_footer = <<"EOF";

>
]
EOF

my $node_content = <<"EOF";

%content%

EOF

my $anon_nodes_header = <<"EOF";
{
node [ shape="record" ];
EOF

my $anon_nodes_footer = <<"EOF";
}
EOF

my $anon_node = <<"EOF";
"%name%" [ label="%label%", color="gray" ];
EOF

my $pending_nodes_header = <<"EOF";
{
node [ shape="record", color="red" ];
rank = "max";
EOF

my $pending_nodes_footer = <<"EOF";
}
EOF

my $pending_node = <<"EOF";
"%name%";
EOF

my $edges_header = <<"EOF";
{
edge [ style="dashed", arrowhead="open" ];
EOF

my $edges_footer = <<"EOF";
}
EOF

my $edge = <<"EOF";
"%begin%" -> "%end%" [ label="%label%", labeltooltip="%tooltip%" ]
EOF

my $node_order_header = <<"EOF";
{
node [ style="invisible" ];
edge [ style="invis", weight="100" ];
EOF

my $node_order_footer = <<"EOF";
}
EOF

my $node_order = <<"EOF";
{
rank="same"
"%begin%";
"o%begin%";
}
"o%begin%" -> "o%end%";
EOF

#-------------------------------------------------------------------------------
# Generate dot output from the nodes and edges.

sub print_nodes()
{
  foreach my $name (sort keys %nodes)
  {
    my $node = $nodes{$name};
    my $entry = $node->{entry};
    my $exit = $node->{exit};
    my $label = escape($node->{label});
    my $header = $node_header;
    $header =~ s/%name%/$name/g;
    $header =~ s/%label%/$label/g;
    print($header);

    if (defined($exit) and defined($entry))
    {
      my $line = $node_content;
      my $content = $entry . " + " . sprintf("%.6f", $exit - $entry) . "s";
      $line =~ s/%content%/$content/g;
      print($line);
    }

    foreach my $content (@{$node->{content}})
    {
      $content = escape($content);
      $content = " " if length($content) == 0;
      my $line = $node_content;
      $line =~ s/%content%/$content/g;
      print($line);
    }

    print($node_footer);
  }
}

sub print_anon_nodes()
{
  print($anon_nodes_header);
  foreach my $name (sort keys %anon_nodes)
  {
    my $label = $anon_nodes{$name};
    my $line = $anon_node;
    $line =~ s/%name%/$name/g;
    $line =~ s/%label%/$label/g;
    print($line);
  }
  print($anon_nodes_footer);
}

sub print_pending_nodes()
{
  print($pending_nodes_header);
  foreach my $name (sort keys %pending_nodes)
  {
    my $line = $pending_node;
    $line =~ s/%name%/$name/g;
    print($line);
  }
  print($pending_nodes_footer);
}

sub print_edges()
{
  print($edges_header);
  foreach my $e (@edges)
  {
    my $begin = $e->{begin};
    my $end = $e->{end};
    my $label = $e->{label};
    my $tooltip = "";
    if (exists($locations{($begin,$end)}))
    {
      for my $line (@{$locations{($begin,$end)}})
      {
        $tooltip = $tooltip . escape($line) . "\n";
      }
    }
    my $line = $edge;
    $line =~ s/%begin%/$begin/g;
    $line =~ s/%end%/$end/g;
    $line =~ s/%label%/$label/g;
    $line =~ s/%tooltip%/$tooltip/g;
    print($line);
  }
  print($edges_footer);
}

sub print_node_order()
{
  my $prev = "";
  print($node_order_header);
  foreach my $name (sort keys %all_nodes)
  {
    if ($prev ne "")
    {
      my $begin = $prev;
      my $end = $all_nodes{$name};
      my $line = $node_order;
      $line =~ s/%begin%/$begin/g;
      $line =~ s/%end%/$end/g;
      print($line);
    }
    $prev = $all_nodes{$name};
  }
  foreach my $name (sort keys %pending_nodes)
  {
    if ($prev ne "")
    {
      my $begin = $prev;
      my $line = $node_order;
      $line =~ s/%begin%/$begin/g;
      $line =~ s/%end%/$name/g;
      print($line);
    }
    last;
  }
  print($node_order_footer);
}

sub generate_dot()
{
  print($graph_header);
  print_nodes();
  print_anon_nodes();
  print_pending_nodes();
  print_edges();
  print_node_order();
  print($graph_footer);
}

#-------------------------------------------------------------------------------

parse_debug_output();
generate_dot();


#!/usr/bin/perl -w
# Bart Garst - 7/1/2004
# additional comments at bottom of file

#############################################################################
#  Copyright (c) 2001-2005 CrystalClear Software, Inc.                      #
#  Subject to the Boost Software License, Version 1.0.                      #
#  (See accompanying file LICENSE_1_0.txt or  http://www.boost.org/LICENSE_1_0.txt) #
#############################################################################

use strict;

# key-value of file name and id attribute
# if the attributes are changed here it would be a good idea to
# also change the links in doxy.xml
my %files = (
  'date_time_autodoc.boostbook'  => 'date_time_reference',
  'gregorian_autodoc.boostbook'  => 'gregorian_reference',
  'posix_time_autodoc.boostbook' => 'posix_time_reference',
  'local_time_autodoc.boostbook' => 'local_time_reference'
);

foreach my $key(keys %files) {
  rewrite_tags($key, $files{$key});
}

exit;

### subroutines ###

# separate words at underscores and capitalize first letter of each
sub make_title {
  my $a = shift || die "Missing required parameter to make_title()\n";
  my @wrds = split(/_/, $a); # remove underscores
  foreach(@wrds){
    $_ = "\u$_"; # capitalize first letter
  }
  $a = join(" ",@wrds);

  return $a;
}

sub rewrite_tags {
  my $filename = shift || die "Error: argument 1 missing to sub $!";
  my $id_tag = shift || die "Error: argument 2 missing to sub $!";
  my ($line, @new_file, $title, $processed);

  $processed = 1; # has this file already been processed?

  print "...processing $filename...\n";

  # prepare a title from id attribute
  $title = make_title($id_tag);

  # open & read file and change appropriate line
  open(INP, "<$filename") || die "File open (read) failed: $!";
  while($line = <INP>){
    if($line =~ /<library-reference>/) {
      push(@new_file, "
\n");
      push(@new_file, "<title>$title</title>\n");
      $processed = 0; # file had not been previously processed
    }
    elsif($line =~ /<\/library-reference>/) {
      push(@new_file, "
\n");
    }
    else{
      push(@new_file, $line);
    }
  }
  close(INP);

  # open & write new file w/ same name
  open(OTP, ">$filename") || die "File open (write) failed: $!";
  print OTP shift(@new_file);

  if($processed == 0){ # has not been previously processed so add license
    my($day, $year) = (localtime)[3,5];
    my $month = (qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec))[(localtime)[4]];
    $year += 1900; # adjust year
    print OTP <<EO_LIC;

EO_LIC
  }

  foreach(@new_file){
    print OTP "$_";
  }
  close(OTP);
}

__END__

Rewrites the library-reference tagset as a section tagset and adds
a title to the generated *.boostbook files. It will NOT update a
file that has already been rewritten.

Change log
7/19/2004
        - rewrite library-reference tags as section tags and add title tags
        - renamed fix_id sub to rewrite_tags.
8/31/2004
        - added license to this file and writes license to boostbook files
11/01/2004
        - fixed minor bug that placed multiple license statements in files if
          input file had already had it's tags fixed.
        - added a processed date to the license statement
12/02/2005
        - added local_time_autodoc.boostbook
        - updated copyrights to 2005


# Copyright (c) 2002 Trustees of Indiana University
#
# Distributed under the Boost Software License, Version 1.0.
# (See accompanying file LICENSE_1_0.txt or copy at
# http://www.boost.org/LICENSE_1_0.txt)

$lastpage = 0;
$thispage = 1;
$counter =  1;
$alphabet = "\@abcdefghijklmnopqrstuvwxyz";
$Alphabet = "\@ABCDEFGHIJKLMNOPQRSTUVWXYZ";
$out = "";
$saved_full = "";
$saved_empty = "";

while(<>) {

# These changes are so that it works when we aren't using hyperref

#  if (/(\\newlabel.*\{\{)([0-9]+)(\}\{)([0-9ivx]+)(\}.*JWebCtr\.)([0-9]+)(.*)/) {
  if (/\\newlabel\{sec:.*/) {
    # make sure not to munge normal (non jweb part) section labels
    print ;
  } elsif (/\\newlabel\{class:.*/) {
    # make sure not to munge normal (non jweb part) class labels
    print ;
  } elsif (/\\newlabel\{tab:.*/) {
    # make sure not to munge normal (non jweb part) table labels
    print ;
  } elsif (/\\newlabel\{concept:.*/) {
    # make sure not to munge normal (non jweb part) concept labels
    print ;
  } elsif (/\\newlabel\{fig:.*/) {
    # make sure not to munge normal (non jweb part) class labels
    print ;
  } elsif (/(\\newlabel.*\{\{)([0-9\.]+)(\}\{)([0-9ivx]+)(\}.*)(.*)/) {
    $thispage = $4;

    if ($thispage ne $lastpage) {

      $counter = 1;

      print $saved_empty;

#      $saved_full = "$1".substr($alphabet,$counter,1)."$3$4$5$6$7\n";
#      $saved_empty = "$1"."$3$4$5$6$7\n";
      $saved_full = "$1".substr($alphabet,$counter,1)."$3$4$5\n";
      $saved_empty = "$1"."$3$4$5\n";

    } else {
      print $saved_full;
#      print "$1".substr($alphabet,$counter,1)."$3$4$5$counter$7\n";
      print "$1".substr($alphabet,$counter,1)."$3$4$5\n";
      $saved_full = "";
      $saved_empty = "";
    }

    $lastpage = $thispage;
    $counter++;

  } else {
    print ;
  }
}
print $saved_empty;

# get a line
# cases
# - ref
#   - if it is first, save off someplace
#     - if there is a first saved, dump the empty version
#   - else
#     - if there is a first saved, dump the non empty version
# - not a ref


#!/usr/bin/perl -w
#          Copyright Steven J. Ross 2008 - 2014
# Distributed under the Boost Software License, Version 1.0.
#    (See accompanying file LICENSE_1_0.txt or copy at
#          http://www.boost.org/LICENSE_1_0.txt)
#
# See http://www.boost.org/libs/sort for library home page.

# A speed and accuracy testing and automated parameter tuning script.

$usage = "usage: tune.pl [-tune] [-real] [-tune_verify] [-verbose] [-multiple_iterations] [-large] [-small] [-windows] [fileSize]\n";
# testing sorting on 40 million elements by default
# don't test on below 2^22 (4 million) elements as that is the minimum
# for max_splits of 11 to be efficient
use File::Compare;
$defFileSize = 5000000;
$loopCount = 1;
$realtimes = 0;
$verifycorrect = 0;
$verbose = 0;
$exename = "spreadsort";
$makename = "../../b2 \-\-tune";
$all = "";
$iter_count = 1;
$debug = 0;
$log = "> .tunelog";
$log2 = "> .tunelog 2>&1";
$diffopt = "-q";
$tune = 0;
# have to change the path for UNIX
$prev_path = $ENV{'PATH'};
$ENV{'PATH'} = '.:'.$prev_path;

for (my $ii = 0; $ii < @ARGV; $ii++) {
        my $currArg = $ARGV[$ii];
        if ($currArg =~ /^-help$/) {
            print STDERR $usage;
            exit(0);
        }
        # verification roughly doubles the runtime of this script,
        # but it does make sure that results are correct during tuning
        # verification always runs during speed comparisons with std::sort
        if ($currArg =~ /^-tune_verify$/) {
            $verifycorrect = 1;
        # use real times only, don't use weighting and special-case tests
        # this saves about 5/6 of the script runtime but results are different
        } elsif ($currArg =~ /^-real$/) {
            $realtimes = 1;
        } elsif ($currArg =~ /^-verbose$/) {
            $verbose = 1;
        # runs until we converge on a precise set of values
        # defaults off because of runtime
        } elsif ($currArg =~ /^-multiple_iterations$/) {
            $iter_count = 4;
        } elsif ($currArg =~ /^-debug$/) {
            $debug = 1;
            $log = "";
            $diffopt = "";
        } elsif ($currArg =~ /^-large$/) {
            $defFileSize = 20000000;
        } elsif ($currArg =~ /^-small$/) {
            $defFileSize = 100000;
        } elsif ($currArg =~ /^-tune$/) {
            $tune = 1;
        } elsif ($currArg =~ /^-windows$/) {
            $makename = "..\\..\\".$makename;
        } elsif ($currArg =~ /^-/) {
            print STDERR $usage;
            exit(0);
        } else {
                $defFileSize = $currArg;
        }
}
$fileSize = $defFileSize;

print STDOUT "Tuning variables for $exename on vectors with $defFileSize elements\n";

# these are reasonable values
$max_splits = 11;
$log_finishing_count = 31;
$log_min_size = 11;
$log_mean_bin_size = 2;
$float_log_min_size = 10;
$float_log_mean_bin_size = 2;
$float_log_finishing_count = 4;

# this value is a minimum to obtain decent file I/O performance
$min_sort_size = 1000;
$std = "";

print STDOUT "building randomgen\n";
system("$makename randomgen $log");
# Tuning to get convergence, maximum of 4 iterations with multiple iterations
# option set
$changed = 1;
my $ii = 0;
if ($tune) {
    for ($ii = 0; $changed and $ii < $iter_count; $ii++) {
        $changed = 0;
        # Tuning max_splits is not recommended.
        #print STDOUT "Tuning max_splits\n";
        #TuneVariable(\$max_splits, $log_min_size - $log_mean_bin_size, 17);
        print STDOUT "Tuning log of the minimum count for recursion\n";
        TuneVariable(\$log_min_size, $log_mean_bin_size + 1, $max_splits + $log_mean_bin_size);
        print STDOUT "Tuning log_mean_bin_size\n";
        TuneVariable(\$log_mean_bin_size, 0, $log_min_size - 1);
        print STDOUT "Tuning log_finishing_size\n";
        TuneVariable(\$log_finishing_count, 1, $log_min_size);
        # tuning variables for floats
        $exename = "floatsort";
        print STDOUT "Tuning log of the minimum count for recursion for floats\n";
        TuneVariable(\$float_log_min_size, $float_log_mean_bin_size + 1, $max_splits + $float_log_mean_bin_size);
        print STDOUT "Tuning float_log_mean_bin_size\n";
        TuneVariable(\$float_log_mean_bin_size, 0, $float_log_min_size - 1);
        print STDOUT "Tuning float_log_finishing_size\n";
        TuneVariable(\$float_log_finishing_count, 1, $float_log_min_size);
        $exename = "spreadsort";
    }

    # After optimizations for large datasets are complete, see how small of a
    # dataset can be sped up
    print STDOUT "Tuning minimum sorting size\n";
    TuneMinSize();
    print STDOUT "Writing results\n";
}

# Doing a final run with final settings to compare sort times
# also verifying correctness of results
$verifycorrect = 1;
$loopCount = 1;
$fileSize = $defFileSize;
system("$makename $all $log");
$std = "";
PerfTest("Verifying integer_sort", "spreadsort");
PerfTest("Verifying float_sort", "floatsort");
PerfTest("Verifying string_sort", "stringsort");
PerfTest("Verifying integer_sort with mostly-sorted data", "mostlysorted");
PerfTest("Timing integer_sort on already-sorted data", "alreadysorted");
PerfTest("Verifying integer_sort with rightshift", "rightshift");
PerfTest("Verifying integer_sort with 64-bit integers", "int64");
PerfTest("Verifying integer_sort with separate key and data", "keyplusdata");
PerfTest("Verifying reverse integer_sort", "reverseintsort");
PerfTest("Verifying float_sort with doubles", "double");
PerfTest("Verifying float_sort with shift functor", "shiftfloatsort");
PerfTest("Verifying float_sort with functors", "floatfunctorsort");
PerfTest("Verifying string_sort with indexing functors", "charstringsort");
PerfTest("Verifying string_sort with all functors", "stringfunctorsort");
PerfTest("Verifying reverse_string_sort", "reversestringsort");
PerfTest("Verifying reverse_string_sort with functors",
         "reversestringfunctorsort");
PerfTest("Verifying generalized string_sort with multiple keys of different types",
         "generalizedstruct");
PerfTest("Verifying boost::sort on its custom-built worst-case distribution",
         "binaryalrbreaker");
# clean up once we finish
system("$makename clean $log");
# WINDOWS
system("del spread_sort_out.txt $log2");
system("del standard_sort_out.txt $log2");
system("del input.txt $log2");
system("del *.rsp $log2");
system("del *.manifest $log2");
system("del time.txt $log2");
# UNIX
system("rm -f time.txt $log2");
system("rm -f spread_sort_out.txt $log2");
system("rm -f standard_sort_out.txt $log2");
system("rm -f input.txt $log2");

$ENV{'PATH'} = $prev_path;

# A simple speed test comparing std::sort to
sub PerfTest {
    my ($message, $local_exe) = @_;
    $exename = $local_exe;
    print STDOUT "$message\n";
    $lastTime = SumTimes();
    print STDOUT "runtime: $lastTime\n";
    print STDOUT "std::sort time: $baseTime\n";
    $speedup = (($baseTime/$lastTime) - 1) * 100;
    print STDOUT "speedup: ".sprintf("%.2f", $speedup)."%\n";
}

# Write an updated constants file as part of tuning.
sub WriteConstants {
    # deleting the file
    $const_file = 'include/boost/sort/spreadsort/detail/constants.hpp';
    @cannot = grep {not unlink} $const_file;
    print "$0: could not unlink @cannot\n" if @cannot;

    # writing the results back to the original file name
    unless(open(CONSTANTS, ">$const_file")) {
      print STDERR "Can't open output file: $const_file: $!\n";
      exit;
    }
    print CONSTANTS "//constant definitions for the Boost Sort library\n\n";
    print CONSTANTS "//          Copyright Steven J. Ross 2001 - 2014\n";
    print CONSTANTS "// Distributed under the Boost Software License, Version 1.0.\n";
    print CONSTANTS "//    (See accompanying file LICENSE_1_0.txt or copy at\n";
    print CONSTANTS "//          http://www.boost.org/LICENSE_1_0.txt)\n\n";
    print CONSTANTS "//  See http://www.boost.org/libs/sort for library home page.\n";
    print CONSTANTS "#ifndef BOOST_SORT_SPREADSORT_DETAIL_CONSTANTS\n";
    print CONSTANTS "#define BOOST_SORT_SPREADSORT_DETAIL_CONSTANTS\n";
    print CONSTANTS "namespace boost {\n";
    print CONSTANTS "namespace sort {\n";
    print CONSTANTS "namespace spreadsort {\n";
    print CONSTANTS "namespace detail {\n";
    print CONSTANTS "//Tuning constants\n";
    print CONSTANTS "//This should be tuned to your processor cache;\n";
    print CONSTANTS "//if you go too large you get cache misses on bins\n";
    print CONSTANTS "//The smaller this number, the less worst-case memory usage.\n";
    print CONSTANTS "//If too small, too many recursions slow down spreadsort\n";
    print CONSTANTS "enum { max_splits = $max_splits,\n";
    print CONSTANTS "//It's better to have a few cache misses and finish sorting\n";
    print CONSTANTS "//than to run another iteration\n";
    print CONSTANTS "max_finishing_splits = max_splits + 1,\n";
    print CONSTANTS "//Sets the minimum number of items per bin.\n";
    print CONSTANTS "int_log_mean_bin_size = $log_mean_bin_size,\n";
    print CONSTANTS "//Used to force a comparison-based sorting for small bins, if it's faster.\n";
    print CONSTANTS "//Minimum value 1\n";
    $log_min_split_count = $log_min_size - $log_mean_bin_size;
    print CONSTANTS "int_log_min_split_count = $log_min_split_count,\n";
    print CONSTANTS "//This is the minimum split count to use spreadsort when it will finish in one\n";
    print CONSTANTS "//iteration.  Make this larger the faster std::sort is relative to integer_sort.\n";
    print CONSTANTS "int_log_finishing_count = $log_finishing_count,\n";
    print CONSTANTS "//Sets the minimum number of items per bin for floating point.\n";
    print CONSTANTS "float_log_mean_bin_size = $float_log_mean_bin_size,\n";
    print CONSTANTS "//Used to force a comparison-based sorting for small bins, if it's faster.\n";
    print CONSTANTS "//Minimum value 1\n";
    $float_log_min_split_count = $float_log_min_size - $float_log_mean_bin_size;
    print CONSTANTS "float_log_min_split_count = $float_log_min_split_count,\n";
    print CONSTANTS "//This is the minimum split count to use spreadsort when it will finish in one\n";
    print CONSTANTS "//iteration.  Make this larger the faster std::sort is relative to float_sort.\n";
    print CONSTANTS "float_log_finishing_count = $float_log_finishing_count,\n";
    print CONSTANTS "//There is a minimum size below which it is not worth using spreadsort\n";
    print CONSTANTS "min_sort_size = $min_sort_size };\n";
    print CONSTANTS "}\n}\n}\n}\n#endif\n";
    close CONSTANTS;
    system("$makename $exename $log");
}

# Sort the file with both std::sort and boost::sort, verify the results are the
# same, update stdtime with std::sort time, and return boost::sort time.
sub CheckTime {
    my $sort_time = 0.0;
    my $time_file = "time.txt";
    # use the line below on systems that can't overwrite.
    #system("rm -f $time_file");
    system("$exename $loopCount $std > $time_file");
    unless(open(CODE, $time_file)) {
        print STDERR "Could not open file: $time_file: $!\n";
        exit;
    }
    while ($line = <CODE>) {
        @parts = split("time", $line);
        if (@parts > 1) {
            $sort_time = $parts[1];
            last;
        }
    }
    close(CODE);
    # verifying correctness
    if (not $std and $verifycorrect) {
        system("$exename $loopCount -std > $time_file");
        unless(open(CODE, $time_file)) {
            print STDERR "Could not open file: $time_file: $!\n";
            exit;
        }
        die "Difference in results\n" unless (compare("boost_sort_out.txt","standard_sort_out.txt") == 0) ;
        while ($line = <CODE>) {
            @parts = split("time", $line);
            if (@parts > 1) {
                $stdsingle = $parts[1];
                last;
            }
        }
        close(CODE);
    }
    return $sort_time;
}

# Sum up times for different data distributions.  If realtimes is not set,
# larger ranges are given a larger weight.
sub SumTimes {
    my $time = 0;
    $baseTime = 0.0;
    $stdsingle = 0.0;
    my $ii = 1;
    # if we're only using real times, don't bother with the corner-cases
    if ($realtimes) {
        $ii = 8;
    }
    for (; $ii <= 16; $ii++) {
        system("randomgen $ii $ii $fileSize");
        if ($realtimes) {
            $time += CheckTime();
            $baseTime += $stdsingle;
        } else {
            # tests with higher levels of randomness are given
            # higher priority in timing results
            print STDOUT "trying $ii $ii\n" if $debug;
            $time += 2 * $ii * CheckTime();
            $baseTime += 2 * $ii * $stdsingle;
            if ($ii > 1) {
                print STDOUT "trying 1 $ii\n" if $debug;
                system("randomgen 1 $ii $fileSize");
                $time += $ii * CheckTime();
                $baseTime += $ii * $stdsingle;
                print STDOUT "trying $ii 1\n" if $debug;
                system("randomgen $ii 1 $fileSize");
                $time += $ii * CheckTime();
                $baseTime += $ii * $stdsingle;
            }
        }
    }
    if ($time == 0.0) {
        $time = 0.01;
    }
    return $time;
}

# Tests a range of potential values for a variable, and sets it to the fastest.
sub TuneVariable {
    my ($tunevar, $beginval, $endval) = @_;
    my $best_val = $$tunevar;
    my $besttime = 0;
    my $startval = $$tunevar;
    for ($$tunevar = $beginval; $$tunevar <= $endval; $$tunevar++) {
        WriteConstants();
        $sumtime = SumTimes();
        # If this value is better, use it.  If this is the start value
        # and it's just as good, use the startval
        if (not $besttime or ($sumtime < $besttime) or (($besttime == $sumtime) and ($$tunevar == $startval))) {
            $besttime = $sumtime;
            $best_val = $$tunevar;
        }
        print STDOUT "Value: $$tunevar Time: $sumtime\n" if $verbose;
    }
    $$tunevar = $best_val;
    print STDOUT "Best Value: $best_val\n";
    if ($best_val != $startval) {
        $changed = 1;
    }
}

# Determine the cutoff size below which std::sort is faster.
sub TuneMinSize {
    for (; $min_sort_size <= $defFileSize; $min_sort_size *= 2) {
        $loopCount = ($defFileSize/$min_sort_size)/10;
        $fileSize = $min_sort_size;
        WriteConstants();
        $std = "";
        $sumtime = SumTimes();
        $std = "-std";
        $stdtime = SumTimes();
        print STDOUT "Size: $min_sort_size boost::sort Time: $sumtime std::sort Time: $stdtime\n";
        last if ($stdtime > $sumtime);
    }
}


# // (C) Copyright Tobias Schwinger
# //
# // Use modification and distribution are subject to the boost Software License
# // Version 1.0. (See http://www.boost.org/LICENSE_1_0.txt).

# // Preprocess and run this script.
# //
# // Invocation example using the GNU preprocessor:
# //
# //   g++ -I$BOOST_ROOT -x c++ preprocess.pl -E |perl
# //
# // or in two steps:
# //
# //   g++ -I$BOOST_ROOT -x c++ preprocess.pl -E >temp.pl
# //   perl temp.pl

#define die(x) 1
die("ERROR: this script has to be preprocessed, stopped");
#undef die

use strict vars;
use File::Spec updir,curdir,catfile,canonpath,splitpath,file_name_is_absolute;

# // --- Settings
my $up = File::Spec->updir();

# // Relative path to the destination directory.
my $path = File::Spec->catdir($up,$up,$up,'boost','typeof');

my $license = qq@
/\/ Copyright (C) 2005 Arkadiy Vertleyb
/\/ Copyright (C) 2005 Peder Holt
/\/
/\/ Use modification and distribution are subject to the boost Software License,
/\/ Version 1.0. (See http:/\/www.boost.org/LICENSE_1_0.txt).

/\/ Preprocessed code, do not edit manually !

@;
# //---

# // Find this script's directory if run directly from the shell (not piped)
$path = File::Spec->canonpath
( File::Spec->catfile
  ( File::Spec->file_name_is_absolute($0)
    ? $0 : (File::Spec->curdir(),$0)
  , $up
  , File::Spec->splitpath($path)
  )
) unless ($0 eq '-');
die
( ($0 eq '-')
  ? "ERROR: please run from this script's directory, stopped"
  : "ERROR: target directoty not found, stopped"
) unless (-d $path);

# // Tidy up the contents and write it to a file
sub write_down(name,contents)
{
  my($name,$contents) = @_;
  my $filename = $name;

  my $fqfname = File::Spec->catfile($path,$filename);
  $contents =~ s"(((\n|^)\s*\#[^\n]+)|(\s*\n)){2,}"\n"g; # "
  print STDERR "Writing file: '$filename'\n";
  open my($file),">$fqfname"
    or die "ERROR: unable to open file '$filename' for writing, stopped";
  print $file $license;
  print $file $contents;
  close $file;
}

# // Include external components to ensure they don't end up in the recorded
# // output
#define BOOST_TYPEOF_PP_INCLUDE_EXTERNAL
my $sewer = <<'%--%-EOF-%--%'
#include <boost/typeof/vector.hpp>
#undef  BOOST_TYPEOF_VECTOR_HPP_INCLUDED
%--%-EOF-%--%
; $sewer = '';

#define BOOST_TYPEOF_PREPROCESSING_MODE
#define BOOST_TYPEOF_LIMIT_SIZE 50
#define BOOST_TYPEOF_PP_NEXT_SIZE 100

&write_down('vector50.hpp',<<'%--%-EOF-%--%'
#include <boost/typeof/vector.hpp>
%--%-EOF-%--%
);
#undef  BOOST_TYPEOF_VECTOR_HPP_INCLUDED

#undef  BOOST_TYPEOF_LIMIT_SIZE
#define BOOST_TYPEOF_LIMIT_SIZE 100
#define BOOST_TYPEOF_PP_NEXT_SIZE 149

&write_down('vector100.hpp',<<'%--%-EOF-%--%'
#include <boost/typeof/vector.hpp>
%--%-EOF-%--%
);
#undef  BOOST_TYPEOF_VECTOR_HPP_INCLUDED

#undef  BOOST_TYPEOF_LIMIT_SIZE
#define BOOST_TYPEOF_LIMIT_SIZE 150
#define BOOST_TYPEOF_PP_NEXT_SIZE 199

&write_down('vector150.hpp',<<'%--%-EOF-%--%'
#include <boost/typeof/vector.hpp>
%--%-EOF-%--%
);
#undef  BOOST_TYPEOF_VECTOR_HPP_INCLUDED

#undef  BOOST_TYPEOF_LIMIT_SIZE
#define BOOST_TYPEOF_LIMIT_SIZE 200
#define BOOST_TYPEOF_PP_NEXT_SIZE 250

&write_down('vector200.hpp',<<'%--%-EOF-%--%'
#include <boost/typeof/vector.hpp>
%--%-EOF-%--%
);