use lib qw(blib/lib blib/arch);
use Sys::CpuAffinity;
use Test::More tests => 2;
use strict qw(vars subs);
use warnings;
$| = 1;
#
# Exercise all of the methods in the toolbox to
# count processors on the system, get cpu affinity,
# and set cpu affinity.
#
# Generally each tool is targeted to work on a
# single system. Since most of the tools are
# targeted at a different system than yours,
# most of these tools will fail on your system.
#
# Among the tools that are targeted to your
# system, some of them will depend on certain
# Perl modules or certain external programs
# being available, so those tools might also
# fail on your system.
#
# Hopefully, we'll find at least one tool for
# each task (count cpus, get affinity, set
# affinity) that will work for you. And that's
# all we need.
#
my $pid = $$;
$Sys::CpuAffinity::IS_TEST = 1;
#########################################################
#
# get inventory of all Sys::CpuAffinity techniques
# from the Sys::CpuAffinity source code.
#
# XXX - could also inspect %Sys::CpuAffinity:: symbol table.
#
#########################################################
{
my (@SET, @GET, @NCPUS);
open my $source, '<', $INC{"Sys/CpuAffinity.pm"}
or die "failed to load Sys::CpuAffinity source. $!\n";
while (<$source>) {
next unless /^sub _/;
next if /XXX/; # method still under development
if (/^sub _setAffinity_with_(\S+)/) {
push @SET, $1;
} elsif (/^sub _getAffinity_with_(\S+)/) {
push @GET, $1;
} elsif (/^sub _getNumCpus_from_(\S+)/) {
push @NCPUS, $1;
}
}
close $source;
sub inventory::getAffinity { sort { lc $a cmp lc $b } @GET }
sub inventory::setAffinity { sort { lc $a cmp lc $b } @SET }
sub inventory::getNumCpus { sort { lc $a cmp lc $b } @NCPUS }
}
select STDERR;
print "\n\n";
EXERCISE_COUNT_NCPUS();
my $n = Sys::CpuAffinity::getNumCpus();
if ($n <= 1) {
SKIP: {
if ($n == 1) {
skip "affinity exercise. Only one processor on this system", 2;
} else {
skip "affinity exercise. Can't detect number of processors", 2;
}
}
exit 0;
}
EXERCISE_GET_AFFINITY();
EXERCISE_SET_AFFINITY();
sleep 1;
ok(1);
# call all of the getAffinity_with_XXX methods
# method is successful if
# at least one method returns > 0
# all methods that return > 0 return the same value
sub EXERCISE_GET_AFFINITY {
my $ok = 0;
print "===============================================\n";
print "Current affinity = \n";
my $success = 0;
for my $s (inventory::getAffinity()) {
my $sub = 'Sys::CpuAffinity::_getAffinity_with_' . $s;
printf " %-30s ==> ", $s;
my $z = eval { $sub->($pid) };
printf "%d\n", $z || 0;
$success += ($z||0) > 0;
if ($z > 0) {
if ($ok == 0) {
$ok = $z;
} elsif ($ok != $z) {
$ok = -1;
}
}
}
if ($success == 0) {
recommend($^O, 'getAffinity');
}
print "\n\n";
ok($ok > 0, "at least one _getAffinity_XXX method works and "
. "all other methods are consistent");
}
#
# call all of the _getNumCpus_from_XXX functions.
# Passes if
# at least one methods returns > 0
# all methods that return > 0 return the same value
#
sub EXERCISE_COUNT_NCPUS {
local $Sys::CpuAffinity::DEBUG = $ENV{DEBUG} || 0;
if ($^O =~ /openbsd/i || $^O =~ /darwin/i) {
$Sys::CpuAffinity::DEBUG = 1;
}
print "=================================================\n";
print "Num processors =\n";
my $ok = 0;
for my $technique (inventory::getNumCpus()) {
my $s = 'Sys::CpuAffinity::_getNumCpus_from_' . $technique;
printf " %-30s ", $technique;
my $ncpus = eval { $s->() } || 0;
printf "- %s -\n", $ncpus;
if ($ncpus > 0) {
if ($ok eq 0) {
$ok = $ncpus;
} elsif ($ok ne $ncpus) {
$ok = -1;
}
}
}
print "\n\n";
# ok($ok > 0, "at least one _getNumCpus_XXX method works and "
# . "all other methods are consistent");
}
#
# call each of the _setAffinity_with_XXX methods.
# passes if at least one method works
#
sub EXERCISE_SET_AFFINITY {
print "==================================================\n";
my $np = Sys::CpuAffinity::getNumCpus();
if ($np <= 1) {
SKIP: {
# skip "skip set affinity test on single-processor sys", 1;
1;
}
return 0;
}
my $ok = 0;
my ($TARGET,$LAST_TARGET) = (0,0);
my @mask = ();
while (@mask < 500) {
$TARGET = int(rand() * (2**$np - 1)) + 1
while $TARGET == $LAST_TARGET;
$LAST_TARGET = $TARGET;
push @mask, $TARGET;
}
# print "@mask\n";
my $success = 0;
print "Set affinity =\n";
for my $technique (inventory::setAffinity()) {
my $rr = Sys::CpuAffinity::getAffinity($pid) || 0;
if ($rr == 0) {
printf " %-30s => %s ==> FAIL\n", $technique,
"no affinity";
next;
}
my $mask;
do {
$mask = shift @mask;
} while $mask == $rr;
my $s = "Sys::CpuAffinity::_setAffinity_with_$technique";
eval { $s->($pid,$mask) };
printf " %-30s => %3u ==> ", $technique, $mask;
my $r = Sys::CpuAffinity::getAffinity($pid);
my $result = $r==$rr ? "FAIL" : " ok ";
if ($r != $rr) {
$success++;
}
printf "%3u [%s]\n", $r, $result;
}
if ($success == 0) {
recommend($^O, 'setAffinity');
}
print "\n\n";
# ok($success != 0, "at least one _setAffinity_XXX method works");
}
sub recommend {
use Config;
my ($sys, $function) = @_;
print "\n\n==========================================\n\n";
print "The function 'Sys::CpuAffinity::$function' does\n";
print "not seem to work on this system.\n\n";
my @recommendations;
if ($Config{"cc"}) {
@recommendations = ("install a C compiler (preferrably $Config{cc})");
} else {
@recommendations = ("install a C compiler");
}
if ($sys eq 'cygwin') {
push @recommendations, "install the Win32 module";
push @recommendations, "install the Win32::API module";
push @recommendations, "install the Win32::Process module";
} elsif ($sys eq 'MSWin32') {
push @recommendations, "install the Win32 module";
push @recommendations, "install the Win32::API module";
push @recommendations, "install the Win32::Process module";
} elsif ($sys =~ /openbsd/i) {
@recommendations = ();
print "OpenBSD does not provide (as far as I can tell)\n";
print "a way to manipulate the CPU affinities of processes.\n";
print "\n\n==========================================\n\n\n";
return;
} elsif ($sys =~ /netbsd/i) {
if ($> != 0) {
push @recommendations, "run as super-user";
push @recommendations,
"\t(the available methods for manipulating CPU affinities "
. "on NetBSD only work for super-user)";
}
} elsif ($sys =~ /freebsd/i) {
push @recommendations, "install the BSD::Process::Affinity module";
push @recommendations, "make sure the cpuset program is in the PATH";
} elsif ($sys =~ /solaris/i) {
push @recommendations, "make sure the pbind program is in the PATH";
} elsif ($sys =~ /irix/i) {
# still need to learn to use the cpuset_XXX functions
} elsif ($sys =~ /darwin/i || $sys =~ /MacOS/i) {
@recommendations = ();
print "The Mac OS does not provide (as far as I can tell)\n";
print "a way to manipulate the CPU affinities of processes.\n";
print "\n\n==========================================\n\n\n";
return;
} elsif ($sys =~ /aix/i) {
push @recommendations,
"make sure the bindprocessor program is in the PATH";
} else {
push @recommendations,
"don't know what else to recommend for system $sys";
}
if (@recommendations > 0) {
print "To make this module work, you may want to install:\n\n";
foreach (@recommendations) {
print "\t$_\n";
}
print "\n\n";
print "If these recommendations do not help, drop a note\n";
print "to mob\@cpan.org with details about your\n";
print "system configuration.\n";
}
print "\n\n==========================================\n\n\n";
}