view release on metacpan or  search on metacpan

lib/Benchmark/Thread/Size.pm  view on Meta::CPAN

for (\$i=0; \$i< $threads ; \$i++) { 
  threads->new( sub {print "started\\n"; sleep( 86400 )} );
}
print "done\\n";       # make sure the world knows we're done
<>;                    # make sure it waits until killed
EOD
    close( $script ) or die "Could not close $testfile: $!\n";

#  Run the testfile
#  Get the pid (returned on first line by the script)
#  Initialize the number of threads that have started
#  Initialize the numbe of times the main thread signals it's ready

    open( my $out,"$^X -w $testfile |" ) or die "Could not run $testfile: $!\n";
    chomp( my $pid = <$out> );
    my $started = 0;
    my $done = 0;

#  While there are lines to be read
#  Increment done flag if done found
#  Increment thread started flag if started found
#  Outloop if all threads started and main thread signalled it was done

    while (<$out>) {
        $done++ if m#^done#;
        $started++ if m#^started#;
        last if $done and $started == $threads;
    }

#  Initialize the size
#  While we don't have a size yet and the program's still running
#   If we're on Windows
#    Get the size information using the applicable API

    my $size = 0;
    while (!$size and kill 0,$pid) {
        if ($wpi) {
            $size = ($wpi->GetProcInfo( $pid ))[0]->{'WorkingSetSize'}/1024;

#   Else (we're not on Windows *phew*  ;-)
#    Open a pipe to process information
#    While something being returned by the pipe
#     Keep it if it looks like a size
#    Close the pipe for good measure
#  Remember the size for this number of threads

        } else {
            open( my $ps,"ps -o rss= -p $pid |" )
             or die "Could not ps -o rss= -p $pid: $!\n";
            while (<$ps>) {
                $size = $1 if m#(\d+)#;
            }
            close( $ps );       # don't care whether successful
        }
    }
    $size{$threads} = $size;

#  Kill the process quickly (should work even on Windows)
#  Close the pipe for good measure
#  Remove the script
#  Move cursor so the next number can be shown

    kill 15,$pid;
    close( $out );      # don't care whether successful
#    unlink( $testfile );
    print STDERR "\b\b\b\b";
}

# Calculate the base size
# Initialize the difference
# For all of the number of threads, sorted by number of threads
#  Tell the world what we got

my $base = $size{0};
my $diff;
foreach my $threads (sort {$a <=> $b} keys %size) {
    printf( "%3d %6d %6d %9d\n",
     $threads,
     $size{$threads},
     $diff = $size{$threads} - $base,
     $threads ? (1024 * $diff) / $threads : 0,
     );
}
RAMTHREAD1
} #_ramthread1

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

__END__

=head1 NAME

Benchmark::Thread::Size - report size of threads for different code approaches

=head1 SYNOPSIS

  use Benchmark::Thread::Size times => 5, noexport => <<'E1', export => <<'E2';
  use threads::shared ();
  E1
  use threads::shared;
  E2

  use Benchmark::Thread::Size 'refonly';    # do reference run only

  perl -MBenchmark::Thread::Size=times,100  # as a one-liner for developers

=head1 DESCRIPTION

                  *** A note of CAUTION ***

 This module only functions on Perl versions 5.8.0 and later.
 And then only when threads are enabled with -Dusethreads.  It
 is of no use with any version of Perl before 5.8.0 or without
 threads enabled.

                  *************************

The Benchmark::Thread::Size module reports how much memory is used by different
pieces of source code within a threaded application.  This allows you to test
different approaches to coding a specific threaded application or to find ways
how to reduce memory usage of threads in general.