Can you all look this over?
This patch skips test 17 on VMS. It is causing an ASTFLT.
The select() system call on VMS is not currently interruptible, so at
least one part of the test is invalid.
For some reason, the original code continues to call tick even after the
3 second timeout, and this eventually results in an ASTFLT at a time
after the test appears to be complete.
This leaves me with the following tests failing under blead:
[-.ext.cwd.t]cwd.t - symlink issues need to be investigated and resolved
under non-POSIX compliant mode before posix compliant support can be added.
[-.lib.CPANPLUS...]*.t - Still needs investigating
[-.lib.Module.Build.t]*.t - Still needs investigating
-John
[EMAIL PROTECTED]
Personal Opinion Only
--- /rsync_root/perl/ext/Time/HiRes/t/HiRes.t Sat Mar 3 22:53:41 2007
+++ ext/Time/HiRes/t/HiRes.t Tue Aug 21 22:12:52 2007
@@ -261,47 +261,54 @@
sleep (0.5);
print "# sleep...", Time::HiRes::tv_interval($r), "\nok 16\n";
- $r = [Time::HiRes::gettimeofday()];
- $i = 5;
my $oldaction;
- if ($use_sigaction) {
- $oldaction = new POSIX::SigAction;
- printf "# sigaction tick, ALRM = %d\n", &POSIX::SIGALRM;
- # Perl's deferred signals may be too wimpy to break through
- # a restartable select(), so use POSIX::sigaction if available.
- POSIX::sigaction(&POSIX::SIGALRM, POSIX::SigAction->new("tick"),
- $oldaction)
- or die "Error setting SIGALRM handler with sigaction: $!\n";
- } else {
- print "# SIG tick\n";
- $SIG{ALRM} = "tick";
- }
- while ($i > 0)
- {
- alarm(0.3);
- select (undef, undef, undef, 3);
- my $ival = Time::HiRes::tv_interval ($r);
- print "# Select returned! $i $ival\n";
- print "# ", abs($ival/3 - 1), "\n";
- # Whether select() gets restarted after signals is
- # implementation dependent. If it is restarted, we
- # will get about 3.3 seconds: 3 from the select, 0.3
- # from the alarm. If this happens, let's just skip
- # this particular test. --jhi
- if (abs($ival/3.3 - 1) < $limit) {
- $ok = "Skip: your select() may get restarted by your SIGALRM (or
just retry test)";
- undef $not;
- last;
+ # on VMS timers can not interrupt select.
+ if ($^O ne 'VMS') {
+ $r = [Time::HiRes::gettimeofday()];
+ $i = 5;
+ if ($use_sigaction) {
+ $oldaction = new POSIX::SigAction;
+ printf "# sigaction tick, ALRM = %d\n", &POSIX::SIGALRM;
+ # Perl's deferred signals may be too wimpy to break through
+ # a restartable select(), so use POSIX::sigaction if available.
+ POSIX::sigaction(&POSIX::SIGALRM, POSIX::SigAction->new("tick"),
+ $oldaction)
+ or die "Error setting SIGALRM handler with sigaction: $!\n";
+ } else {
+ print "# SIG tick\n";
+ $SIG{ALRM} = "tick";
}
- my $exp = 0.3 * (5 - $i);
- # This test is more sensitive, so impose a softer limit.
- if (abs($ival/$exp - 1) > 3*$limit) {
- my $ratio = abs($ival/$exp);
- $not = "while: $exp sleep took $ival ratio $ratio";
- last;
+
+ while ($i > 0)
+ {
+ alarm(0.3);
+ select (undef, undef, undef, 3);
+ my $ival = Time::HiRes::tv_interval ($r);
+ print "# Select returned! $i $ival\n";
+ print "# ", abs($ival/3 - 1), "\n";
+ # Whether select() gets restarted after signals is
+ # implementation dependent. If it is restarted, we
+ # will get about 3.3 seconds: 3 from the select, 0.3
+ # from the alarm. If this happens, let's just skip
+ # this particular test. --jhi
+ if (abs($ival/3.3 - 1) < $limit) {
+ $ok =
+ "Skip: your select() may get restarted by your SIGALRM (or just retry test)";
+ undef $not;
+ last;
+ }
+ my $exp = 0.3 * (5 - $i);
+ # This test is more sensitive, so impose a softer limit.
+ if (abs($ival/$exp - 1) > 3*$limit) {
+ my $ratio = abs($ival/$exp);
+ $not = "while: $exp sleep took $ival ratio $ratio";
+ last;
+ }
+ $ok = $i;
}
- $ok = $i;
+ } else {
+ $ok = "Skip: VMS select() does not get interrupted.";
}
sub tick
@@ -318,10 +325,13 @@
}
}
- if ($use_sigaction) {
- POSIX::sigaction(&POSIX::SIGALRM, $oldaction);
- } else {
- alarm(0); # can't cancel usig %SIG
+
+ if ($^O ne 'VMS') {
+ if ($use_sigaction) {
+ POSIX::sigaction(&POSIX::SIGALRM, $oldaction);
+ } else {
+ alarm(0); # can't cancel usig %SIG
+ }
}
print $not ? "not ok 17 # $not\n" : "ok 17 # $ok\n";
