dslinux/user/perl/ext/Sys/Syslog/t 00-load.t constants.t syslog.t
cayenne
dslinux_cayenne at user.in-berlin.de
Mon Dec 4 17:59:44 CET 2006
Update of /cvsroot/dslinux/dslinux/user/perl/ext/Sys/Syslog/t
In directory antilope:/tmp/cvs-serv17422/ext/Sys/Syslog/t
Added Files:
00-load.t constants.t syslog.t
Log Message:
Adding fresh perl source to HEAD to branch from
--- NEW FILE: 00-load.t ---
#!perl -T
use Test::More tests => 1;
BEGIN {
use_ok( 'Sys::Syslog' );
}
#diag( "Testing Sys::Syslog $Sys::Syslog::VERSION, Perl $], $^X" );
--- NEW FILE: syslog.t ---
#!/usr/bin/perl -T
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = '../lib';
}
}
use strict;
use Config;
use File::Spec;
use Test::More;
# check that the module is at least available
plan skip_all => "Sys::Syslog was not build"
unless $Config{'extensions'} =~ /\bSyslog\b/;
# we also need Socket
plan skip_all => "Socket was not build"
unless $Config{'extensions'} =~ /\bSocket\b/;
BEGIN {
plan tests => 119;
# ok, now loads them
eval 'use Socket';
use_ok('Sys::Syslog', ':standard', ':extended', ':macros');
}
# check that the documented functions are correctly provided
can_ok( 'Sys::Syslog' => qw(openlog syslog syslog setlogmask setlogsock closelog) );
# check the diagnostics
# setlogsock()
eval { setlogsock() };
like( $@, qr/^Invalid argument passed to setlogsock; must be 'stream', 'unix', 'tcp', 'udp' or 'inet'/,
"calling setlogsock() with no argument" );
# syslog()
eval { syslog() };
like( $@, qr/^syslog: expecting argument \$priority/,
"calling syslog() with no argument" );
my $test_string = "uid $< is testing Perl $] syslog(3) capabilities";
my $r = 0;
# try to open a syslog using a Unix or stream socket
SKIP: {
skip "can't connect to Unix socket: _PATH_LOG unavailable", 8
unless -e Sys::Syslog::_PATH_LOG();
# The only known $^O eq 'svr4' that needs this is NCR MP-RAS,
# but assuming 'stream' in SVR4 is probably not that bad.
my $sock_type = $^O =~ /^(solaris|irix|svr4|powerux)$/ ? 'stream' : 'unix';
eval { setlogsock($sock_type) };
is( $@, '', "setlogsock() called with '$sock_type'" );
TODO: {
local $TODO = "minor bug";
ok( $r, "setlogsock() should return true: '$r'" );
}
# open syslog with a "local0" facility
SKIP: {
# openlog()
$r = eval { openlog('perl', 'ndelay', 'local0') } || 0;
skip "can't connect to syslog", 6 if $@ =~ /^no connection to syslog available/;
is( $@, '', "openlog() called with facility 'local0'" );
ok( $r, "openlog() should return true: '$r'" );
# syslog()
$r = eval { syslog('info', "$test_string by connecting to a $sock_type socket") } || 0;
is( $@, '', "syslog() called with level 'info'" );
ok( $r, "syslog() should return true: '$r'" );
# closelog()
$r = eval { closelog() } || 0;
is( $@, '', "closelog()" );
ok( $r, "closelog() should return true: '$r'" );
}
}
# try to open a syslog using all the available connection methods
for my $sock_type (qw(stream unix inet tcp udp console)) {
SKIP: {
# setlogsock()
$r = eval { setlogsock([$sock_type]) } || 0;
skip "can't use '$sock_type' socket", 16 unless $r;
is( $@, '', "setlogsock() called with '$sock_type'" );
ok( $r, "setlogsock() should return true: '$r'" );
# openlog() without option NDELAY
$r = eval { openlog('perl', '', 'local0') } || 0;
skip "can't connect to syslog", 14 if $@ =~ /^no connection to syslog available/;
is( $@, '', "openlog() called with facility 'local0' and without option 'ndelay'" );
ok( $r, "openlog() should return true: '$r'" );
# openlog() with the option NDELAY
$r = eval { openlog('perl', 'ndelay', 'local0') } || 0;
skip "can't connect to syslog", 12 if $@ =~ /^no connection to syslog available/;
is( $@, '', "openlog() called with facility 'local0' with option 'ndelay'" );
ok( $r, "openlog() should return true: '$r'" );
# syslog() with level "info" (as a string), should pass
$r = eval { syslog('info', "$test_string by connecting to a $sock_type socket") } || 0;
is( $@, '', "syslog() called with level 'info'" );
ok( $r, "syslog() should return true: '$r'" );
# syslog() with level "info" (as a macro), should pass
$r = eval { syslog(LOG_INFO, "$test_string by connecting to a $sock_type socket") } || 0;
is( $@, '', "syslog() called with level 'info'" );
ok( $r, "syslog() should return true: '$r'" );
# syslog() with facility "kern" (as a string), should fail
$r = eval { syslog('kern', "$test_string by connecting to a $sock_type socket") } || 0;
like( $@, '/^syslog: invalid level/facility: kern/', "syslog() called with facility 'kern'" );
ok( !$r, "syslog() should return false: '$r'" );
# syslog() with facility "kern" (as a macro), should fail
$r = eval { syslog(LOG_KERN, "$test_string by connecting to a $sock_type socket") } || 0;
like( $@, '/^syslog: invalid level/facility: 0/', "syslog() called with facility 'kern'" );
ok( !$r, "syslog() should return false: '$r'" );
SKIP: {
skip "skipping closelog() tests for 'console'", 2 if $sock_type eq 'console';
# closelog()
$r = eval { closelog() } || 0;
is( $@, '', "closelog()" );
ok( $r, "closelog() should return true: '$r'" );
}
}
}
# setlogmask()
{
my $oldmask = 0;
$oldmask = eval { setlogmask(0) } || 0;
is( $@, '', "setlogmask() called with a null mask" );
$r = eval { setlogmask(0) } || 0;
is( $@, '', "setlogmask() called with a null mask (second time)" );
is( $r, $oldmask, "setlogmask() must return the same mask as previous call");
for my $newmask ( LOG_ERR , LOG_CRIT|LOG_ERR|LOG_WARNING ) {
$r = eval { setlogmask($newmask) } || 0;
is( $@, '', "setlogmask() called with a new mask" );
is( $r, $oldmask, "setlogmask() must return the same mask as previous call");
$r = eval { setlogmask(0) } || 0;
is( $@, '', "setlogmask() called with a null mask" );
is( $r, $newmask, "setlogmask() must return the new mask");
setlogmask($oldmask);
}
}
--- NEW FILE: constants.t ---
#!/usr/bin/perl -T
use strict;
use File::Spec;
use Test::More;
my $macrosall = $ENV{PERL_CORE} ? File::Spec->catfile(qw(.. ext Sys Syslog macros.all))
: 'macros.all';
open(MACROS, $macrosall) or plan skip_all => "can't read '$macrosall': $!";
my @names = map {chomp;$_} <MACROS>;
close(MACROS);
plan tests => @names * 2 + 2;
my $callpack = my $testpack = 'Sys::Syslog';
eval "use $callpack";
eval "${callpack}::This()";
like( $@, "/^This is not a valid $testpack macro/", "trying a non-existing macro");
eval "${callpack}::NOSUCHNAME()";
like( $@, "/^NOSUCHNAME is not a valid $testpack macro/", "trying a non-existing macro");
# Testing all macros
if(@names) {
for my $name (@names) {
SKIP: {
$name =~ /^(\w+)$/ or skip "invalid name '$name'", 2;
$name = $1;
my $v = eval "${callpack}::$name()";
if(defined($v) && $v =~ /^\d+$/) {
is( $@, '', "calling the constant $name as a function" );
like( $v, '/^\d+$/', "checking that $name is a number ($v)" );
} else {
like( $@, "/^Your vendor has not defined $testpack macro $name/",
"calling the constant via its name" );
skip "irrelevant test in this case", 1
}
}
}
}
More information about the dslinux-commit
mailing list