X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fop%2Fgroups.t;h=695f9897539895e734106a4582c8146801c3f1d9;hb=69938bbac29d5bcb76b80f6eccb27c5ff84cee37;hp=8c146499d28ba47fd1f19806b26a959e1ddf4e5e;hpb=dd570ea6ed120327ae1b94a6071154a927352720;p=p5sagit%2Fp5-mst-13.2.git diff --git a/t/op/groups.t b/t/op/groups.t index 8c14649..695f989 100755 --- a/t/op/groups.t +++ b/t/op/groups.t @@ -5,11 +5,28 @@ $ENV{PATH} ="/bin:/usr/bin:/usr/xpg4/bin:/usr/ucb" . $ENV{LC_ALL} = "C"; # so that external utilities speak English $ENV{LANGUAGE} = 'C'; # GNU locale extension +BEGIN { + chdir 't'; + @INC = '../lib'; + + require Config; + if ($@) { + print "1..0 # Skip: no Config\n"; + } else { + Config->import; + } +} + sub quit { print "1..0 # Skip: no `id` or `groups`\n"; exit 0; } +unless (eval { getgrgid(0); 1 }) { + print "1..0 # Skip: getgrgid() not implemented\n"; + exit 0; +} + quit() if (($^O eq 'MSWin32' || $^O eq 'NetWare') or $^O =~ /lynxos/i); # We have to find a command that prints all (effective @@ -56,7 +73,7 @@ GROUPS: { # # If these tests fail, report the particular incantation you use # on this platform to find *all* the groups that an arbitrary -# luser may belong to, using the 'perlbug' program. +# user may belong to, using the 'perlbug' program. EOM } last GROUPS; @@ -65,11 +82,6 @@ EOM quit(); } -unless (eval { getgrgid(0); 1 }) { - print "1..0 # Skip: getgrgid() not implemented\n"; - exit 0; -} - chomp($groups); print "# groups = $groups\n"; @@ -104,18 +116,13 @@ print "1..2\n"; $pwgid = $( + 0; ($pwgnam) = getgrgid($pwgid); -if ($^O eq 'cygwin') { # basegroup on Cygwin has id = 0. - @basegroup{$pwgid,$pwgnam} = (0,0); -} else { - @basegroup{$pwgid,$pwgnam} = (1,1); -} $seen{$pwgid}++; print "# pwgid = $pwgid, pwgnam = $pwgnam\n"; for (split(' ', $()) { - next if $seen{$_}++; ($group) = getgrgid($_); + next if (! defined $group or ! grep { $_ eq $group } @gr) and $seen{$_}++; if (defined $group) { push(@gr, $group); } @@ -126,19 +133,35 @@ for (split(' ', $()) { print "# gr = @gr\n"; -if ($^O =~ /^(?:uwin|solaris)$/) { +if ($^O =~ /^(?:uwin|cygwin|solaris)$/) { # Or anybody else who can have spaces in group names. $gr1 = join(' ', grep(!$did{$_}++, sort split(' ', join(' ', @gr)))); } else { $gr1 = join(' ', sort @gr); } +if ($Config{myuname} =~ /^cygwin_nt/i) { # basegroup on CYGWIN_NT has id = 0. + @basegroup{$pwgid,$pwgnam} = (0,0); +} else { + @basegroup{$pwgid,$pwgnam} = (1,1); +} $gr2 = join(' ', grep(!$basegroup{$_}++, sort split(' ',$groups))); +my $ok1 = 0; if ($gr1 eq $gr2 || ($gr1 eq '' && $gr2 eq $pwgid)) { print "ok 1\n"; + $ok1++; } -else { +elsif ($Config{myuname} =~ /^cygwin_nt/i) { # basegroup on CYGWIN_NT has id = 0. + # Retry in default unix mode + %basegroup = ( $pwgid => 1, $pwgnam => 1 ); + $gr2 = join(' ', grep(!$basegroup{$_}++, sort split(' ',$groups))); + if ($gr1 eq $gr2 || ($gr1 eq '' && $gr2 eq $pwgid)) { + print "ok 1 # This Cygwin behaves like Unix (Win2k?)\n"; + $ok1++; + } +} +unless ($ok1) { print "#gr1 is <$gr1>\n"; print "#gr2 is <$gr2>\n"; print "not ok 1\n";