Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

dist/Time-HiRes/t/stat.t: provide descriptions for all tests #19322

Merged
merged 1 commit into from
Jan 4, 2022
Merged

dist/Time-HiRes/t/stat.t: provide descriptions for all tests #19322

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion dist/Time-HiRes/Makefile.PL
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -873,7 +873,7 @@ sub doMakefile {
'Config' => 0,
'Exporter' => 0,
'ExtUtils::MakeMaker' => 0,
'Test::More' => 0,
'Test::More' => 0.84,
'XSLoader' => 0,
'strict' => 0,
'File::Spec' => 0,
Expand Down
12 changes: 6 additions & 6 deletions dist/Time-HiRes/t/Watchdog.pm
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -10,30 +10,30 @@ my $watchdog_pid;
my $TheEnd;

if ($Config{d_fork}) {
print("# I am the main process $$, starting the watchdog process...\n");
jkeenan marked this conversation as resolved.
Show resolved Hide resolved
note ("I am the main process $$, starting the watchdog process...");
$watchdog_pid = fork();
if (defined $watchdog_pid) {
if ($watchdog_pid == 0) { # We are the kid, set up the watchdog.
my $ppid = getppid();
print("# I am the watchdog process $$, sleeping for $waitfor seconds...\n");
note ("I am the watchdog process $$, sleeping for $waitfor seconds...");
sleep($waitfor - 2); # Workaround for perlbug #49073
sleep(2); # Wait for parent to exit
if (kill(0, $ppid)) { # Check if parent still exists
warn "\n$0: overall time allowed for tests (${waitfor}s) exceeded!\n";
print("Terminating main process $ppid...\n");
kill('KILL', $ppid);
print("# This is the watchdog process $$, over and out.\n");
note ("This is the watchdog process $$, over and out.");
}
exit(0);
} else {
print("# The watchdog process $watchdog_pid launched, continuing testing...\n");
note ("The watchdog process $watchdog_pid launched, continuing testing...");
$TheEnd = time() + $waitfor;
}
} else {
warn "$0: fork failed: $!\n";
}
} else {
print("# No watchdog process (need fork)\n");
note ("No watchdog process (need fork)");
}

END {
Expand All @@ -47,7 +47,7 @@ END {
printf("# kill KILL $watchdog_pid = %d\n", $kill);
}
unlink("ktrace.out"); # Used in BSD system call tracing.
print("# All done.\n");
note ("All done.");
}
}

Expand Down
41 changes: 23 additions & 18 deletions dist/Time-HiRes/t/stat.t
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -20,36 +20,37 @@ use t::Watchdog;
my @atime;
my @mtime;
for (1..5) {
note "cycle $_";
Time::HiRes::sleep(rand(0.1) + 0.1);
open(X, '>', $$);
print X $$;
close(X);
my($a, $stat, $b) = ("a", [Time::HiRes::stat($$)], "b");
is $a, "a";
is $b, "b";
is ref($stat), "ARRAY";
is $a, "a", "stat stack discipline";
is $b, "b", "stat stack discipline";
is ref($stat), "ARRAY", "stat returned array";
push @mtime, $stat->[9];
($a, my $lstat, $b) = ("a", [Time::HiRes::lstat($$)], "b");
is $a, "a";
is $b, "b";
is $a, "a", "lstat stack discipline";
is $b, "b", "lstat stack discipline";
SKIP: {
if($^O eq "haiku") {
skip "testing stat access time on Haiku", 2;
}
is_deeply $lstat, $stat;
is_deeply $lstat, $stat, "write: stat and lstat returned same values";
Time::HiRes::sleep(rand(0.1) + 0.1);
open(X, '<', $$);
<X>;
close(X);
$stat = [Time::HiRes::stat($$)];
push @atime, $stat->[8];
$lstat = [Time::HiRes::lstat($$)];
is_deeply $lstat, $stat;
is_deeply $lstat, $stat, "read: stat and lstat returned same values";
}
}
1 while unlink $$;
print("# mtime = @mtime\n");
print("# atime = @atime\n");
note ("mtime = @mtime");
note ("atime = @atime");
my $ai = 0;
my $mi = 0;
my $ss = 0;
Expand All @@ -69,14 +70,15 @@ for (my $i = 1; $i < @mtime; $i++) {
$ss++;
}
}
print("# ai = $ai, mi = $mi, ss = $ss\n");
note ("ai = $ai, mi = $mi, ss = $ss");
# Need at least 75% of monotonical increase and
# 20% of subsecond results. Yes, this is guessing.
SKIP: {
skip "no subsecond timestamps detected", 1 if $ss == 0;
skip "testing stat access on Haiku", 1 if $^O eq "haiku";
ok $mi/(@mtime-1) >= 0.75 && $ai/(@atime-1) >= 0.75 &&
$ss/(@mtime+@atime) >= 0.2;
$ss/(@mtime+@atime) >= 0.2,
"monotonical increase and subsecond results within expected parameters";
}

my $targetname = "tgt$$";
Expand All @@ -87,18 +89,21 @@ SKIP: {
close(X);
eval { symlink $targetname, $linkname or die "can't symlink: $!"; };
skip "can't symlink", 7 if $@ ne "";
note "compare Time::HiRes::stat with ::lstat";
my @tgt_stat = Time::HiRes::stat($targetname);
my @tgt_lstat = Time::HiRes::lstat($targetname);
my @lnk_stat = Time::HiRes::stat($linkname);
my @lnk_lstat = Time::HiRes::lstat($linkname);
is scalar(@tgt_stat), 13;
is scalar(@tgt_lstat), 13;
is scalar(@lnk_stat), 13;
is scalar(@lnk_lstat), 13;
my $exp = 13;
is scalar(@tgt_stat), $exp, "stat on target";
is scalar(@tgt_lstat), $exp, "lstat on target";
is scalar(@lnk_stat), $exp, "stat on link";
is scalar(@lnk_lstat), $exp, "lstat on link";
skip "testing stat access on Haiku", 3 if $^O eq "haiku";
is_deeply \@tgt_stat, \@tgt_lstat;
is_deeply \@tgt_stat, \@lnk_stat;
isnt $lnk_lstat[2], $tgt_stat[2];
is_deeply \@tgt_stat, \@tgt_lstat, "stat and lstat return same values on target";
is_deeply \@tgt_stat, \@lnk_stat, "stat and lstat return same values on link";
isnt $lnk_lstat[2], $tgt_stat[2],
"target stat mode value differs from link lstat mode value";
}
1 while unlink $linkname;
1 while unlink $targetname;
Expand Down