AIX-Perfstat
view release on metacpan or search on metacpan
inc/Devel/CheckLib.pm view on Meta::CPAN
things before checking that what they've told you is sane.
If any library or header is missing, it exits with an exit value of 0 to avoid
causing a CPAN Testers 'FAIL' report. CPAN Testers should ignore this
result -- which is what you want if an external library dependency is not
available.
=cut
sub check_lib_or_exit {
eval 'assert_lib(@_)';
if($@) {
warn $@;
exit;
}
}
sub assert_lib {
my %args = @_;
my (@libs, @libpaths, @headers, @incpaths);
For a global function, use:
#define NEED_function_GLOBAL
Note that you mustn't have more than one global request for one
function in your project.
Function Static Request Global Request
-----------------------------------------------------------------------------------------
eval_pv() NEED_eval_pv NEED_eval_pv_GLOBAL
grok_bin() NEED_grok_bin NEED_grok_bin_GLOBAL
grok_hex() NEED_grok_hex NEED_grok_hex_GLOBAL
grok_number() NEED_grok_number NEED_grok_number_GLOBAL
grok_numeric_radix() NEED_grok_numeric_radix NEED_grok_numeric_radix_GLOBAL
grok_oct() NEED_grok_oct NEED_grok_oct_GLOBAL
newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL
newRV_noinc() NEED_newRV_noinc NEED_newRV_noinc_GLOBAL
sv_2pv_nolen() NEED_sv_2pv_nolen NEED_sv_2pv_nolen_GLOBAL
sv_2pvbyte() NEED_sv_2pvbyte NEED_sv_2pvbyte_GLOBAL
sv_catpvf_mg() NEED_sv_catpvf_mg NEED_sv_catpvf_mg_GLOBAL
hints => 1,
changes => 1,
cplusplus => 0,
filter => 1,
);
my($ppport) = $0 =~ /([\w.]+)$/;
my $LF = '(?:\r\n|[\r\n])'; # line feed
my $HS = "[ \t]"; # horizontal whitespace
eval {
require Getopt::Long;
Getopt::Long::GetOptions(\%opt, qw(
help quiet diag! filter! hints! changes! cplusplus
patch=s copy=s diff=s compat-version=s
list-provided list-unsupported api-info=s
)) or usage();
};
if ($@ and grep /^-/, @ARGV) {
usage() if "@ARGV" =~ /^--?h(?:elp)?$/;
die "Getopt::Long not found. Please don't use any options.\n";
}
usage() if $opt{help};
if (exists $opt{'compat-version'}) {
my($r,$v,$s) = eval { parse_version($opt{'compat-version'}) };
if ($@) {
die "Invalid version number format: '$opt{'compat-version'}'\n";
}
die "Only Perl 5 is supported\n" if $r != 5;
die "Invalid version number: $opt{'compat-version'}\n" if $v >= 1000 || $s >= 1000;
$opt{'compat-version'} = sprintf "%d.%03d%03d", $r, $v, $s;
}
else {
$opt{'compat-version'} = 5;
}
check_uni|||
checkcomma|||
checkposixcc|||
ck_anoncode|||
ck_bitop|||
ck_concat|||
ck_defined|||
ck_delete|||
ck_die|||
ck_eof|||
ck_eval|||
ck_exec|||
ck_exists|||
ck_exit|||
ck_ftst|||
ck_fun|||
ck_glob|||
ck_grep|||
ck_index|||
ck_join|||
ck_lengthconst|||
do_trans_count_utf8|||
do_trans_count|||
do_trans_simple_utf8|||
do_trans_simple|||
do_trans|||
do_vecget|||
do_vecset|||
do_vop|||
docatch_body|||
docatch|||
doeval|||
dofile|||
dofindlabel|||
doform|||
doing_taint||5.008001|n
dooneliner|||
doopen_pm|||
doparseform|||
dopoptoeval|||
dopoptolabel|||
dopoptoloop|||
dopoptosub_at|||
dopoptosub|||
dounwind|||
dowantarray|||
dump_all||5.006000|
dump_eval||5.006000|
dump_fds|||
dump_form||5.006000|
dump_indent||5.006000|v
dump_mstats|||
dump_packsubs||5.006000|
dump_sub||5.006000|
dump_vindent||5.006000|
dumpuntil|||
dup_attrlist|||
emulate_eaccess|||
eval_pv|5.006000||p
eval_sv|5.006000||p
expect_number|||
fbm_compile||5.005000|
fbm_instr||5.005000|
fd_on_nosuid_fs|||
filter_add|||
filter_del|||
filter_gets|||
filter_read|||
find_beginning|||
find_byclass|||
my @files;
my @srcext = qw( xs c h cc cpp );
my $srcext = join '|', @srcext;
if (@ARGV) {
my %seen;
@files = grep { -f && !exists $seen{$_} } map { glob $_ } @ARGV;
}
else {
eval {
require File::Find;
File::Find::find(sub {
$File::Find::name =~ /\.($srcext)$/i
and push @files, $File::Find::name;
}, '.');
};
if ($@) {
@files = map { glob "*.$_" } @srcext;
}
}
}
else {
error("Cannot open '$tmp' for writing: $!");
}
return undef;
}
sub can_use
{
eval "use @_;";
return $@ eq '';
}
sub rec_depend
{
my $func = shift;
my %seen;
return () unless exists $depends{$func};
grep !$seen{$_}++, map { ($_, rec_depend($_)) } @{$depends{$func}};
}
# define call_pv perl_call_pv
#endif
#ifndef call_argv
# define call_argv perl_call_argv
#endif
#ifndef call_method
# define call_method perl_call_method
#endif
#ifndef eval_sv
# define eval_sv perl_eval_sv
#endif
/* Replace: 0 */
/* Replace perl_eval_pv with eval_pv */
/* eval_pv depends on eval_sv */
#ifndef eval_pv
#if defined(NEED_eval_pv)
static SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
static
#else
extern SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
#endif
#ifdef eval_pv
# undef eval_pv
#endif
#define eval_pv(a,b) DPPP_(my_eval_pv)(aTHX_ a,b)
#define Perl_eval_pv DPPP_(my_eval_pv)
#if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL)
SV*
DPPP_(my_eval_pv)(char *p, I32 croak_on_error)
{
dSP;
SV* sv = newSVpv(p, 0);
PUSHMARK(sp);
eval_sv(sv, G_SCALAR);
SvREFCNT_dec(sv);
SPAGAIN;
sv = POPs;
PUTBACK;
if (croak_on_error && SvTRUE(GvSV(errgv)))
croak(SvPVx(GvSV(errgv), na));
return sv;
#setup name so we are asking for the last processor.
my $name = "proc".($cpu_count-1);
my $x = AIX::Perfstat::cpu(1,$name);
cmp_ok($name, 'eq', "", 'cpu called with a variable of the last processor name returns the empty string in $name');
$name = "";
$x = AIX::Perfstat::cpu($cpu_count, $name);
cmp_ok($name, 'eq', "", 'cpu called with the empty string and requesting all processors returns the empty string in $name');
}
eval { AIX::Perfstat::cpu(1,"aaabbbcccdddeeefffggghhhiiijjjkkklllmmmnnnooopppqqqrrrssstttuuu") };
ok( !$@, 'cpu called with name with 63 characters does not cause die to be called');
eval { AIX::Perfstat::cpu(1,"aaabbbcccdddeeefffggghhhiiijjjkkklllmmmnnnooopppqqqrrrssstttuuuv") };
ok( $@, 'cpu called with name with 64 characters does not cause die to be called');
eval { AIX::Perfstat::cpu(-1) };
ok( $@, 'cpu called with -1 for desired_number causes a die.');
eval { AIX::Perfstat::cpu(0) };
ok( $@, 'cpu called with 0 for desired_number causes a die.');
# my $x = AIX::Perfstat::disk($disk_count-1,$name);
# $x = AIX::Perfstat::disk(1,$name);
# cmp_ok($name, 'eq', "", 'disk called with a variable of the last disk name returns the empty string in $name');
$name = "";
my $x = AIX::Perfstat::disk($disk_count, $name);
cmp_ok($name, 'eq', "", 'disk called with the empty string and requesting all disks returns the empty string in $name');
}
eval { AIX::Perfstat::disk(1,"aaabbbcccdddeeefffggghhhiiijjjkkklllmmmnnnooopppqqqrrrssstttuuu") };
ok( !$@, 'disk called with name with 63 characters does not cause die to be called');
eval { AIX::Perfstat::disk(1,"aaabbbcccdddeeefffggghhhiiijjjkkklllmmmnnnooopppqqqrrrssstttuuuv") };
ok( $@, 'disk called with name with 64 characters does not cause die to be called');
eval { AIX::Perfstat::disk(-1) };
ok( $@, 'disk called with -1 for desired_number causes a die.');
eval { AIX::Perfstat::disk(0) };
ok( $@, 'disk called with 0 for desired_number causes a die.');
t/netinterface.t view on Meta::CPAN
my $x = AIX::Perfstat::netinterface($netinterface_count-1,$name);
$x = AIX::Perfstat::netinterface(1,$name);
cmp_ok($name, 'eq', "", 'netinterface called with a variable of the last netinterface name returns the empty string in $name');
$name = "";
$x = AIX::Perfstat::netinterface($netinterface_count, $name);
cmp_ok($name, 'eq', "", 'netinterface called with the empty string and requesting all netinterfaces returns the empty string in $name');
}
eval { AIX::Perfstat::netinterface(1,"aaabbbcccdddeeefffggghhhiiijjjkkklllmmmnnnooopppqqqrrrssstttuuu") };
ok( !$@, 'netinterface called with name with 63 characters does not cause die to be called');
eval { AIX::Perfstat::netinterface(1,"aaabbbcccdddeeefffggghhhiiijjjkkklllmmmnnnooopppqqqrrrssstttuuuv") };
ok( $@, 'netinterface called with name with 64 characters does not cause die to be called');
eval { AIX::Perfstat::netinterface(-1) };
ok( $@, 'netinterface called with -1 for desired_number causes a die.');
eval { AIX::Perfstat::netinterface(0) };
ok( $@, 'netinterface called with 0 for desired_number causes a die.');
( run in 1.209 second using v1.01-cache-2.11-cpan-98e64b0badf )