Properly return a syntax error instead of segfaulting if each/keys/values is used...

[p5sagit/p5-mst-13.2.git] / t / op / groups.t

diff --git a/t/op/groups.t b/t/op/groups.t
old mode 100755 (executable)
new mode 100644 (file)
index 77dbb2b..404b8cd
--- a/t/op/groups.t
+++ b/t/op/groups.t
@@ -1,7 +1,7 @@
 #!./perl
 
 $ENV{PATH} ="/bin:/usr/bin:/usr/xpg4/bin:/usr/ucb" .
-    exists $ENV{PATH} ? ":$ENV{PATH}" : "";
+    exists $ENV{PATH} ? ":$ENV{PATH}" : "" unless $^O eq 'VMS';
 $ENV{LC_ALL} = "C"; # so that external utilities speak English
 $ENV{LANGUAGE} = 'C'; # GNU locale extension
 
@@ -27,7 +27,8 @@ unless (eval { getgrgid(0); 1 }) {
     exit 0;
 }
 
-quit() if (($^O eq 'MSWin32' || $^O eq 'NetWare') or $^O =~ /lynxos/i);
+quit() if (($^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'VMS')
+           or $^O =~ /lynxos/i);
 
 # We have to find a command that prints all (effective
 # and real) group names (not ids).  The known commands are:
@@ -56,6 +57,8 @@ GROUPS: {
     if (($groups = `id -a 2>/dev/null`) ne '') {
        # $groups is of the form:
        # uid=39957(gsar) gid=22(users) groups=33536,39181,22(users),0(root),1067(dev)
+       # FreeBSD since 6.2 has a fake id -a:
+       # uid=1001(tobez) gid=20(staff) groups=20(staff), 0(wheel), 68(dialer)
        last GROUPS if $groups =~ /groups=/;
     }
     if (($groups = `id -Gn 2>/dev/null`) ne '') {
@@ -90,15 +93,15 @@ print "# groups = $groups\n";
 # That is: do not \w, do not \S.
 if ($groups =~ /groups=(.+)( [ug]id=|$)/) {
     my $gr = $1;
-    my @g0 = split /,/, $gr;
+    my @g0 = split /, ?/, $gr;
     my @g1;
     # prefer names over numbers
     for (@g0) {
-        # 42(zot me)
+       # 42(zot me)
        if (/^(\d+)(?:\(([^)]+)\))?/) {
            push @g1, ($2 || $1);
        }
-        # zot me(42)
+       # zot me(42)
        elsif (/^([^(]*)\((\d+)\)/) {
            push @g1, ($1 || $2);
        }
@@ -121,23 +124,25 @@ $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);
     }
     else {
        push(@gr, $_);
     }
-} 
+}
 
 print "# gr = @gr\n";
 
-if ($^O =~ /^(?:uwin|solaris)$/) {
+my %did;
+if ($^O =~ /^(?:uwin|cygwin|interix|solaris|linux)$/) {
        # Or anybody else who can have spaces in group names.
        $gr1 = join(' ', grep(!$did{$_}++, sort split(' ', join(' ', @gr))));
 } else {
-       $gr1 = join(' ', sort @gr);
+       # Don't assume that there aren't duplicate groups
+       $gr1 = join(' ', sort grep defined $_ && !$did{$_}++, @gr);
 }
 
 if ($Config{myuname} =~ /^cygwin_nt/i) { # basegroup on CYGWIN_NT has id = 0.