1850e2753Smillert#!./perl -w 2850e2753Smillert 3*898184e3Ssthenuse Test::More; 4850e2753Smillert 5850e2753Smillertuse File::Temp; 6*898184e3Ssthenuse File::Spec; 7*898184e3Ssthen 8850e2753Smillertuse Fcntl qw(:mode); 9850e2753Smillert 10850e2753Smillertmy $tmpfile = File::Temp->new; 11*898184e3Ssthenmy @tests = ( 12*898184e3Ssthen ['REG', 'tmpfile', (stat "$tmpfile")[2]], 13*898184e3Ssthen ['DIR', 'dir', (stat '.')[2]] 14*898184e3Ssthen ); 15*898184e3Ssthen 16*898184e3Ssthen$devnull = File::Spec->devnull(); 17*898184e3Ssthenif (-c $devnull) { 18*898184e3Ssthen push @tests, ['CHR', $devnull, (stat $devnull)[2]]; 19*898184e3Ssthen} 20*898184e3Ssthen 21*898184e3Ssthenplan(tests => 34 + 6 + 9 * @tests); 22*898184e3Ssthenforeach (@tests) { 23*898184e3Ssthen my ($type, $name, $mode) = @$_; 24*898184e3Ssthen 25*898184e3Ssthen if ($type eq 'REG') { 26*898184e3Ssthen ok( S_ISREG($mode), " S_ISREG $name"); 27*898184e3Ssthen } else { 28*898184e3Ssthen ok(!S_ISREG($mode), "!S_ISREG $name"); 29*898184e3Ssthen } 30*898184e3Ssthen 31*898184e3Ssthen if ($type eq 'DIR') { 32*898184e3Ssthen ok( S_ISDIR($mode), " S_ISDIR $name"); 33*898184e3Ssthen } else { 34*898184e3Ssthen ok(!S_ISDIR($mode), "!S_ISDIR $name"); 35*898184e3Ssthen } 36*898184e3Ssthen 37*898184e3Ssthen SKIP: { 38*898184e3Ssthen skip 'No S_IFCHR', 1 unless defined eval {S_IFCHR}; 39*898184e3Ssthen if ($type eq 'CHR') { 40*898184e3Ssthen ok( S_ISCHR($mode), " S_ISCHR $name"); 41*898184e3Ssthen } else { 42*898184e3Ssthen ok(!S_ISCHR($mode), "!S_ISCHR $name"); 43*898184e3Ssthen } 44*898184e3Ssthen } 45*898184e3Ssthen 46*898184e3Ssthen SKIP: { 47*898184e3Ssthen skip 'No S_IFLNK', 1 unless defined eval {S_IFLNK}; 48*898184e3Ssthen ok(!S_ISLNK($mode), "!S_ISLNK $name"); 49*898184e3Ssthen } 50*898184e3Ssthen SKIP: { 51*898184e3Ssthen skip 'No S_IFSOCK', 1 unless defined eval {S_IFSOCK}; 52*898184e3Ssthen ok(!S_ISSOCK($mode), "!S_ISSOCK $name"); 53*898184e3Ssthen } 54*898184e3Ssthen SKIP: { 55*898184e3Ssthen skip 'No S_IFBLK', 1 unless defined eval {S_IFBLK}; 56*898184e3Ssthen ok(!S_ISBLK($mode), "!S_ISBLK $name"); 57*898184e3Ssthen } 58*898184e3Ssthen SKIP: { 59*898184e3Ssthen skip 'No S_IFFIFO', 1 unless defined eval {S_IFFIFO}; 60*898184e3Ssthen ok(!S_ISFIFO($mode), "!S_ISFIFO $name"); 61*898184e3Ssthen } 62*898184e3Ssthen SKIP: { 63*898184e3Ssthen skip 'No S_IFWHT', 1 unless defined eval {S_IFWHT}; 64*898184e3Ssthen ok(!S_ISWHT($mode), "!S_ISWHT $name"); 65*898184e3Ssthen } 66*898184e3Ssthen SKIP: { 67*898184e3Ssthen skip 'No S_ENFMT', 1 unless defined eval {S_ENFMT}; 68*898184e3Ssthen ok(!S_ISENFMT($mode), "!S_ISENFMT $name"); 69*898184e3Ssthen } 70*898184e3Ssthen} 71*898184e3Ssthen 72*898184e3Ssthenforeach ([S_ISREG => \&S_ISREG], 73*898184e3Ssthen [S_IMODE => \&S_IMODE], 74*898184e3Ssthen ) { 75*898184e3Ssthen my ($name, $func) = @$_; 76*898184e3Ssthen my @warnings; 77*898184e3Ssthen my $ret; 78*898184e3Ssthen 79*898184e3Ssthen { 80*898184e3Ssthen local $SIG{__WARN__} = sub { push @warnings, "@_" }; 81*898184e3Ssthen $ret = &$func(); 82*898184e3Ssthen } 83*898184e3Ssthen ok(!$ret, "$name() is false"); 84*898184e3Ssthen is(scalar @warnings, 1, '1 warning'); 85*898184e3Ssthen like($warnings[0], qr/^Use of uninitialized value/, 'expected warning'); 86*898184e3Ssthen} 87*898184e3Ssthen 88*898184e3Ssthenis (S_IFMT(), _S_IFMT(), 'S_IFMT()'); 89*898184e3Ssthenis (S_IFMT(0), 0, 'S_IFMT(0)'); 90*898184e3Ssthenfor my $shift (0..31) { 91*898184e3Ssthen is (S_IFMT(1 << $shift), ((1 << $shift) & _S_IFMT()), "S_IFMT(1 << $shift)"); 92*898184e3Ssthen} 93