This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
U/WIN testsuite patches from Joe Buehler <jhpb@hekimian.com>
[perl5.git] / t / op / groups.t
1 #!./perl
2
3 if (! -x ($groups = '/usr/ucb/groups') &&
4     ! -x ($groups = '/usr/bin/groups') &&
5     ! -x ($groups = '/bin/groups')
6 ) {
7     print "1..0\n";
8     exit 0;
9 }
10
11 print "1..2\n";
12
13 $pwgid = $( + 0;
14 ($pwgnam) = getgrgid($pwgid);
15 @basegroup{$pwgid,$pwgnam} = (1,1);
16
17 $seen{$pwgid}++;
18
19 for (split(' ', $()) {
20     next if $seen{$_}++;
21     ($group) = getgrgid($_);
22     if (defined $group) {
23         push(@gr, $group);
24     }
25     else {
26         push(@gr, $_);
27     }
28
29
30 if ($^O eq "uwin") {
31         $gr1 = join(' ', grep(!$did{$_}++, sort split(' ', join(' ', @gr))));
32 } else {
33         $gr1 = join(' ', sort @gr);
34 }
35
36 $gr2 = join(' ', grep(!$basegroup{$_}++, sort split(' ',`$groups`)));
37
38 if ($gr1 eq $gr2) {
39     print "ok 1\n";
40 }
41 else {
42     print "#gr1 is <$gr1>\n";
43     print "#gr2 is <$gr2>\n";
44     print "not ok 1\n";
45 }
46
47 # multiple 0's indicate GROUPSTYPE is currently long but should be short
48
49 if ($pwgid == 0 || $seen{0} < 2) {
50     print "ok 2\n";
51 }
52 else {
53     print "not ok 2 (groupstype should be type short, not long)\n";
54 }