"Fossies" - the Fresh Open Source Software Archive

Member "Time-HiRes-1.9760/t/stat.t" (18 Feb 2019, 2461 Bytes) of package /linux/privat/Time-HiRes-1.9760.tar.gz:


As a special service "Fossies" has tried to format the requested text file into HTML format (style: standard) with prefixed line numbers. Alternatively you can here view or download the uninterpreted source code file.

    1 use strict;
    2 
    3 BEGIN {
    4     require Time::HiRes;
    5     unless(&Time::HiRes::d_hires_stat) {
    6 	require Test::More;
    7 	Test::More::plan(skip_all => "no hi-res stat");
    8     }
    9     if($^O =~ /\A(?:cygwin|MSWin)/) {
   10 	require Test::More;
   11 	Test::More::plan(skip_all =>
   12 		"$^O file timestamps not reliable enough for stat test");
   13     }
   14 }
   15 
   16 use Test::More tests => 43;
   17 BEGIN { push @INC, '.' }
   18 use t::Watchdog;
   19 
   20 my @atime;
   21 my @mtime;
   22 for (1..5) {
   23     Time::HiRes::sleep(rand(0.1) + 0.1);
   24     open(X, '>', $$);
   25     print X $$;
   26     close(X);
   27     my($a, $stat, $b) = ("a", [Time::HiRes::stat($$)], "b");
   28     is $a, "a";
   29     is $b, "b";
   30     is ref($stat), "ARRAY";
   31     push @mtime, $stat->[9];
   32     ($a, my $lstat, $b) = ("a", [Time::HiRes::lstat($$)], "b");
   33     is $a, "a";
   34     is $b, "b";
   35     is_deeply $lstat, $stat;
   36     Time::HiRes::sleep(rand(0.1) + 0.1);
   37     open(X, '<', $$);
   38     <X>;
   39     close(X);
   40     $stat = [Time::HiRes::stat($$)];
   41     push @atime, $stat->[8];
   42     $lstat = [Time::HiRes::lstat($$)];
   43     is_deeply $lstat, $stat;
   44 }
   45 1 while unlink $$;
   46 print("# mtime = @mtime\n");
   47 print("# atime = @atime\n");
   48 my $ai = 0;
   49 my $mi = 0;
   50 my $ss = 0;
   51 for (my $i = 1; $i < @atime; $i++) {
   52     if ($atime[$i] >= $atime[$i-1]) {
   53 	$ai++;
   54     }
   55     if ($atime[$i] > int($atime[$i])) {
   56 	$ss++;
   57     }
   58 }
   59 for (my $i = 1; $i < @mtime; $i++) {
   60     if ($mtime[$i] >= $mtime[$i-1]) {
   61 	$mi++;
   62     }
   63     if ($mtime[$i] > int($mtime[$i])) {
   64 	$ss++;
   65     }
   66 }
   67 print("# ai = $ai, mi = $mi, ss = $ss\n");
   68 # Need at least 75% of monotonical increase and
   69 # 20% of subsecond results. Yes, this is guessing.
   70 SKIP: {
   71     skip "no subsecond timestamps detected", 1 if $ss == 0;
   72     ok $mi/(@mtime-1) >= 0.75 && $ai/(@atime-1) >= 0.75 &&
   73 	     $ss/(@mtime+@atime) >= 0.2;
   74 }
   75 
   76 my $targetname = "tgt$$";
   77 my $linkname = "link$$";
   78 SKIP: {
   79     open(X, '>', $targetname);
   80     print X $$;
   81     close(X);
   82     eval { symlink $targetname, $linkname or die "can't symlink: $!"; };
   83     skip "can't symlink", 7 if $@ ne "";
   84     my @tgt_stat = Time::HiRes::stat($targetname);
   85     my @tgt_lstat = Time::HiRes::lstat($targetname);
   86     my @lnk_stat = Time::HiRes::stat($linkname);
   87     my @lnk_lstat = Time::HiRes::lstat($linkname);
   88     is scalar(@tgt_stat), 13;
   89     is scalar(@tgt_lstat), 13;
   90     is scalar(@lnk_stat), 13;
   91     is scalar(@lnk_lstat), 13;
   92     is_deeply \@tgt_stat, \@tgt_lstat;
   93     is_deeply \@tgt_stat, \@lnk_stat;
   94     isnt $lnk_lstat[2], $tgt_stat[2];
   95 }
   96 1 while unlink $linkname;
   97 1 while unlink $targetname;
   98 
   99 1;