home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / t / op / stat.t < prev    next >
Encoding:
Text File  |  2000-02-25  |  8.4 KB  |  283 lines
  1. #!./perl
  2.  
  3. # $RCSfile: stat.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:28 $
  4.  
  5. BEGIN {
  6.     chdir 't' if -d 't';
  7.     unshift @INC, '../lib';
  8. }
  9.  
  10. use Config;
  11.  
  12. print "1..58\n";
  13.  
  14. $Is_MSWin32 = $^O eq 'MSWin32';
  15. $Is_Dos = $^O eq 'dos';
  16. $Is_Dosish = $Is_Dos || $^O eq 'os2' || $Is_MSWin32;
  17. $Is_Cygwin = $^O eq 'cygwin';
  18. chop($cwd = ($Is_MSWin32 ? `cd` : `pwd`));
  19.  
  20. $DEV = `ls -l /dev` unless $Is_Dosish or $Is_Cygwin;
  21.  
  22. unlink "Op.stat.tmp";
  23. if (open(FOO, ">Op.stat.tmp")) {
  24.   # hack to make Apollo update link count:
  25.   $junk = `ls Op.stat.tmp` unless ($Is_MSWin32 || $Is_Dos);
  26.  
  27.   ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
  28.    $blksize,$blocks) = stat(FOO);
  29.   if ($nlink == 1) {
  30.     print "ok 1\n";
  31.   }
  32.   else {
  33.     print "# res=$res, nlink=$nlink.\nnot ok 1\n";
  34.   }
  35.   if ($Is_MSWin32 or $Is_Cygwin || ($mtime && $mtime == $ctime)) {
  36.     print "ok 2\n";
  37.   }
  38.   else {
  39.     print "# |$mtime| vs |$ctime|\nnot ok 2\n";
  40.   }
  41.  
  42.   my $funky_FAT_timestamps = $Is_Cygwin;
  43.  
  44.   sleep 3 if $funky_FAT_timestamps;
  45.  
  46.   print FOO "Now is the time for all good men to come to.\n";
  47.   close(FOO);
  48.  
  49.   sleep 2 unless $funky_FAT_timestamps;
  50.  
  51. } else {
  52.   print "# open failed: $!\nnot ok 1\nnot ok 2\n";
  53. }
  54.  
  55. if ($Is_Dosish) { unlink "Op.stat.tmp2"}
  56. else {
  57.     `rm -f Op.stat.tmp2;ln Op.stat.tmp Op.stat.tmp2; chmod 644 Op.stat.tmp`;
  58. }
  59.  
  60. ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
  61.     $blksize,$blocks) = stat('Op.stat.tmp');
  62.  
  63. if ($Is_Dosish || $Config{dont_use_nlink})
  64.     {print "ok 3 # skipped: no link count\n";} 
  65. elsif ($nlink == 2)
  66.     {print "ok 3\n";} 
  67. else {print "# \$nlink is |$nlink|\nnot ok 3\n";}
  68.  
  69. if (   $Is_Dosish
  70.         # Solaris tmpfs bug
  71.     || ($cwd =~ m#^/tmp# and $mtime && $mtime==$ctime && $^O eq 'solaris')
  72.     || $cwd =~ m#/afs/#
  73.     || $^O eq 'amigaos') {
  74.     print "ok 4 # skipped: different semantic of mtime/ctime\n";
  75. }
  76. elsif (   ($mtime && $mtime != $ctime)  ) {
  77.     print "ok 4\n";
  78. }
  79. else {
  80.     print "not ok 4\n";
  81.     print "#4 If test op/stat.t fails test 4, check if you are on a tmpfs\n";
  82.     print "#4 of some sort.  Building in /tmp sometimes has this problem.\n";
  83. }
  84. print "#4    :$mtime: should != :$ctime:\n";
  85.  
  86. unlink "Op.stat.tmp" or print "# unlink failed: $!\n";
  87. if ($Is_MSWin32) {  open F, '>Op.stat.tmp' and close F }
  88. else             { `touch Op.stat.tmp` }
  89.  
  90. if (-z 'Op.stat.tmp') {print "ok 5\n";} else {print "not ok 5\n";}
  91. if (! -s 'Op.stat.tmp') {print "ok 6\n";} else {print "not ok 6\n";}
  92.  
  93. $Is_MSWin32 ? `cmd /c echo hi > Op.stat.tmp` : `echo hi >Op.stat.tmp`;
  94. if (! -z 'Op.stat.tmp') {print "ok 7\n";} else {print "not ok 7\n";}
  95. if (-s 'Op.stat.tmp') {print "ok 8\n";} else {print "not ok 8\n";}
  96.  
  97. unlink 'Op.stat.tmp' or print "# unlink failed: $!\n";
  98. $olduid = $>;        # can't test -r if uid == 0
  99. $Is_MSWin32 ? `cmd /c echo hi > Op.stat.tmp` : `echo hi >Op.stat.tmp`;
  100. chmod 0,'Op.stat.tmp';
  101. eval '$> = 1;';        # so switch uid (may not be implemented)
  102. if (!$> || $Is_Dos || ! -r 'Op.stat.tmp') {print "ok 9\n";} else {print "not ok 9\n";}
  103. if (!$> || ! -w 'Op.stat.tmp') {print "ok 10\n";} else {print "not ok 10\n";}
  104. eval '$> = $olduid;';        # switch uid back (may not be implemented)
  105. print "# olduid=$olduid, newuid=$>\n" unless ($> == $olduid);
  106.  
  107. if (! -x 'Op.stat.tmp') {print "ok 11\n";}
  108. else                    {print "not ok 11\n";}
  109.  
  110. foreach ((12,13,14,15,16,17)) {
  111.     print "ok $_\n";        #deleted tests
  112. }
  113.  
  114. # in ms windows, Op.stat.tmp inherits owner uid from directory
  115. # not sure about os/2, but chown is harmless anyway
  116. eval { chown $>,'Op.stat.tmp'; 1 } or print "# $@" ;
  117. chmod 0700,'Op.stat.tmp';
  118. if (-r 'Op.stat.tmp') {print "ok 18\n";} else {print "not ok 18\n";}
  119. if (-w 'Op.stat.tmp') {print "ok 19\n";} else {print "not ok 19\n";}
  120. if ($Is_Dosish) {print "ok 20 # skipped: -x by extension\n";} 
  121. elsif (-x 'Op.stat.tmp') {print "ok 20\n";} 
  122. else {print "not ok 20\n";}
  123.  
  124. if (-f 'Op.stat.tmp') {print "ok 21\n";} else {print "not ok 21\n";}
  125. if (! -d 'Op.stat.tmp') {print "ok 22\n";} else {print "not ok 22\n";}
  126.  
  127. if (-d '.') {print "ok 23\n";} else {print "not ok 23\n";}
  128. if (! -f '.') {print "ok 24\n";} else {print "not ok 24\n";}
  129.  
  130. if (!$Is_Dosish and `ls -l perl` =~ /^l.*->/) {
  131.     if (-l 'perl') {print "ok 25\n";} else {print "not ok 25\n";}
  132. }
  133. else {
  134.     print "ok 25\n";
  135. }
  136.  
  137. if (-o 'Op.stat.tmp') {print "ok 26\n";} else {print "not ok 26\n";}
  138.  
  139. if (-e 'Op.stat.tmp') {print "ok 27\n";} else {print "not ok 27\n";}
  140. unlink 'Op.stat.tmp2';
  141. if (! -e 'Op.stat.tmp2') {print "ok 28\n";} else {print "not ok 28\n";}
  142.  
  143. if ($Is_MSWin32 || $Is_Dos)
  144.     {print "ok 29\n";}
  145. elsif ($DEV !~ /\nc.* (\S+)\n/)
  146.     {print "ok 29\n";}
  147. elsif (-c "/dev/$1")
  148.     {print "ok 29\n";}
  149. else
  150.     {print "not ok 29\n";}
  151. if (! -c '.') {print "ok 30\n";} else {print "not ok 30\n";}
  152.  
  153. if ($Is_MSWin32 || $Is_Dos)
  154.     {print "ok 31\n";}
  155. elsif ($DEV !~ /\ns.* (\S+)\n/)
  156.     {print "ok 31\n";}
  157. elsif (-S "/dev/$1")
  158.     {print "ok 31\n";}
  159. else
  160.     {print "not ok 31\n";}
  161. if (! -S '.') {print "ok 32\n";} else {print "not ok 32\n";}
  162.  
  163. if ($Is_MSWin32 || $Is_Dos)
  164.     {print "ok 33\n";}
  165. elsif ($DEV !~ /\nb.* (\S+)\n/)
  166.     {print "ok 33\n";}
  167. elsif (-b "/dev/$1")
  168.     {print "ok 33\n";}
  169. else
  170.     {print "not ok 33\n";}
  171. if (! -b '.') {print "ok 34\n";} else {print "not ok 34\n";}
  172.  
  173. if ($^O eq 'mpeix' or $^O eq 'amigaos' or $Is_Dosish or $Is_Cygwin) {
  174.   print "ok 35 # skipped: no -u\n"; goto tty_test;
  175. }
  176.  
  177. $cnt = $uid = 0;
  178.  
  179. die "Can't run op/stat.t test 35 without pwd working" unless $cwd;
  180. ($bin) = grep {-d} ($^O eq 'machten' ? qw(/usr/bin /bin) : qw(/bin /usr/bin))
  181.     or print ("not ok 35\n"), goto tty_test;
  182. opendir BIN, $bin or die "Can't opendir $bin: $!";
  183. while (defined($_ = readdir BIN)) {
  184.     $_ = "$bin/$_";
  185.     $cnt++;
  186.     $uid++ if -u;
  187.     last if $uid && $uid < $cnt;
  188. }
  189. closedir BIN;
  190.  
  191. # I suppose this is going to fail somewhere...
  192. if ($uid > 0 && $uid < $cnt)
  193.     {print "ok 35\n";}
  194. else
  195.     {print "not ok 35 \n# ($uid $cnt)\n";}
  196.  
  197. tty_test:
  198.  
  199. # To assist in automated testing when a controlling terminal (/dev/tty)
  200. # may not be available (at, cron  rsh etc), the PERL_SKIP_TTY_TEST env var
  201. # can be set to skip the tests that need a tty.
  202. unless($ENV{PERL_SKIP_TTY_TEST}) {
  203.     if ($Is_MSWin32) {
  204.     print "ok 36\n";
  205.     print "ok 37\n";
  206.     }
  207.     else {
  208.     my $TTY = "/dev/tty";
  209.  
  210.     $TTY = "/dev/ttyp0" if $^O eq 'rhapsody';
  211.  
  212.     if (defined $TTY) {
  213.         unless (open(TTY, $TTY)) {
  214.         print STDERR "Can't open $TTY--run t/TEST outside of make.\n";
  215.         }
  216.         if (-t TTY) {print "ok 36\n";} else {print "not ok 36\n";}
  217.         if (-c TTY) {print "ok 37\n";} else {print "not ok 37\n";}
  218.         close(TTY);
  219.     } else { # if some platform completely undefines $TTY
  220.         print "ok 36 # skipped\n";
  221.         print "ok 37 # skipped\n";
  222.     }
  223.     }
  224.     if (! -t TTY) {print "ok 38\n";} else {print "not ok 38\n";}
  225.     if (-t)       {print "ok 39\n";} else {print "not ok 39\n";}
  226. }
  227. else {
  228.     print "ok 36\n";
  229.     print "ok 37\n";
  230.     print "ok 38\n";
  231.     print "ok 39\n";
  232. }
  233. open(null,"/dev/null");
  234. if (! -t null || -e '/xenix' || $^O eq 'machten' || $Is_MSWin32)
  235.     {print "ok 40\n";} else {print "not ok 40\n";}
  236. close(null);
  237.  
  238. # These aren't strictly "stat" calls, but so what?
  239.  
  240. if (-T 'op/stat.t') {print "ok 41\n";} else {print "not ok 41\n";}
  241. if (! -B 'op/stat.t') {print "ok 42\n";} else {print "not ok 42\n";}
  242.  
  243. if (-B './perl' || -B './perl.exe') {print "ok 43\n";} else {print "not ok 43\n";}
  244. if (! -T './perl' && ! -T './perl.exe') {print "ok 44\n";} else {print "not ok 44\n";}
  245.  
  246. open(FOO,'op/stat.t');
  247. eval { -T FOO; };
  248. if ($@ =~ /not implemented/) {
  249.     print "# $@";
  250.     for (45 .. 54) {
  251.     print "ok $_\n";
  252.     }
  253. }
  254. else {
  255.     if (-T FOO) {print "ok 45\n";} else {print "not ok 45\n";}
  256.     if (! -B FOO) {print "ok 46\n";} else {print "not ok 46\n";}
  257.     $_ = <FOO>;
  258.     if (/perl/) {print "ok 47\n";} else {print "not ok 47\n";}
  259.     if (-T FOO) {print "ok 48\n";} else {print "not ok 48\n";}
  260.     if (! -B FOO) {print "ok 49\n";} else {print "not ok 49\n";}
  261.     close(FOO);
  262.  
  263.     open(FOO,'op/stat.t');
  264.     $_ = <FOO>;
  265.     if (/perl/) {print "ok 50\n";} else {print "not ok 50\n";}
  266.     if (-T FOO) {print "ok 51\n";} else {print "not ok 51\n";}
  267.     if (! -B FOO) {print "ok 52\n";} else {print "not ok 52\n";}
  268.     seek(FOO,0,0);
  269.     if (-T FOO) {print "ok 53\n";} else {print "not ok 53\n";}
  270.     if (! -B FOO) {print "ok 54\n";} else {print "not ok 54\n";}
  271. }
  272. close(FOO);
  273.  
  274. if (-T '/dev/null') {print "ok 55\n";} else {print "not ok 55\n";}
  275. if (-B '/dev/null') {print "ok 56\n";} else {print "not ok 56\n";}
  276.  
  277. # and now, a few parsing tests:
  278. $_ = 'Op.stat.tmp';
  279. if (-f) {print "ok 57\n";} else {print "not ok 57\n";}
  280. if (-f()) {print "ok 58\n";} else {print "not ok 58\n";}
  281.  
  282. unlink 'Op.stat.tmp' or print "# unlink failed: $!\n";
  283.