| 1 | #!./perl
|
|---|
| 2 |
|
|---|
| 3 | BEGIN {
|
|---|
| 4 | chdir 't' if -d 't';
|
|---|
| 5 | @INC = '../lib';
|
|---|
| 6 | }
|
|---|
| 7 |
|
|---|
| 8 | BEGIN {
|
|---|
| 9 | our $haspw;
|
|---|
| 10 | eval { my @n = getpwuid 0 };
|
|---|
| 11 | $haspw = 1 unless $@ && $@ =~ /unimplemented/;
|
|---|
| 12 | unless ($haspw) { print "1..0 # Skip: no getpwuid\n"; exit 0 }
|
|---|
| 13 | use Config;
|
|---|
| 14 | # VMS's pwd.h struct passwd conflicts with the one in vmsish.h
|
|---|
| 15 | $haspw = 0 unless ( $Config{'i_pwd'} eq 'define' || $^O eq 'VMS' );
|
|---|
| 16 | unless ($haspw) { print "1..0 # Skip: no pwd.h\n"; exit 0 }
|
|---|
| 17 | }
|
|---|
| 18 |
|
|---|
| 19 | BEGIN {
|
|---|
| 20 | our $uid = 0;
|
|---|
| 21 | # On VMS getpwuid(0) may return [$gid,0] UIC info (which may not exist).
|
|---|
| 22 | # It is better to use the $< uid for testing on VMS instead.
|
|---|
| 23 | if ( $^O eq 'VMS' ) { $uid = $< ; }
|
|---|
| 24 | our @pwent = getpwuid $uid; # This is the function getpwuid.
|
|---|
| 25 | unless (@pwent) { print "1..0 # Skip: no uid $uid\n"; exit 0 }
|
|---|
| 26 | }
|
|---|
| 27 |
|
|---|
| 28 | print "1..9\n";
|
|---|
| 29 |
|
|---|
| 30 | use User::pwent;
|
|---|
| 31 |
|
|---|
| 32 | print "ok 1\n";
|
|---|
| 33 |
|
|---|
| 34 | my $pwent = getpwuid $uid; # This is the OO getpwuid.
|
|---|
| 35 |
|
|---|
| 36 | my $uid_expect = $uid;
|
|---|
| 37 | if ( $^O eq 'cygwin' ) {
|
|---|
| 38 | print "not " unless ( $pwent->uid == $uid_expect
|
|---|
| 39 | || $pwent->uid == 500 ); # go figure
|
|---|
| 40 | }
|
|---|
| 41 | else {
|
|---|
| 42 | print "not " unless $pwent->uid == $uid_expect ;
|
|---|
| 43 | }
|
|---|
| 44 | print "ok 2\n";
|
|---|
| 45 |
|
|---|
| 46 | print "not " unless $pwent->name eq $pwent[0];
|
|---|
| 47 | print "ok 3\n";
|
|---|
| 48 |
|
|---|
| 49 | if ($^O eq 'os390') {
|
|---|
| 50 | print "not "
|
|---|
| 51 | unless not defined $pwent->passwd &&
|
|---|
| 52 | $pwent[1] eq '0'; # go figure
|
|---|
| 53 | } else {
|
|---|
| 54 | print "not " unless $pwent->passwd eq $pwent[1];
|
|---|
| 55 | }
|
|---|
| 56 | print "ok 4\n";
|
|---|
| 57 |
|
|---|
| 58 | print "not " unless $pwent->uid == $pwent[2];
|
|---|
| 59 | print "ok 5\n";
|
|---|
| 60 |
|
|---|
| 61 | print "not " unless $pwent->gid == $pwent[3];
|
|---|
| 62 | print "ok 6\n";
|
|---|
| 63 |
|
|---|
| 64 | # The quota and comment fields are unportable.
|
|---|
| 65 |
|
|---|
| 66 | print "not " unless $pwent->gecos eq $pwent[6];
|
|---|
| 67 | print "ok 7\n";
|
|---|
| 68 |
|
|---|
| 69 | print "not " unless $pwent->dir eq $pwent[7];
|
|---|
| 70 | print "ok 8\n";
|
|---|
| 71 |
|
|---|
| 72 | print "not " unless $pwent->shell eq $pwent[8];
|
|---|
| 73 | print "ok 9\n";
|
|---|
| 74 |
|
|---|
| 75 | # The expire field is unportable.
|
|---|
| 76 |
|
|---|
| 77 | # Testing pretty much anything else is unportable:
|
|---|
| 78 | # there maybe more than one username with uid 0;
|
|---|
| 79 | # uid 0's home directory may be "/" or "/root' or something else,
|
|---|
| 80 | # and so on.
|
|---|
| 81 |
|
|---|