$ENV{LC_ALL} = "C"; # so that external utilities speak English
$ENV{LANGUAGE} = 'C'; # GNU locale extension
- chdir 't';
- @INC = '../lib';
+ chdir 't' if -d 't';
+ require './test.pl';
+ set_up_inc( '../lib' );
+ skip_all_if_miniperl("no dynamic loading on miniperl, no POSIX");
}
+
use 5.010;
use strict;
use Config ();
use POSIX ();
-unless (eval { my($foo) = getgrgid(0); 1 }) {
- quit( "getgrgid() not implemented" );
-}
+skip_all('getgrgid() not implemented')
+ unless eval { my($foo) = getgrgid(0); 1 };
-quit("No `id' or `groups'") if
- $^O eq 'MSWin32'
- || $^O eq 'NetWare'
- || $^O eq 'VMS'
- || $^O =~ /lynxos/i;
+skip_all("No 'id' or 'groups'") if
+ $^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'VMS' || $^O =~ /lynxos/i;
Test();
exit;
# Get our supplementary groups from the system by running commands
# like `id -a'.
my ( $groups_command, $groups_string ) = system_groups()
- or quit( "No `id' or `groups'" );
+ or skip_all("No 'id' or 'groups'");
my @extracted_groups = extract_system_groups( $groups_string )
- or quit( "Can't parse `${groups_command}'" );
+ or skip_all("Can't parse '${groups_command}'");
my $pwgid = $( + 0;
my ($pwgnam) = getgrgid($pwgid);
$pwgnam //= '';
- print "# pwgid=$pwgid pwgnam=$pwgnam \$(=$(\n";
+ note "pwgid=$pwgid pwgnam=$pwgnam \$(=$(";
# Get perl's supplementary groups by looking at $(
my ( $gid_count, $all_perl_groups ) = perl_groups();
my %basegroup = basegroups( $pwgid, $pwgnam );
my @extracted_supplementary_groups = remove_basegroup( \ %basegroup, \ @extracted_groups );
- print "1..2\n";
+ plan 2;
# Test: The supplementary groups in $( should match the
# getgroups(2) kernal API call.
#
- my $ngroups_max = posix_ngroups_max();
- if ( defined $ngroups_max && $ngroups_max < @extracted_groups ) {
- # Some OSes (like darwin)but conceivably others might return
- # more groups from `id -a' than can be handled by the
- # kernel. On darwin, NGROUPS_MAX is 16 and 12 are taken up for
- # the system already.
- #
- # There is more fall-out from this than just Perl's unit
- # tests. You may be a member of a group according to Active
- # Directory (or whatever) but the OS won't respect it because
- # it's the 17th (or higher) group and there's no space to
- # store your membership.
- print "ok 1 # SKIP Your platform's `$groups_command' is broken\n";
- }
-
- elsif ( darwin() ) {
- # darwin uses getgrouplist(3) or an Open Directory API within
- # /usr/bin/id and /usr/bin/groups which while "nice" isn't
- # accurate for this test. The hard, real, list of groups we're
- # running in derives from getgroups(2) and is not dynamic but
- # the Libc API getgrouplist(3) is.
- #
- # In practical terms, this meant that while `id -a' can be
- # relied on in other OSes to purely use getgroups(2) and show
- # us what's real, darwin will use getgrouplist(3) to show us
- # what might be real if only we'd open a new console.
- #
- print "ok 1 # SKIP darwin's `${groups_command}' can't be trusted\n";
- }
+ SKIP: {
+ my $ngroups_max = posix_ngroups_max();
+ if ( defined $ngroups_max && $ngroups_max < @extracted_groups ) {
+ # Some OSes (like darwin)but conceivably others might return
+ # more groups from `id -a' than can be handled by the
+ # kernel. On darwin, NGROUPS_MAX is 16 and 12 are taken up for
+ # the system already.
+ #
+ # There is more fall-out from this than just Perl's unit
+ # tests. You may be a member of a group according to Active
+ # Directory (or whatever) but the OS won't respect it because
+ # it's the 17th (or higher) group and there's no space to
+ # store your membership.
+ skip "Your platform's `$groups_command' is broken";
+ }
- else {
+ if ( darwin() ) {
+ # darwin uses getgrouplist(3) or an Open Directory API within
+ # /usr/bin/id and /usr/bin/groups which while "nice" isn't
+ # accurate for this test. The hard, real, list of groups we're
+ # running in derives from getgroups(2) and is not dynamic but
+ # the Libc API getgrouplist(3) is.
+ #
+ # In practical terms, this meant that while `id -a' can be
+ # relied on in other OSes to purely use getgroups(2) and show
+ # us what's real, darwin will use getgrouplist(3) to show us
+ # what might be real if only we'd open a new console.
+ #
+ skip "darwin's `${groups_command}' can't be trusted";
+ }
# Read $( but ignore any groups in $( that we failed to parse
# successfully out of the `id -a` mess.
if ( match_groups( \ @supplementary_groups,
\ @extracted_supplementary_groups,
$pwgid ) ) {
- print "ok 1\n";
$ok1 = 1;
}
elsif ( cygwin_nt() ) {
if ( match_groups( \ @supplementary_groups,
\ @extracted_supplementary_groups,
$pwgid ) ) {
- print "ok 1 # This Cygwin behaves like Unix (Win2k?)\n";
+ note "This Cygwin behaves like Unix (Win2k?)";
$ok1 = 1;
}
}
- unless ( $ok1 ) {
-
- }
+ ok $ok1, "perl's `\$(' agrees with `${groups_command}'";
}
# multiple 0's indicate GROUPSTYPE is currently long but should be short
$gid_count->{0} //= 0;
- if ( 0 == $pwgid || $gid_count->{0} < 2 ) {
- print "ok 2\n";
- }
- else {
- print "not ok 2 (groupstype should be type short, not long)\n";
- }
+ ok 0 == $pwgid || $gid_count->{0} < 2, "groupstype should be type short, not long";
return;
}
-# Cleanly abort this entire test file
-sub quit {
- print "1..0 # SKIP: @_\n";
- exit 0;
-}
-
# Get the system groups and the command used to fetch them.
#
sub system_groups {
push @extracted, $+{gr_name} || $+{gid};
}
else {
- print "# ignoring group entry [$_]\n";
+ note "ignoring group entry [$_]";
}
}
@_;
}
-# Local variables:
-# indent-tabs-mode: nil
-# End:
-#
-# ex: set ts=8 sts=4 sw=4 noet:
+# ex: set ts=8 sts=4 sw=4 et:
https://perl5.git.perl.org / perl5.git / blobdiff