Upgrade to 1.9770 as provided in perl-5.35.11
This commit is contained in:
parent
61d4e5495e
commit
8787bd08f5
|
@ -0,0 +1,292 @@
|
|||
From 8716488cb3bf92cb12be1776c49be2c55e590733 Mon Sep 17 00:00:00 2001
|
||||
From: Jitka Plesnikova <jplesnik@redhat.com>
|
||||
Date: Thu, 12 May 2022 15:21:50 +0200
|
||||
Subject: [PATCH] Upgrade to 1.9770
|
||||
|
||||
---
|
||||
HiRes.pm | 2 +-
|
||||
HiRes.xs | 9 ++++----
|
||||
Makefile.PL | 22 +++++++++++++-----
|
||||
t/Watchdog.pm | 12 +++++-----
|
||||
t/stat.t | 62 ++++++++++++++++++++++++++++++---------------------
|
||||
5 files changed, 66 insertions(+), 41 deletions(-)
|
||||
|
||||
diff --git a/HiRes.pm b/HiRes.pm
|
||||
index 9377c34..7e21047 100644
|
||||
--- a/HiRes.pm
|
||||
+++ b/HiRes.pm
|
||||
@@ -50,7 +50,7 @@ our @EXPORT_OK = qw (usleep sleep ualarm alarm gettimeofday time tv_interval
|
||||
stat lstat utime
|
||||
);
|
||||
|
||||
-our $VERSION = '1.9767';
|
||||
+our $VERSION = '1.9770';
|
||||
our $XS_VERSION = $VERSION;
|
||||
$VERSION = eval $VERSION;
|
||||
|
||||
diff --git a/HiRes.xs b/HiRes.xs
|
||||
index 1b97962..1eb7de3 100644
|
||||
--- a/HiRes.xs
|
||||
+++ b/HiRes.xs
|
||||
@@ -20,6 +20,7 @@ extern "C" {
|
||||
#include "XSUB.h"
|
||||
#include "reentr.h"
|
||||
#ifdef USE_PPPORT_H
|
||||
+#define NEED_ck_warner
|
||||
# include "ppport.h"
|
||||
#endif
|
||||
#if defined(__CYGWIN__) && defined(HAS_W32API_WINDOWS_H)
|
||||
@@ -1192,7 +1193,7 @@ gettimeofday()
|
||||
int status;
|
||||
status = gettimeofday (&Tp, NULL);
|
||||
if (status == 0) {
|
||||
- if (GIMME == G_ARRAY) {
|
||||
+ if (GIMME == G_LIST) {
|
||||
EXTEND(sp, 2);
|
||||
PUSHs(sv_2mortal(newSViv(Tp.tv_sec)));
|
||||
PUSHs(sv_2mortal(newSViv(Tp.tv_usec)));
|
||||
@@ -1249,7 +1250,7 @@ setitimer(which, seconds, interval = 0)
|
||||
if (setitimer(which, &newit, &oldit) == 0) {
|
||||
EXTEND(sp, 1);
|
||||
PUSHs(sv_2mortal(newSVnv(TV2NV(oldit.it_value))));
|
||||
- if (GIMME == G_ARRAY) {
|
||||
+ if (GIMME == G_LIST) {
|
||||
EXTEND(sp, 1);
|
||||
PUSHs(sv_2mortal(newSVnv(TV2NV(oldit.it_interval))));
|
||||
}
|
||||
@@ -1269,7 +1270,7 @@ getitimer(which)
|
||||
if (getitimer(which, &nowit) == 0) {
|
||||
EXTEND(sp, 1);
|
||||
PUSHs(sv_2mortal(newSVnv(TV2NV(nowit.it_value))));
|
||||
- if (GIMME == G_ARRAY) {
|
||||
+ if (GIMME == G_LIST) {
|
||||
EXTEND(sp, 1);
|
||||
PUSHs(sv_2mortal(newSVnv(TV2NV(nowit.it_interval))));
|
||||
}
|
||||
@@ -1522,7 +1523,7 @@ PROTOTYPE: ;$
|
||||
Zero(&fakeop, 1, OP);
|
||||
fakeop.op_type = ix ? OP_LSTAT : OP_STAT;
|
||||
fakeop.op_ppaddr = PL_ppaddr[fakeop.op_type];
|
||||
- fakeop.op_flags = GIMME_V == G_ARRAY ? OPf_WANT_LIST :
|
||||
+ fakeop.op_flags = GIMME_V == G_LIST ? OPf_WANT_LIST :
|
||||
GIMME_V == G_SCALAR ? OPf_WANT_SCALAR : OPf_WANT_VOID;
|
||||
PL_op = &fakeop;
|
||||
(void)fakeop.op_ppaddr(aTHX);
|
||||
diff --git a/Makefile.PL b/Makefile.PL
|
||||
index c918cd1..e5ba503 100644
|
||||
--- a/Makefile.PL
|
||||
+++ b/Makefile.PL
|
||||
@@ -562,7 +562,10 @@ EOD
|
||||
my $has_clock_gettime;
|
||||
my $has_clock_gettime_emulation;
|
||||
if (exists $Config{d_clock_gettime}) {
|
||||
- $has_clock_gettime++ if $Config{d_clock_gettime}; # Unlikely...
|
||||
+ if ($Config{d_clock_gettime}) { # possibly set for cross-compilation
|
||||
+ $has_clock_gettime++;
|
||||
+ $DEFINE .= ' -DTIME_HIRES_CLOCK_GETTIME';
|
||||
+ }
|
||||
} elsif (has_clock_xxx('gettime')) {
|
||||
$has_clock_gettime++;
|
||||
$DEFINE .= ' -DTIME_HIRES_CLOCK_GETTIME';
|
||||
@@ -591,7 +594,10 @@ EOD
|
||||
my $has_clock_getres;
|
||||
my $has_clock_getres_emulation;
|
||||
if (exists $Config{d_clock_getres}) {
|
||||
- $has_clock_getres++ if $Config{d_clock_getres}; # Unlikely...
|
||||
+ if ($Config{d_clock_getres}) { # possibly set for cross-compilation
|
||||
+ $has_clock_getres++;
|
||||
+ $DEFINE .= ' -DTIME_HIRES_CLOCK_GETRES';
|
||||
+ }
|
||||
} elsif (has_clock_xxx('getres')) {
|
||||
$has_clock_getres++;
|
||||
$DEFINE .= ' -DTIME_HIRES_CLOCK_GETRES';
|
||||
@@ -620,7 +626,10 @@ EOD
|
||||
my $has_clock_nanosleep;
|
||||
my $has_clock_nanosleep_emulation;
|
||||
if (exists $Config{d_clock_nanosleep}) {
|
||||
- $has_clock_nanosleep++ if $Config{d_clock_nanosleep}; # Unlikely...
|
||||
+ if ($Config{d_clock_nanosleep}) { # possibly set for cross-compilation
|
||||
+ $has_clock_nanosleep++;
|
||||
+ $DEFINE .= ' -DTIME_HIRES_CLOCK_NANOSLEEP';
|
||||
+ }
|
||||
} elsif (has_clock_nanosleep()) {
|
||||
$has_clock_nanosleep++;
|
||||
$DEFINE .= ' -DTIME_HIRES_CLOCK_NANOSLEEP';
|
||||
@@ -643,7 +652,10 @@ EOD
|
||||
print "Looking for clock()... ";
|
||||
my $has_clock;
|
||||
if (exists $Config{d_clock}) {
|
||||
- $has_clock++ if $Config{d_clock}; # Unlikely...
|
||||
+ if ($Config{d_clock}) { # possibly set for cross-compilation
|
||||
+ $has_clock++;
|
||||
+ $DEFINE .= ' -DTIME_HIRES_CLOCK';
|
||||
+ }
|
||||
} elsif (has_clock()) {
|
||||
$has_clock++;
|
||||
$DEFINE .= ' -DTIME_HIRES_CLOCK';
|
||||
@@ -861,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,
|
||||
diff --git a/t/Watchdog.pm b/t/Watchdog.pm
|
||||
index a93ab4f..5f78a17 100644
|
||||
--- a/t/Watchdog.pm
|
||||
+++ b/t/Watchdog.pm
|
||||
@@ -10,30 +10,30 @@ my $watchdog_pid;
|
||||
my $TheEnd;
|
||||
|
||||
if ($Config{d_fork}) {
|
||||
- print("# I am the main process $$, starting the watchdog process...\n");
|
||||
+ 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 {
|
||||
@@ -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.");
|
||||
}
|
||||
}
|
||||
|
||||
diff --git a/t/stat.t b/t/stat.t
|
||||
index f2f8e87..1f1fa96 100644
|
||||
--- a/t/stat.t
|
||||
+++ b/t/stat.t
|
||||
@@ -20,31 +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_deeply $lstat, $stat;
|
||||
- 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 $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, "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, "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;
|
||||
@@ -64,13 +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$$";
|
||||
@@ -81,17 +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;
|
||||
- is_deeply \@tgt_stat, \@tgt_lstat;
|
||||
- is_deeply \@tgt_stat, \@lnk_stat;
|
||||
- isnt $lnk_lstat[2], $tgt_stat[2];
|
||||
+ 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, "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;
|
||||
--
|
||||
2.34.3
|
||||
|
|
@ -2,14 +2,16 @@
|
|||
|
||||
Name: perl-Time-HiRes
|
||||
Epoch: 4
|
||||
Version: 1.9767
|
||||
Release: 480%{?dist}
|
||||
Version: 1.9770
|
||||
Release: 488%{?dist}
|
||||
Summary: High resolution alarm, sleep, gettimeofday, interval timers
|
||||
License: GPL+ or Artistic
|
||||
URL: https://metacpan.org/release/Time-HiRes
|
||||
Source0: https://cpan.metacpan.org/authors/id/A/AT/ATOOMIC/Time-HiRes-%{base_version}.tar.gz
|
||||
# Unbundled from perl 5.34.0
|
||||
Patch0: Time-HiRes-1.9764-Upgrade-to-1.9767.patch
|
||||
# Unbundled from perl 5.35.11
|
||||
Patch1: Time-HiRes-1.9767-Upgrade-to-1.9770.patch
|
||||
BuildRequires: coreutils
|
||||
BuildRequires: findutils
|
||||
BuildRequires: gcc
|
||||
|
@ -45,6 +47,7 @@ high resolution time and timers.
|
|||
%prep
|
||||
%setup -q -n Time-HiRes-%{base_version}
|
||||
%patch0 -p1
|
||||
%patch1 -p1
|
||||
|
||||
%build
|
||||
unset PERL_CORE
|
||||
|
@ -66,6 +69,9 @@ make test
|
|||
%{_mandir}/man3/*
|
||||
|
||||
%changelog
|
||||
* Mon May 30 2022 Jitka Plesnikova <jplesnik@redhat.com> - 4:1.9770-488
|
||||
- Upgrade to 1.9770 as provided in perl-5.35.11
|
||||
|
||||
* Fri Jan 21 2022 Fedora Release Engineering <releng@fedoraproject.org> - 4:1.9767-480
|
||||
- Rebuilt for https://fedoraproject.org/wiki/Fedora_36_Mass_Rebuild
|
||||
|
||||
|
|
Loading…
Reference in New Issue