diff --git a/Time-HiRes-1.9760-Upgrade-to-1.9764.patch b/Time-HiRes-1.9760-Upgrade-to-1.9764.patch new file mode 100644 index 0000000..1bae891 --- /dev/null +++ b/Time-HiRes-1.9760-Upgrade-to-1.9764.patch @@ -0,0 +1,5431 @@ +From 8ee999ad66e2b3c8b4ca87a543c081fc248719d5 Mon Sep 17 00:00:00 2001 +From: Jitka Plesnikova +Date: Tue, 21 Apr 2020 10:24:17 +0200 +Subject: [PATCH] Upgrade to 1.9764 + +--- + HiRes.pm | 141 ++-- + HiRes.xs | 1721 ++++++++++++++++++++++++---------------------- + Makefile.PL | 689 +++++++++---------- + t/Watchdog.pm | 54 +- + t/alarm.t | 204 +++--- + t/clock.t | 62 +- + t/gettimeofday.t | 6 +- + t/itimer.t | 18 +- + t/nanosleep.t | 6 +- + t/sleep.t | 6 +- + t/stat.t | 20 +- + t/time.t | 6 +- + t/ualarm.t | 60 +- + t/usleep.t | 14 +- + t/utime.t | 304 ++++---- + typemap | 454 ++++++------ + 16 files changed, 1891 insertions(+), 1874 deletions(-) + +diff --git a/HiRes.pm b/HiRes.pm +index 08eefc8..433ca31 100644 +--- a/HiRes.pm ++++ b/HiRes.pm +@@ -11,46 +11,46 @@ our @ISA = qw(Exporter); + our @EXPORT = qw( ); + # More or less this same list is in Makefile.PL. Should unify. + our @EXPORT_OK = qw (usleep sleep ualarm alarm gettimeofday time tv_interval +- getitimer setitimer nanosleep clock_gettime clock_getres +- clock clock_nanosleep +- CLOCKS_PER_SEC +- CLOCK_BOOTTIME +- CLOCK_HIGHRES +- CLOCK_MONOTONIC +- CLOCK_MONOTONIC_COARSE +- CLOCK_MONOTONIC_FAST +- CLOCK_MONOTONIC_PRECISE +- CLOCK_MONOTONIC_RAW +- CLOCK_PROCESS_CPUTIME_ID +- CLOCK_PROF +- CLOCK_REALTIME +- CLOCK_REALTIME_COARSE +- CLOCK_REALTIME_FAST +- CLOCK_REALTIME_PRECISE +- CLOCK_REALTIME_RAW +- CLOCK_SECOND +- CLOCK_SOFTTIME +- CLOCK_THREAD_CPUTIME_ID +- CLOCK_TIMEOFDAY +- CLOCK_UPTIME +- CLOCK_UPTIME_COARSE +- CLOCK_UPTIME_FAST +- CLOCK_UPTIME_PRECISE +- CLOCK_UPTIME_RAW +- CLOCK_VIRTUAL +- ITIMER_PROF +- ITIMER_REAL +- ITIMER_REALPROF +- ITIMER_VIRTUAL +- TIMER_ABSTIME +- d_usleep d_ualarm d_gettimeofday d_getitimer d_setitimer +- d_nanosleep d_clock_gettime d_clock_getres +- d_clock d_clock_nanosleep d_hires_stat +- d_futimens d_utimensat d_hires_utime +- stat lstat utime +- ); +- +-our $VERSION = '1.9760'; ++ getitimer setitimer nanosleep clock_gettime clock_getres ++ clock clock_nanosleep ++ CLOCKS_PER_SEC ++ CLOCK_BOOTTIME ++ CLOCK_HIGHRES ++ CLOCK_MONOTONIC ++ CLOCK_MONOTONIC_COARSE ++ CLOCK_MONOTONIC_FAST ++ CLOCK_MONOTONIC_PRECISE ++ CLOCK_MONOTONIC_RAW ++ CLOCK_PROCESS_CPUTIME_ID ++ CLOCK_PROF ++ CLOCK_REALTIME ++ CLOCK_REALTIME_COARSE ++ CLOCK_REALTIME_FAST ++ CLOCK_REALTIME_PRECISE ++ CLOCK_REALTIME_RAW ++ CLOCK_SECOND ++ CLOCK_SOFTTIME ++ CLOCK_THREAD_CPUTIME_ID ++ CLOCK_TIMEOFDAY ++ CLOCK_UPTIME ++ CLOCK_UPTIME_COARSE ++ CLOCK_UPTIME_FAST ++ CLOCK_UPTIME_PRECISE ++ CLOCK_UPTIME_RAW ++ CLOCK_VIRTUAL ++ ITIMER_PROF ++ ITIMER_REAL ++ ITIMER_REALPROF ++ ITIMER_VIRTUAL ++ TIMER_ABSTIME ++ d_usleep d_ualarm d_gettimeofday d_getitimer d_setitimer ++ d_nanosleep d_clock_gettime d_clock_getres ++ d_clock d_clock_nanosleep d_hires_stat ++ d_futimens d_utimensat d_hires_utime ++ stat lstat utime ++ ); ++ ++our $VERSION = '1.9764'; + our $XS_VERSION = $VERSION; + $VERSION = eval $VERSION; + +@@ -67,8 +67,8 @@ sub AUTOLOAD { + die "$error at $file line $line.\n"; + } + { +- no strict 'refs'; +- *$AUTOLOAD = sub { $val }; ++ no strict 'refs'; ++ *$AUTOLOAD = sub { $val }; + } + goto &$AUTOLOAD; + } +@@ -76,17 +76,17 @@ sub AUTOLOAD { + sub import { + my $this = shift; + for my $i (@_) { +- if (($i eq 'clock_getres' && !&d_clock_getres) || +- ($i eq 'clock_gettime' && !&d_clock_gettime) || +- ($i eq 'clock_nanosleep' && !&d_clock_nanosleep) || +- ($i eq 'clock' && !&d_clock) || +- ($i eq 'nanosleep' && !&d_nanosleep) || +- ($i eq 'usleep' && !&d_usleep) || +- ($i eq 'utime' && !&d_hires_utime) || +- ($i eq 'ualarm' && !&d_ualarm)) { +- require Carp; +- Carp::croak("Time::HiRes::$i(): unimplemented in this platform"); +- } ++ if (($i eq 'clock_getres' && !&d_clock_getres) || ++ ($i eq 'clock_gettime' && !&d_clock_gettime) || ++ ($i eq 'clock_nanosleep' && !&d_clock_nanosleep) || ++ ($i eq 'clock' && !&d_clock) || ++ ($i eq 'nanosleep' && !&d_nanosleep) || ++ ($i eq 'usleep' && !&d_usleep) || ++ ($i eq 'utime' && !&d_hires_utime) || ++ ($i eq 'ualarm' && !&d_ualarm)) { ++ require Carp; ++ Carp::croak("Time::HiRes::$i(): unimplemented in this platform"); ++ } + } + Time::HiRes->export_to_level(1, $this, @_); + } +@@ -114,7 +114,7 @@ Time::HiRes - High resolution alarm, sleep, gettimeofday, interval timers + =head1 SYNOPSIS + + use Time::HiRes qw( usleep ualarm gettimeofday tv_interval nanosleep +- clock_gettime clock_getres clock_nanosleep clock ++ clock_gettime clock_getres clock_nanosleep clock + stat lstat utime); + + usleep ($microseconds); +@@ -143,7 +143,7 @@ Time::HiRes - High resolution alarm, sleep, gettimeofday, interval timers + getitimer ($which); + + use Time::HiRes qw( clock_gettime clock_getres clock_nanosleep +- ITIMER_REAL ITIMER_VIRTUAL ITIMER_PROF ++ ITIMER_REAL ITIMER_VIRTUAL ITIMER_PROF + ITIMER_REALPROF ); + + $realtime = clock_gettime(CLOCK_REALTIME); +@@ -221,8 +221,8 @@ Sleeps for the number of microseconds (millionths of a second) + specified. Returns the number of microseconds actually slept. + Can sleep for more than one second, unlike the C system call. + Can also sleep for zero seconds, which often works like a I. +-See also C, C, and +-C. ++See also L|/sleep ( $floating_seconds )>, and ++L|/clock_nanosleep ( $which, $nanoseconds, $flags = 0)>. + + Do not expect usleep() to be exact down to one microsecond. + +@@ -232,8 +232,10 @@ Sleeps for the number of nanoseconds (1e9ths of a second) specified. + Returns the number of nanoseconds actually slept (accurate only to + microseconds, the nearest thousand of them). Can sleep for more than + one second. Can also sleep for zero seconds, which often works like +-a I. See also C, +-C, and C. ++a I. See also ++L|/sleep ( $floating_seconds )>, ++L|/usleep ( $useconds )>, and ++L|/clock_nanosleep ( $which, $nanoseconds, $flags = 0)>. + + Do not expect nanosleep() to be exact down to one nanosecond. + Getting even accuracy of one thousand nanoseconds is good. +@@ -250,7 +252,7 @@ ualarm(0) will cancel an outstanding ualarm(). + + Note that the interaction between alarms and sleeps is unspecified. + +-=item tv_interval ++=item tv_interval + + tv_interval ( $ref_to_gettimeofday [, $ref_to_later_gettimeofday] ) + +@@ -356,7 +358,7 @@ delivered when the timer expires. C can interrupt system calls. + The semantics of interval timers for multithreaded programs are + system-specific, and some systems may support additional interval + timers. For example, it is unspecified which thread gets the signals. +-See your C documentation. ++See your L> documentation. + + =item getitimer ( $which ) + +@@ -404,8 +406,10 @@ default to zero but C can specified (must be exported + explicitly) which means that C<$nanoseconds> is not a time interval + (as is the default) but instead an absolute time. Can sleep for more + than one second. Can also sleep for zero seconds, which often works +-like a I. See also C, +-C, and C. ++like a I. See also ++L|/sleep ( $floating_seconds )>, ++L|/usleep ( $useconds )>, and ++L|/nanosleep ( $nanoseconds )>. + + Do not expect clock_nanosleep() to be exact down to one nanosecond. + Getting even accuracy of one thousand nanoseconds is good. +@@ -515,7 +519,7 @@ Returns the number of files successfully changed. + # get seconds and microseconds since the epoch + ($s, $usec) = gettimeofday(); + +- # measure elapsed time ++ # measure elapsed time + # (could also do by subtracting 2 gettimeofday return values) + $t0 = [gettimeofday]; + # do bunch of stuff here +@@ -524,7 +528,7 @@ Returns the number of files successfully changed. + $t0_t1 = tv_interval $t0, $t1; + + $elapsed = tv_interval ($t0, [gettimeofday]); +- $elapsed = tv_interval ($t0); # equivalent code ++ $elapsed = tv_interval ($t0); # equivalent code + + # + # replacements for time, alarm and sleep that know about +@@ -650,9 +654,10 @@ gnukfreebsd seems to have non-functional futimens() and utimensat() + + Perl modules L, L. + +-Your system documentation for C, C, +-C, C, C, C, +-C, C, C, C, C. ++Your system documentation for L>, L>, ++L>, L>, L>, ++L>, L>, L>, L>, ++L>, L>. + + =head1 AUTHORS + +diff --git a/HiRes.xs b/HiRes.xs +index 97e870c..8002472 100644 +--- a/HiRes.xs ++++ b/HiRes.xs +@@ -1,12 +1,12 @@ + /* +- * ++ * + * Copyright (c) 1996-2002 Douglas E. Wegscheid. All rights reserved. +- * ++ * + * Copyright (c) 2002-2010 Jarkko Hietaniemi. + * All rights reserved. + * + * Copyright (C) 2011, 2012, 2013 Andrew Main (Zefram) +- * ++ * + * This program is free software; you can redistribute it and/or modify + * it under the same terms as Perl itself. + */ +@@ -22,21 +22,21 @@ extern "C" { + # include "ppport.h" + #endif + #if defined(__CYGWIN__) && defined(HAS_W32API_WINDOWS_H) +-# include +-# define CYGWIN_WITH_W32API ++# include ++# define CYGWIN_WITH_W32API + #endif + #ifdef WIN32 +-# include ++# include + #else +-# include ++# include + #endif + #ifdef HAS_SELECT +-# ifdef I_SYS_SELECT +-# include +-# endif ++# ifdef I_SYS_SELECT ++# include ++# endif + #endif + #if defined(TIME_HIRES_CLOCK_GETTIME_SYSCALL) || defined(TIME_HIRES_CLOCK_GETRES_SYSCALL) +-#include ++# include + #endif + #ifdef __cplusplus + } +@@ -44,29 +44,22 @@ extern "C" { + + #define PERL_VERSION_DECIMAL(r,v,s) (r*1000000 + v*1000 + s) + #define PERL_DECIMAL_VERSION \ +- PERL_VERSION_DECIMAL(PERL_REVISION,PERL_VERSION,PERL_SUBVERSION) ++ PERL_VERSION_DECIMAL(PERL_REVISION,PERL_VERSION,PERL_SUBVERSION) + #define PERL_VERSION_GE(r,v,s) \ +- (PERL_DECIMAL_VERSION >= PERL_VERSION_DECIMAL(r,v,s)) ++ (PERL_DECIMAL_VERSION >= PERL_VERSION_DECIMAL(r,v,s)) + + #ifndef GCC_DIAG_IGNORE +-# define GCC_DIAG_IGNORE(x) +-# define GCC_DIAG_RESTORE ++# define GCC_DIAG_IGNORE(x) ++# define GCC_DIAG_RESTORE + #endif + #ifndef GCC_DIAG_IGNORE_STMT +-# define GCC_DIAG_IGNORE_STMT(x) GCC_DIAG_IGNORE(x) NOOP +-# define GCC_DIAG_RESTORE_STMT GCC_DIAG_RESTORE NOOP +-#endif +- +-/* At least ppport.h 3.13 gets this wrong: one really cannot +- * have NVgf as anything else than "g" under Perl 5.6.x. */ +-#if PERL_REVISION == 5 && PERL_VERSION == 6 +-# undef NVgf +-# define NVgf "g" ++# define GCC_DIAG_IGNORE_STMT(x) GCC_DIAG_IGNORE(x) NOOP ++# define GCC_DIAG_RESTORE_STMT GCC_DIAG_RESTORE NOOP + #endif + + #if PERL_VERSION_GE(5,7,3) && !PERL_VERSION_GE(5,10,1) +-# undef SAVEOP +-# define SAVEOP() SAVEVPTR(PL_op) ++# undef SAVEOP ++# define SAVEOP() SAVEVPTR(PL_op) + #endif + + #define IV_1E6 1000000 +@@ -78,14 +71,14 @@ extern "C" { + #define NV_1E9 1000000000.0 + + #ifndef PerlProc_pause +-# define PerlProc_pause() Pause() ++# define PerlProc_pause() Pause() + #endif + + #ifdef HAS_PAUSE +-# define Pause pause ++# define Pause pause + #else +-# undef Pause /* In case perl.h did it already. */ +-# define Pause() sleep(~0) /* Zzz for a long time. */ ++# undef Pause /* In case perl.h did it already. */ ++# define Pause() sleep(~0) /* Zzz for a long time. */ + #endif + + /* Though the cpp define ITIMER_VIRTUAL is available the functionality +@@ -93,9 +86,9 @@ extern "C" { + * Neither are ITIMER_PROF or ITIMER_REALPROF implemented. --jhi + */ + #if defined(__CYGWIN__) || defined(WIN32) +-# undef ITIMER_VIRTUAL +-# undef ITIMER_PROF +-# undef ITIMER_REALPROF ++# undef ITIMER_VIRTUAL ++# undef ITIMER_PROF ++# undef ITIMER_REALPROF + #endif + + #ifndef TIME_HIRES_CLOCKID_T +@@ -106,37 +99,37 @@ typedef int clockid_t; + + /* HP-UX has CLOCK_XXX values but as enums, not as defines. + * The only way to detect these would be to test compile for each. */ +-# ifdef __hpux ++# ifdef __hpux + /* However, it seems that at least in HP-UX 11.31 ia64 there *are* + * defines for these, so let's try detecting them. */ +-# ifndef CLOCK_REALTIME +-# define CLOCK_REALTIME CLOCK_REALTIME +-# define CLOCK_VIRTUAL CLOCK_VIRTUAL +-# define CLOCK_PROFILE CLOCK_PROFILE +-# endif +-# endif /* # ifdef __hpux */ ++# ifndef CLOCK_REALTIME ++# define CLOCK_REALTIME CLOCK_REALTIME ++# define CLOCK_VIRTUAL CLOCK_VIRTUAL ++# define CLOCK_PROFILE CLOCK_PROFILE ++# endif ++# endif /* # ifdef __hpux */ + + #endif /* #if defined(TIME_HIRES_CLOCK_GETTIME) && defined(_STRUCT_ITIMERSPEC) */ + + #if defined(WIN32) || defined(CYGWIN_WITH_W32API) + +-#ifndef HAS_GETTIMEOFDAY +-# define HAS_GETTIMEOFDAY +-#endif ++# ifndef HAS_GETTIMEOFDAY ++# define HAS_GETTIMEOFDAY ++# endif + + /* shows up in winsock.h? + struct timeval { +- long tv_sec; +- long tv_usec; ++ long tv_sec; ++ long tv_usec; + } + */ + + typedef union { +- unsigned __int64 ft_i64; +- FILETIME ft_val; ++ unsigned __int64 ft_i64; ++ FILETIME ft_val; + } FT_t; + +-#define MY_CXT_KEY "Time::HiRes_" XS_VERSION ++# define MY_CXT_KEY "Time::HiRes_" XS_VERSION + + typedef struct { + unsigned long run_count; +@@ -146,27 +139,35 @@ typedef struct { + unsigned __int64 reset_time; + } my_cxt_t; + ++/* Visual C++ 2013 and older don't have the timespec structure */ ++# if defined(_MSC_VER) && _MSC_VER < 1900 ++struct timespec { ++ time_t tv_sec; ++ long tv_nsec; ++}; ++# endif ++ + START_MY_CXT + + /* Number of 100 nanosecond units from 1/1/1601 to 1/1/1970 */ +-#ifdef __GNUC__ +-# define Const64(x) x##LL +-#else +-# define Const64(x) x##i64 +-#endif +-#define EPOCH_BIAS Const64(116444736000000000) +- +-#ifdef Const64 +-# ifdef __GNUC__ +-# define IV_1E6LL 1000000LL /* Needed because of Const64() ##-appends LL (or i64). */ +-# define IV_1E7LL 10000000LL +-# define IV_1E9LL 1000000000LL +-# else +-# define IV_1E6i64 1000000i64 +-# define IV_1E7i64 10000000i64 +-# define IV_1E9i64 1000000000i64 +-# endif +-#endif ++# ifdef __GNUC__ ++# define Const64(x) x##LL ++# else ++# define Const64(x) x##i64 ++# endif ++# define EPOCH_BIAS Const64(116444736000000000) ++ ++# ifdef Const64 ++# ifdef __GNUC__ ++# define IV_1E6LL 1000000LL /* Needed because of Const64() ##-appends LL (or i64). */ ++# define IV_1E7LL 10000000LL ++# define IV_1E9LL 1000000000LL ++# else ++# define IV_1E6i64 1000000i64 ++# define IV_1E7i64 10000000i64 ++# define IV_1E9i64 1000000000i64 ++# endif ++# endif + + /* NOTE: This does not compute the timezone info (doing so can be expensive, + * and appears to be unsupported even by glibc) */ +@@ -174,50 +175,82 @@ START_MY_CXT + /* dMY_CXT needs a Perl context and we don't want to call PERL_GET_CONTEXT + for performance reasons */ + +-#undef gettimeofday +-#define gettimeofday(tp, not_used) _gettimeofday(aTHX_ tp, not_used) ++# undef gettimeofday ++# define gettimeofday(tp, not_used) _gettimeofday(aTHX_ tp, not_used) ++ ++# undef GetSystemTimePreciseAsFileTime ++# define GetSystemTimePreciseAsFileTime(out) _GetSystemTimePreciseAsFileTime(aTHX_ out) ++ ++# undef clock_gettime ++# define clock_gettime(clock_id, tp) _clock_gettime(aTHX_ clock_id, tp) ++ ++# undef clock_getres ++# define clock_getres(clock_id, tp) _clock_getres(clock_id, tp) ++ ++# ifndef CLOCK_REALTIME ++# define CLOCK_REALTIME 1 ++# define CLOCK_MONOTONIC 2 ++# endif + + /* If the performance counter delta drifts more than 0.5 seconds from the + * system time then we recalibrate to the system time. This means we may + * move *backwards* in time! */ +-#define MAX_PERF_COUNTER_SKEW Const64(5000000) /* 0.5 seconds */ ++# define MAX_PERF_COUNTER_SKEW Const64(5000000) /* 0.5 seconds */ + + /* Reset reading from the performance counter every five minutes. + * Many PC clocks just seem to be so bad. */ +-#define MAX_PERF_COUNTER_TICKS Const64(300000000) /* 300 seconds */ ++# define MAX_PERF_COUNTER_TICKS Const64(300000000) /* 300 seconds */ + +-static int +-_gettimeofday(pTHX_ struct timeval *tp, void *not_used) ++/* ++ * Windows 8 introduced GetSystemTimePreciseAsFileTime(), but currently we have ++ * to support older systems, so for now we provide our own implementation. ++ * In the future we will switch to the real deal. ++ */ ++static void ++_GetSystemTimePreciseAsFileTime(pTHX_ FILETIME *out) + { + dMY_CXT; +- +- unsigned __int64 ticks; + FT_t ft; + +- PERL_UNUSED_ARG(not_used); + if (MY_CXT.run_count++ == 0 || +- MY_CXT.base_systime_as_filetime.ft_i64 > MY_CXT.reset_time) { ++ MY_CXT.base_systime_as_filetime.ft_i64 > MY_CXT.reset_time) { ++ + QueryPerformanceFrequency((LARGE_INTEGER*)&MY_CXT.tick_frequency); + QueryPerformanceCounter((LARGE_INTEGER*)&MY_CXT.base_ticks); + GetSystemTimeAsFileTime(&MY_CXT.base_systime_as_filetime.ft_val); + ft.ft_i64 = MY_CXT.base_systime_as_filetime.ft_i64; +- MY_CXT.reset_time = ft.ft_i64 + MAX_PERF_COUNTER_TICKS; ++ MY_CXT.reset_time = ft.ft_i64 + MAX_PERF_COUNTER_TICKS; + } + else { +- __int64 diff; ++ __int64 diff; ++ unsigned __int64 ticks; + QueryPerformanceCounter((LARGE_INTEGER*)&ticks); + ticks -= MY_CXT.base_ticks; + ft.ft_i64 = MY_CXT.base_systime_as_filetime.ft_i64 + + Const64(IV_1E7) * (ticks / MY_CXT.tick_frequency) + +(Const64(IV_1E7) * (ticks % MY_CXT.tick_frequency)) / MY_CXT.tick_frequency; +- diff = ft.ft_i64 - MY_CXT.base_systime_as_filetime.ft_i64; +- if (diff < -MAX_PERF_COUNTER_SKEW || diff > MAX_PERF_COUNTER_SKEW) { +- MY_CXT.base_ticks += ticks; ++ diff = ft.ft_i64 - MY_CXT.base_systime_as_filetime.ft_i64; ++ if (diff < -MAX_PERF_COUNTER_SKEW || diff > MAX_PERF_COUNTER_SKEW) { ++ MY_CXT.base_ticks += ticks; + GetSystemTimeAsFileTime(&MY_CXT.base_systime_as_filetime.ft_val); + ft.ft_i64 = MY_CXT.base_systime_as_filetime.ft_i64; +- } ++ } + } + ++ *out = ft.ft_val; ++ ++ return; ++} ++ ++static int ++_gettimeofday(pTHX_ struct timeval *tp, void *not_used) ++{ ++ FT_t ft; ++ ++ PERL_UNUSED_ARG(not_used); ++ ++ GetSystemTimePreciseAsFileTime(&ft.ft_val); ++ + /* seconds since epoch */ + tp->tv_sec = (long)((ft.ft_i64 - EPOCH_BIAS) / Const64(IV_1E7)); + +@@ -226,54 +259,107 @@ _gettimeofday(pTHX_ struct timeval *tp, void *not_used) + + return 0; + } +-#endif + +-#if defined(WIN32) && !defined(ATLEASTFIVEOHOHFIVE) +-static unsigned int +-sleep(unsigned int t) ++static int ++_clock_gettime(pTHX_ clockid_t clock_id, struct timespec *tp) + { +- Sleep(t*1000); ++ FT_t ft; ++ ++ switch (clock_id) { ++ case CLOCK_REALTIME: { ++ FT_t ft; ++ ++ GetSystemTimePreciseAsFileTime(&ft.ft_val); ++ tp->tv_sec = (time_t)((ft.ft_i64 - EPOCH_BIAS) / IV_1E7); ++ tp->tv_nsec = (long)((ft.ft_i64 % IV_1E7) * 100); ++ break; ++ } ++ case CLOCK_MONOTONIC: { ++ unsigned __int64 freq, ticks; ++ ++ QueryPerformanceFrequency((LARGE_INTEGER*)&freq); ++ QueryPerformanceCounter((LARGE_INTEGER*)&ticks); ++ ++ tp->tv_sec = (time_t)(ticks / freq); ++ tp->tv_nsec = (long)((IV_1E9 * (ticks % freq)) / freq); ++ break; ++ } ++ default: ++ errno = EINVAL; ++ return 1; ++ } ++ + return 0; + } +-#endif ++ ++static int ++_clock_getres(clockid_t clock_id, struct timespec *tp) ++{ ++ unsigned __int64 freq, qpc_res_ns; ++ ++ QueryPerformanceFrequency((LARGE_INTEGER*)&freq); ++ qpc_res_ns = IV_1E9 > freq ? IV_1E9 / freq : 1; ++ ++ switch (clock_id) { ++ case CLOCK_REALTIME: ++ tp->tv_sec = 0; ++ /* the resolution can't be smaller than 100ns because our implementation ++ * of CLOCK_REALTIME is using FILETIME internally */ ++ tp->tv_nsec = (long)(qpc_res_ns > 100 ? qpc_res_ns : 100); ++ break; ++ ++ case CLOCK_MONOTONIC: ++ tp->tv_sec = 0; ++ tp->tv_nsec = (long)qpc_res_ns; ++ break; ++ ++ default: ++ errno = EINVAL; ++ return 1; ++ } ++ ++ return 0; ++} ++ ++#endif /* #if defined(WIN32) || defined(CYGWIN_WITH_W32API) */ + + #if !defined(HAS_GETTIMEOFDAY) && defined(VMS) +-#define HAS_GETTIMEOFDAY +- +-#include +-#include /* gettimeofday */ +-#include /* qdiv */ +-#include /* sys$gettim */ +-#include +-#ifdef __VAX +-#include /* lib$ediv() */ +-#endif ++# define HAS_GETTIMEOFDAY ++ ++# include ++# include /* gettimeofday */ ++# include /* qdiv */ ++# include /* sys$gettim */ ++# include ++# ifdef __VAX ++# include /* lib$ediv() */ ++# endif + + /* + VMS binary time is expressed in 100 nano-seconds since + system base time which is 17-NOV-1858 00:00:00.00 + */ + +-#define DIV_100NS_TO_SECS 10000000L +-#define DIV_100NS_TO_USECS 10L ++# define DIV_100NS_TO_SECS 10000000L ++# define DIV_100NS_TO_USECS 10L + +-/* ++/* + gettimeofday is supposed to return times since the epoch + so need to determine this in terms of VMS base time + */ + static $DESCRIPTOR(dscepoch,"01-JAN-1970 00:00:00.00"); + +-#ifdef __VAX ++# ifdef __VAX + static long base_adjust[2]={0L,0L}; +-#else ++# else + static __int64 base_adjust=0; +-#endif ++# endif + +-/* ++/* + + If we don't have gettimeofday, then likely we are on a VMS machine that + operates on local time rather than UTC...so we have to zone-adjust. +- This code gleefully swiped from VMS.C ++ This code gleefully swiped from VMS.C + + */ + /* method used to handle UTC conversions: +@@ -282,115 +368,115 @@ static __int64 base_adjust=0; + static int gmtime_emulation_type; + /* number of secs to add to UTC POSIX-style time to get local time */ + static long int utc_offset_secs; +-static struct dsc$descriptor_s fildevdsc = +- { 12, DSC$K_DTYPE_T, DSC$K_CLASS_S, "LNM$FILE_DEV" }; ++static struct dsc$descriptor_s fildevdsc = ++ { 12, DSC$K_DTYPE_T, DSC$K_CLASS_S, "LNM$FILE_DEV" }; + static struct dsc$descriptor_s *fildev[] = { &fildevdsc, NULL }; + + static time_t toutc_dst(time_t loc) { +- struct tm *rsltmp; ++ struct tm *rsltmp; + +- if ((rsltmp = localtime(&loc)) == NULL) return -1; +- loc -= utc_offset_secs; +- if (rsltmp->tm_isdst) loc -= 3600; +- return loc; ++ if ((rsltmp = localtime(&loc)) == NULL) return -1; ++ loc -= utc_offset_secs; ++ if (rsltmp->tm_isdst) loc -= 3600; ++ return loc; + } + + static time_t toloc_dst(time_t utc) { +- struct tm *rsltmp; ++ struct tm *rsltmp; + +- utc += utc_offset_secs; +- if ((rsltmp = localtime(&utc)) == NULL) return -1; +- if (rsltmp->tm_isdst) utc += 3600; +- return utc; ++ utc += utc_offset_secs; ++ if ((rsltmp = localtime(&utc)) == NULL) return -1; ++ if (rsltmp->tm_isdst) utc += 3600; ++ return utc; + } + +-#define _toutc(secs) ((secs) == (time_t) -1 ? (time_t) -1 : \ +- ((gmtime_emulation_type || timezone_setup()), \ +- (gmtime_emulation_type == 1 ? toutc_dst(secs) : \ +- ((secs) - utc_offset_secs)))) ++# define _toutc(secs) ((secs) == (time_t) -1 ? (time_t) -1 : \ ++ ((gmtime_emulation_type || timezone_setup()), \ ++ (gmtime_emulation_type == 1 ? toutc_dst(secs) : \ ++ ((secs) - utc_offset_secs)))) + +-#define _toloc(secs) ((secs) == (time_t) -1 ? (time_t) -1 : \ +- ((gmtime_emulation_type || timezone_setup()), \ +- (gmtime_emulation_type == 1 ? toloc_dst(secs) : \ +- ((secs) + utc_offset_secs)))) ++# define _toloc(secs) ((secs) == (time_t) -1 ? (time_t) -1 : \ ++ ((gmtime_emulation_type || timezone_setup()), \ ++ (gmtime_emulation_type == 1 ? toloc_dst(secs) : \ ++ ((secs) + utc_offset_secs)))) + + static int +-timezone_setup(void) ++timezone_setup(void) + { +- struct tm *tm_p; +- +- if (gmtime_emulation_type == 0) { +- int dstnow; +- time_t base = 15 * 86400; /* 15jan71; to avoid month/year ends between */ +- /* results of calls to gmtime() and localtime() */ +- /* for same &base */ ++ struct tm *tm_p; + +- gmtime_emulation_type++; +- if ((tm_p = gmtime(&base)) == NULL) { /* CRTL gmtime() is a fake */ +- char off[LNM$C_NAMLENGTH+1];; ++ if (gmtime_emulation_type == 0) { ++ int dstnow; ++ time_t base = 15 * 86400; /* 15jan71; to avoid month/year ends between */ ++ /* results of calls to gmtime() and localtime() */ ++ /* for same &base */ + +- gmtime_emulation_type++; +- if (!Perl_vmstrnenv("SYS$TIMEZONE_DIFFERENTIAL",off,0,fildev,0)) { + gmtime_emulation_type++; +- utc_offset_secs = 0; +- Perl_warn(aTHX_ "no UTC offset information; assuming local time is UTC"); +- } +- else { utc_offset_secs = atol(off); } +- } +- else { /* We've got a working gmtime() */ +- struct tm gmt, local; +- +- gmt = *tm_p; +- tm_p = localtime(&base); +- local = *tm_p; +- utc_offset_secs = (local.tm_mday - gmt.tm_mday) * 86400; +- utc_offset_secs += (local.tm_hour - gmt.tm_hour) * 3600; +- utc_offset_secs += (local.tm_min - gmt.tm_min) * 60; +- utc_offset_secs += (local.tm_sec - gmt.tm_sec); ++ if ((tm_p = gmtime(&base)) == NULL) { /* CRTL gmtime() is a fake */ ++ char off[LNM$C_NAMLENGTH+1];; ++ ++ gmtime_emulation_type++; ++ if (!Perl_vmstrnenv("SYS$TIMEZONE_DIFFERENTIAL",off,0,fildev,0)) { ++ gmtime_emulation_type++; ++ utc_offset_secs = 0; ++ Perl_warn(aTHX_ "no UTC offset information; assuming local time is UTC"); ++ } ++ else { utc_offset_secs = atol(off); } ++ } ++ else { /* We've got a working gmtime() */ ++ struct tm gmt, local; ++ ++ gmt = *tm_p; ++ tm_p = localtime(&base); ++ local = *tm_p; ++ utc_offset_secs = (local.tm_mday - gmt.tm_mday) * 86400; ++ utc_offset_secs += (local.tm_hour - gmt.tm_hour) * 3600; ++ utc_offset_secs += (local.tm_min - gmt.tm_min) * 60; ++ utc_offset_secs += (local.tm_sec - gmt.tm_sec); ++ } + } +- } +- return 1; ++ return 1; + } + + + int + gettimeofday (struct timeval *tp, void *tpz) + { +- long ret; +-#ifdef __VAX +- long quad[2]; +- long quad1[2]; +- long div_100ns_to_secs; +- long div_100ns_to_usecs; +- long quo,rem; +- long quo1,rem1; +-#else +- __int64 quad; +- __qdiv_t ans1,ans2; +-#endif +-/* ++ long ret; ++# ifdef __VAX ++ long quad[2]; ++ long quad1[2]; ++ long div_100ns_to_secs; ++ long div_100ns_to_usecs; ++ long quo,rem; ++ long quo1,rem1; ++# else ++ __int64 quad; ++ __qdiv_t ans1,ans2; ++# endif ++ /* + In case of error, tv_usec = 0 and tv_sec = VMS condition code. + The return from function is also set to -1. + This is not exactly as per the manual page. +-*/ ++ */ + +- tp->tv_usec = 0; ++ tp->tv_usec = 0; + +-#ifdef __VAX +- if (base_adjust[0]==0 && base_adjust[1]==0) { +-#else +- if (base_adjust==0) { /* Need to determine epoch adjustment */ +-#endif ++# ifdef __VAX ++ if (base_adjust[0]==0 && base_adjust[1]==0) { ++# else ++ if (base_adjust==0) { /* Need to determine epoch adjustment */ ++# endif + ret=sys$bintim(&dscepoch,&base_adjust); + if (1 != (ret &&1)) { +- tp->tv_sec = ret; +- return -1; ++ tp->tv_sec = ret; ++ return -1; + } +- } ++ } + +- ret=sys$gettim(&quad); /* Get VMS system time */ +- if ((1 && ret) == 1) { +-#ifdef __VAX ++ ret=sys$gettim(&quad); /* Get VMS system time */ ++ if ((1 && ret) == 1) { ++# ifdef __VAX + quad[0] -= base_adjust[0]; /* convert to epoch offset */ + quad[1] -= base_adjust[1]; /* convert 2nd half of quadword */ + div_100ns_to_secs = DIV_100NS_TO_SECS; +@@ -401,27 +487,27 @@ gettimeofday (struct timeval *tp, void *tpz) + lib$ediv(&div_100ns_to_usecs,&quad1,&quo1,&rem1); + tp->tv_sec = quo; /* Whole seconds */ + tp->tv_usec = quo1; /* Micro-seconds */ +-#else ++# else + quad -= base_adjust; /* convert to epoch offset */ + ans1=qdiv(quad,DIV_100NS_TO_SECS); + ans2=qdiv(ans1.rem,DIV_100NS_TO_USECS); + tp->tv_sec = ans1.quot; /* Whole seconds */ + tp->tv_usec = ans2.quot; /* Micro-seconds */ +-#endif +- } else { ++# endif ++ } else { + tp->tv_sec = ret; + return -1; +- } +-# ifdef VMSISH_TIME +-# ifdef RTL_USES_UTC +- if (VMSISH_TIME) tp->tv_sec = _toloc(tp->tv_sec); +-# else +- if (!VMSISH_TIME) tp->tv_sec = _toutc(tp->tv_sec); +-# endif +-# endif +- return 0; ++ } ++# ifdef VMSISH_TIME ++# ifdef RTL_USES_UTC ++ if (VMSISH_TIME) tp->tv_sec = _toloc(tp->tv_sec); ++# else ++ if (!VMSISH_TIME) tp->tv_sec = _toutc(tp->tv_sec); ++# endif ++# endif ++ return 0; + } +-#endif ++#endif /* #if !defined(HAS_GETTIMEOFDAY) && defined(VMS) */ + + + /* Do not use H A S _ N A N O S L E E P +@@ -430,8 +516,8 @@ gettimeofday (struct timeval *tp, void *tpz) + * (We are part of the core perl now.) + * The TIME_HIRES_NANOSLEEP is set by Makefile.PL. */ + #if !defined(HAS_USLEEP) && defined(TIME_HIRES_NANOSLEEP) +-#define HAS_USLEEP +-#define usleep hrt_usleep /* could conflict with ncurses for static build */ ++# define HAS_USLEEP ++# define usleep hrt_usleep /* could conflict with ncurses for static build */ + + static void + hrt_usleep(unsigned long usec) /* This is used to emulate usleep. */ +@@ -445,9 +531,9 @@ hrt_usleep(unsigned long usec) /* This is used to emulate usleep. */ + #endif /* #if !defined(HAS_USLEEP) && defined(TIME_HIRES_NANOSLEEP) */ + + #if !defined(HAS_USLEEP) && defined(HAS_SELECT) +-#ifndef SELECT_IS_BROKEN +-#define HAS_USLEEP +-#define usleep hrt_usleep /* could conflict with ncurses for static build */ ++# ifndef SELECT_IS_BROKEN ++# define HAS_USLEEP ++# define usleep hrt_usleep /* could conflict with ncurses for static build */ + + static void + hrt_usleep(unsigned long usec) +@@ -456,14 +542,14 @@ hrt_usleep(unsigned long usec) + tv.tv_sec = 0; + tv.tv_usec = usec; + select(0, (Select_fd_set_t)NULL, (Select_fd_set_t)NULL, +- (Select_fd_set_t)NULL, &tv); ++ (Select_fd_set_t)NULL, &tv); + } +-#endif ++# endif + #endif /* #if !defined(HAS_USLEEP) && defined(HAS_SELECT) */ + + #if !defined(HAS_USLEEP) && defined(WIN32) +-#define HAS_USLEEP +-#define usleep hrt_usleep /* could conflict with ncurses for static build */ ++# define HAS_USLEEP ++# define usleep hrt_usleep /* could conflict with ncurses for static build */ + + static void + hrt_usleep(unsigned long usec) +@@ -475,8 +561,8 @@ hrt_usleep(unsigned long usec) + #endif /* #if !defined(HAS_USLEEP) && defined(WIN32) */ + + #if !defined(HAS_USLEEP) && defined(HAS_POLL) +-#define HAS_USLEEP +-#define usleep hrt_usleep /* could conflict with ncurses for static build */ ++# define HAS_USLEEP ++# define usleep hrt_usleep /* could conflict with ncurses for static build */ + + static void + hrt_usleep(unsigned long usec) +@@ -492,34 +578,34 @@ hrt_usleep(unsigned long usec) + static int + hrt_ualarm_itimero(struct itimerval *oitv, int usec, int uinterval) + { +- struct itimerval itv; +- itv.it_value.tv_sec = usec / IV_1E6; +- itv.it_value.tv_usec = usec % IV_1E6; +- itv.it_interval.tv_sec = uinterval / IV_1E6; +- itv.it_interval.tv_usec = uinterval % IV_1E6; +- return setitimer(ITIMER_REAL, &itv, oitv); ++ struct itimerval itv; ++ itv.it_value.tv_sec = usec / IV_1E6; ++ itv.it_value.tv_usec = usec % IV_1E6; ++ itv.it_interval.tv_sec = uinterval / IV_1E6; ++ itv.it_interval.tv_usec = uinterval % IV_1E6; ++ return setitimer(ITIMER_REAL, &itv, oitv); + } + + #endif /* #if !defined(HAS_UALARM) && defined(HAS_SETITIMER) */ + + #if !defined(HAS_UALARM) && defined(HAS_SETITIMER) +-#define HAS_UALARM +-#define ualarm hrt_ualarm_itimer /* could conflict with ncurses for static build */ ++# define HAS_UALARM ++# define ualarm hrt_ualarm_itimer /* could conflict with ncurses for static build */ + #endif + + #if !defined(HAS_UALARM) && defined(VMS) +-#define HAS_UALARM +-#define ualarm vms_ualarm ++# define HAS_UALARM ++# define ualarm vms_ualarm + +-#include +-#include +-#include +-#include +-#include +-#include +-#include ++# include ++# include ++# include ++# include ++# include ++# include ++# include + +-#define VMSERR(s) (!((s)&1)) ++# define VMSERR(s) (!((s)&1)) + + static void + us_to_VMS(useconds_t mseconds, unsigned long v[]) +@@ -567,13 +653,13 @@ typedef struct _ualarm { + + static int alarm_ef; + static Alarm *a0, alarm_base; +-#define UAL_NULL 0 +-#define UAL_SET 1 +-#define UAL_CLEAR 2 +-#define UAL_ACTIVE 4 ++# define UAL_NULL 0 ++# define UAL_SET 1 ++# define UAL_CLEAR 2 ++# define UAL_ACTIVE 4 + static void ualarm_AST(Alarm *a); + +-static int ++static int + vms_ualarm(int mseconds, int interval) + { + Alarm *a, abase; +@@ -605,7 +691,7 @@ vms_ualarm(int mseconds, int interval) + a0->function = UAL_NULL; + } + itmlst[0].bufaddr = &asten; +- ++ + iss = sys$getjpiw(0,0,0,itmlst,0,0,0); + if (VMSERR(iss)) lib$signal(iss); + if (!(asten&0x08)) return -1; +@@ -621,7 +707,7 @@ vms_ualarm(int mseconds, int interval) + if (interval) { + us_to_VMS(interval, a->interval); + a->repeat = 1; +- } else ++ } else + a->repeat = 0; + + iss = sys$clref(alarm_ef); +@@ -633,7 +719,7 @@ vms_ualarm(int mseconds, int interval) + iss = sys$waitfr(alarm_ef); + if (VMSERR(iss)) lib$signal(iss); + +- if (a->function == UAL_ACTIVE) ++ if (a->function == UAL_ACTIVE) + return VMS_to_us(a->remain); + else + return 0; +@@ -658,7 +744,7 @@ ualarm_AST(Alarm *a) + iss = lib$subx(a0->remain, now, a->remain); + if (VMSERR(iss)) lib$signal(iss); + +- if (a->remain[1] & 0x80000000) ++ if (a->remain[1] & 0x80000000) + a->remain[0] = a->remain[1] = 0; + } + +@@ -709,24 +795,24 @@ ualarm_AST(Alarm *a) + static int + myU2time(pTHX_ UV *ret) + { +- struct timeval Tp; +- int status; +- status = gettimeofday (&Tp, NULL); +- ret[0] = Tp.tv_sec; +- ret[1] = Tp.tv_usec; +- return status; ++ struct timeval Tp; ++ int status; ++ status = gettimeofday (&Tp, NULL); ++ ret[0] = Tp.tv_sec; ++ ret[1] = Tp.tv_usec; ++ return status; + } + + static NV + myNVtime() + { +-#ifdef WIN32 +- dTHX; +-#endif +- struct timeval Tp; +- int status; +- status = gettimeofday (&Tp, NULL); +- return status == 0 ? Tp.tv_sec + (Tp.tv_usec / NV_1E6) : -1.0; ++# ifdef WIN32 ++ dTHX; ++# endif ++ struct timeval Tp; ++ int status; ++ status = gettimeofday (&Tp, NULL); ++ return status == 0 ? Tp.tv_sec + (Tp.tv_usec / NV_1E6) : -1.0; + } + + #endif /* #ifdef HAS_GETTIMEOFDAY */ +@@ -734,31 +820,31 @@ myNVtime() + static void + hrstatns(UV *atime_nsec, UV *mtime_nsec, UV *ctime_nsec) + { +- dTHX; ++ dTHX; + #if TIME_HIRES_STAT == 1 +- *atime_nsec = PL_statcache.st_atimespec.tv_nsec; +- *mtime_nsec = PL_statcache.st_mtimespec.tv_nsec; +- *ctime_nsec = PL_statcache.st_ctimespec.tv_nsec; ++ *atime_nsec = PL_statcache.st_atimespec.tv_nsec; ++ *mtime_nsec = PL_statcache.st_mtimespec.tv_nsec; ++ *ctime_nsec = PL_statcache.st_ctimespec.tv_nsec; + #elif TIME_HIRES_STAT == 2 +- *atime_nsec = PL_statcache.st_atimensec; +- *mtime_nsec = PL_statcache.st_mtimensec; +- *ctime_nsec = PL_statcache.st_ctimensec; ++ *atime_nsec = PL_statcache.st_atimensec; ++ *mtime_nsec = PL_statcache.st_mtimensec; ++ *ctime_nsec = PL_statcache.st_ctimensec; + #elif TIME_HIRES_STAT == 3 +- *atime_nsec = PL_statcache.st_atime_n; +- *mtime_nsec = PL_statcache.st_mtime_n; +- *ctime_nsec = PL_statcache.st_ctime_n; ++ *atime_nsec = PL_statcache.st_atime_n; ++ *mtime_nsec = PL_statcache.st_mtime_n; ++ *ctime_nsec = PL_statcache.st_ctime_n; + #elif TIME_HIRES_STAT == 4 +- *atime_nsec = PL_statcache.st_atim.tv_nsec; +- *mtime_nsec = PL_statcache.st_mtim.tv_nsec; +- *ctime_nsec = PL_statcache.st_ctim.tv_nsec; ++ *atime_nsec = PL_statcache.st_atim.tv_nsec; ++ *mtime_nsec = PL_statcache.st_mtim.tv_nsec; ++ *ctime_nsec = PL_statcache.st_ctim.tv_nsec; + #elif TIME_HIRES_STAT == 5 +- *atime_nsec = PL_statcache.st_uatime * 1000; +- *mtime_nsec = PL_statcache.st_umtime * 1000; +- *ctime_nsec = PL_statcache.st_uctime * 1000; ++ *atime_nsec = PL_statcache.st_uatime * 1000; ++ *mtime_nsec = PL_statcache.st_umtime * 1000; ++ *ctime_nsec = PL_statcache.st_uctime * 1000; + #else /* !TIME_HIRES_STAT */ +- *atime_nsec = 0; +- *mtime_nsec = 0; +- *ctime_nsec = 0; ++ *atime_nsec = 0; ++ *mtime_nsec = 0; ++ *ctime_nsec = 0; + #endif /* !TIME_HIRES_STAT */ + } + +@@ -770,157 +856,157 @@ hrstatns(UV *atime_nsec, UV *mtime_nsec, UV *ctime_nsec) + defined(TIME_HIRES_CLOCK_GETRES_EMULATION) || \ + defined(TIME_HIRES_CLOCK_NANOSLEEP_EMULATION)) + +-#ifndef CLOCK_REALTIME +-# define CLOCK_REALTIME 0x01 +-# define CLOCK_MONOTONIC 0x02 +-#endif ++# ifndef CLOCK_REALTIME ++# define CLOCK_REALTIME 0x01 ++# define CLOCK_MONOTONIC 0x02 ++# endif + +-#ifndef TIMER_ABSTIME +-# define TIMER_ABSTIME 0x01 +-#endif ++# ifndef TIMER_ABSTIME ++# define TIMER_ABSTIME 0x01 ++# endif + +-#ifdef USE_ITHREADS +-# define PERL_DARWIN_MUTEX +-#endif ++# ifdef USE_ITHREADS ++# define PERL_DARWIN_MUTEX ++# endif + +-#ifdef PERL_DARWIN_MUTEX ++# ifdef PERL_DARWIN_MUTEX + STATIC perl_mutex darwin_time_mutex; +-#endif ++# endif + +-#include ++# include + + static uint64_t absolute_time_init; + static mach_timebase_info_data_t timebase_info; + static struct timespec timespec_init; + + static int darwin_time_init() { +- struct timeval tv; +- int success = 1; +-#ifdef PERL_DARWIN_MUTEX +- MUTEX_LOCK(&darwin_time_mutex); +-#endif +- if (absolute_time_init == 0) { +- /* mach_absolute_time() cannot fail */ +- absolute_time_init = mach_absolute_time(); +- success = mach_timebase_info(&timebase_info) == KERN_SUCCESS; +- if (success) { +- success = gettimeofday(&tv, NULL) == 0; +- if (success) { +- timespec_init.tv_sec = tv.tv_sec; +- timespec_init.tv_nsec = tv.tv_usec * 1000; +- } ++ struct timeval tv; ++ int success = 1; ++# ifdef PERL_DARWIN_MUTEX ++ MUTEX_LOCK(&darwin_time_mutex); ++# endif ++ if (absolute_time_init == 0) { ++ /* mach_absolute_time() cannot fail */ ++ absolute_time_init = mach_absolute_time(); ++ success = mach_timebase_info(&timebase_info) == KERN_SUCCESS; ++ if (success) { ++ success = gettimeofday(&tv, NULL) == 0; ++ if (success) { ++ timespec_init.tv_sec = tv.tv_sec; ++ timespec_init.tv_nsec = tv.tv_usec * 1000; ++ } ++ } + } +- } +-#ifdef PERL_DARWIN_MUTEX +- MUTEX_UNLOCK(&darwin_time_mutex); +-#endif +- return success; ++# ifdef PERL_DARWIN_MUTEX ++ MUTEX_UNLOCK(&darwin_time_mutex); ++# endif ++ return success; + } + +-#ifdef TIME_HIRES_CLOCK_GETTIME_EMULATION ++# ifdef TIME_HIRES_CLOCK_GETTIME_EMULATION + static int th_clock_gettime(clockid_t clock_id, struct timespec *ts) { +- if (darwin_time_init() && timebase_info.denom) { +- switch (clock_id) { +- case CLOCK_REALTIME: +- { +- uint64_t nanos = +- ((mach_absolute_time() - absolute_time_init) * +- (uint64_t)timebase_info.numer) / (uint64_t)timebase_info.denom; +- ts->tv_sec = timespec_init.tv_sec + nanos / IV_1E9; +- ts->tv_nsec = timespec_init.tv_nsec + nanos % IV_1E9; +- return 0; +- } +- +- case CLOCK_MONOTONIC: +- { +- uint64_t nanos = +- (mach_absolute_time() * +- (uint64_t)timebase_info.numer) / (uint64_t)timebase_info.denom; +- ts->tv_sec = nanos / IV_1E9; +- ts->tv_nsec = nanos - ts->tv_sec * IV_1E9; +- return 0; +- } +- +- default: +- break; ++ if (darwin_time_init() && timebase_info.denom) { ++ switch (clock_id) { ++ case CLOCK_REALTIME: ++ { ++ uint64_t nanos = ++ ((mach_absolute_time() - absolute_time_init) * ++ (uint64_t)timebase_info.numer) / (uint64_t)timebase_info.denom; ++ ts->tv_sec = timespec_init.tv_sec + nanos / IV_1E9; ++ ts->tv_nsec = timespec_init.tv_nsec + nanos % IV_1E9; ++ return 0; ++ } ++ ++ case CLOCK_MONOTONIC: ++ { ++ uint64_t nanos = ++ (mach_absolute_time() * ++ (uint64_t)timebase_info.numer) / (uint64_t)timebase_info.denom; ++ ts->tv_sec = nanos / IV_1E9; ++ ts->tv_nsec = nanos - ts->tv_sec * IV_1E9; ++ return 0; ++ } ++ ++ default: ++ break; ++ } + } +- } + +- SETERRNO(EINVAL, LIB_INVARG); +- return -1; ++ SETERRNO(EINVAL, LIB_INVARG); ++ return -1; + } + +-#define clock_gettime(clock_id, ts) th_clock_gettime((clock_id), (ts)) ++# define clock_gettime(clock_id, ts) th_clock_gettime((clock_id), (ts)) + +-#endif /* TIME_HIRES_CLOCK_GETTIME_EMULATION */ ++# endif /* TIME_HIRES_CLOCK_GETTIME_EMULATION */ + +-#ifdef TIME_HIRES_CLOCK_GETRES_EMULATION ++# ifdef TIME_HIRES_CLOCK_GETRES_EMULATION + static int th_clock_getres(clockid_t clock_id, struct timespec *ts) { +- if (darwin_time_init() && timebase_info.denom) { +- switch (clock_id) { +- case CLOCK_REALTIME: +- case CLOCK_MONOTONIC: +- ts->tv_sec = 0; +- /* In newer kernels both the numer and denom are one, +- * resulting in conversion factor of one, which is of +- * course unrealistic. */ +- ts->tv_nsec = timebase_info.numer / timebase_info.denom; +- return 0; +- default: +- break; ++ if (darwin_time_init() && timebase_info.denom) { ++ switch (clock_id) { ++ case CLOCK_REALTIME: ++ case CLOCK_MONOTONIC: ++ ts->tv_sec = 0; ++ /* In newer kernels both the numer and denom are one, ++ * resulting in conversion factor of one, which is of ++ * course unrealistic. */ ++ ts->tv_nsec = timebase_info.numer / timebase_info.denom; ++ return 0; ++ default: ++ break; ++ } + } +- } + +- SETERRNO(EINVAL, LIB_INVARG); +- return -1; ++ SETERRNO(EINVAL, LIB_INVARG); ++ return -1; + } + +-#define clock_getres(clock_id, ts) th_clock_getres((clock_id), (ts)) +-#endif /* TIME_HIRES_CLOCK_GETRES_EMULATION */ ++# define clock_getres(clock_id, ts) th_clock_getres((clock_id), (ts)) ++# endif /* TIME_HIRES_CLOCK_GETRES_EMULATION */ + +-#ifdef TIME_HIRES_CLOCK_NANOSLEEP_EMULATION ++# ifdef TIME_HIRES_CLOCK_NANOSLEEP_EMULATION + static int th_clock_nanosleep(clockid_t clock_id, int flags, +- const struct timespec *rqtp, +- struct timespec *rmtp) { +- if (darwin_time_init()) { +- switch (clock_id) { +- case CLOCK_REALTIME: +- case CLOCK_MONOTONIC: +- { +- uint64_t nanos = rqtp->tv_sec * IV_1E9 + rqtp->tv_nsec; +- int success; +- if ((flags & TIMER_ABSTIME)) { +- uint64_t back = +- timespec_init.tv_sec * IV_1E9 + timespec_init.tv_nsec; +- nanos = nanos > back ? nanos - back : 0; +- } +- success = +- mach_wait_until(mach_absolute_time() + nanos) == KERN_SUCCESS; +- +- /* In the relative sleep, the rmtp should be filled in with +- * the 'unused' part of the rqtp in case the sleep gets +- * interrupted by a signal. But it is unknown how signals +- * interact with mach_wait_until(). In the absolute sleep, +- * the rmtp should stay untouched. */ +- rmtp->tv_sec = 0; +- rmtp->tv_nsec = 0; +- +- return success; +- } ++ const struct timespec *rqtp, ++ struct timespec *rmtp) { ++ if (darwin_time_init()) { ++ switch (clock_id) { ++ case CLOCK_REALTIME: ++ case CLOCK_MONOTONIC: ++ { ++ uint64_t nanos = rqtp->tv_sec * IV_1E9 + rqtp->tv_nsec; ++ int success; ++ if ((flags & TIMER_ABSTIME)) { ++ uint64_t back = ++ timespec_init.tv_sec * IV_1E9 + timespec_init.tv_nsec; ++ nanos = nanos > back ? nanos - back : 0; ++ } ++ success = ++ mach_wait_until(mach_absolute_time() + nanos) == KERN_SUCCESS; ++ ++ /* In the relative sleep, the rmtp should be filled in with ++ * the 'unused' part of the rqtp in case the sleep gets ++ * interrupted by a signal. But it is unknown how signals ++ * interact with mach_wait_until(). In the absolute sleep, ++ * the rmtp should stay untouched. */ ++ rmtp->tv_sec = 0; ++ rmtp->tv_nsec = 0; ++ ++ return success; ++ } + +- default: +- break; ++ default: ++ break; ++ } + } +- } + +- SETERRNO(EINVAL, LIB_INVARG); +- return -1; ++ SETERRNO(EINVAL, LIB_INVARG); ++ return -1; + } + +-#define clock_nanosleep(clock_id, flags, rqtp, rmtp) \ ++# define clock_nanosleep(clock_id, flags, rqtp, rmtp) \ + th_clock_nanosleep((clock_id), (flags), (rqtp), (rmtp)) + +-#endif /* TIME_HIRES_CLOCK_NANOSLEEP_EMULATION */ ++# endif /* TIME_HIRES_CLOCK_NANOSLEEP_EMULATION */ + + #endif /* PERL_DARWIN */ + +@@ -937,25 +1023,25 @@ static int th_clock_nanosleep(clockid_t clock_id, int flags, + * are always available. + */ + #ifndef __has_builtin +-# define __has_builtin(x) 0 /* non-clang */ ++# define __has_builtin(x) 0 /* non-clang */ + #endif + #ifdef HAS_FUTIMENS +-# if defined(PERL_DARWIN) && __has_builtin(__builtin_available) +-# define FUTIMENS_AVAILABLE __builtin_available(macOS 10.13, *) +-# else +-# define FUTIMENS_AVAILABLE 1 +-# endif ++# if defined(PERL_DARWIN) && __has_builtin(__builtin_available) ++# define FUTIMENS_AVAILABLE __builtin_available(macOS 10.13, *) ++# else ++# define FUTIMENS_AVAILABLE 1 ++# endif + #else +-# define FUTIMENS_AVAILABLE 0 ++# define FUTIMENS_AVAILABLE 0 + #endif + #ifdef HAS_UTIMENSAT +-# if defined(PERL_DARWIN) && __has_builtin(__builtin_available) +-# define UTIMENSAT_AVAILABLE __builtin_available(macOS 10.13, *) +-# else +-# define UTIMENSAT_AVAILABLE 1 +-# endif ++# if defined(PERL_DARWIN) && __has_builtin(__builtin_available) ++# define UTIMENSAT_AVAILABLE __builtin_available(macOS 10.13, *) ++# else ++# define UTIMENSAT_AVAILABLE 1 ++# endif + #else +-# define UTIMENSAT_AVAILABLE 0 ++# define UTIMENSAT_AVAILABLE 0 + #endif + + #include "const-c.inc" +@@ -976,23 +1062,23 @@ nanosleep_init(NV nsec, + static NV + nsec_without_unslept(struct timespec *sleepfor, + const struct timespec *unslept) { +- if (sleepfor->tv_sec >= unslept->tv_sec) { +- sleepfor->tv_sec -= unslept->tv_sec; +- if (sleepfor->tv_nsec >= unslept->tv_nsec) { +- sleepfor->tv_nsec -= unslept->tv_nsec; +- } else if (sleepfor->tv_sec > 0) { +- sleepfor->tv_sec--; +- sleepfor->tv_nsec += IV_1E9; +- sleepfor->tv_nsec -= unslept->tv_nsec; ++ if (sleepfor->tv_sec >= unslept->tv_sec) { ++ sleepfor->tv_sec -= unslept->tv_sec; ++ if (sleepfor->tv_nsec >= unslept->tv_nsec) { ++ sleepfor->tv_nsec -= unslept->tv_nsec; ++ } else if (sleepfor->tv_sec > 0) { ++ sleepfor->tv_sec--; ++ sleepfor->tv_nsec += IV_1E9; ++ sleepfor->tv_nsec -= unslept->tv_nsec; ++ } else { ++ sleepfor->tv_sec = 0; ++ sleepfor->tv_nsec = 0; ++ } + } else { +- sleepfor->tv_sec = 0; +- sleepfor->tv_nsec = 0; ++ sleepfor->tv_sec = 0; ++ sleepfor->tv_nsec = 0; + } +- } else { +- sleepfor->tv_sec = 0; +- sleepfor->tv_nsec = 0; +- } +- return ((NV)sleepfor->tv_sec) * NV_1E9 + ((NV)sleepfor->tv_nsec); ++ return ((NV)sleepfor->tv_sec) * NV_1E9 + ((NV)sleepfor->tv_nsec); + } + + #endif +@@ -1000,17 +1086,17 @@ nsec_without_unslept(struct timespec *sleepfor, + /* In case Perl and/or Devel::PPPort are too old, minimally emulate + * IS_SAFE_PATHNAME() (which looks for zero bytes in the pathname). */ + #ifndef IS_SAFE_PATHNAME +-#if PERL_VERSION >= 12 /* Perl_ck_warner is 5.10.0 -> */ +-#ifdef WARN_SYSCALLS +-#define WARNEMUCAT WARN_SYSCALLS /* 5.22.0 -> */ +-#else +-#define WARNEMUCAT WARN_MISC +-#endif +-#define WARNEMU(opname) Perl_ck_warner(aTHX_ packWARN(WARNEMUCAT), "Invalid \\0 character in pathname for %s",opname) +-#else +-#define WARNEMU(opname) Perl_warn(aTHX_ "Invalid \\0 character in pathname for %s",opname) +-#endif +-#define IS_SAFE_PATHNAME(pv, len, opname) (((len)>1)&&memchr((pv), 0, (len)-1)?(SETERRNO(ENOENT, LIB_INVARG),WARNEMU(opname),FALSE):(TRUE)) ++# if PERL_VERSION >= 12 /* Perl_ck_warner is 5.10.0 -> */ ++# ifdef WARN_SYSCALLS ++# define WARNEMUCAT WARN_SYSCALLS /* 5.22.0 -> */ ++# else ++# define WARNEMUCAT WARN_MISC ++# endif ++# define WARNEMU(opname) Perl_ck_warner(aTHX_ packWARN(WARNEMUCAT), "Invalid \\0 character in pathname for %s",opname) ++# else ++# define WARNEMU(opname) Perl_warn(aTHX_ "Invalid \\0 character in pathname for %s",opname) ++# endif ++# define IS_SAFE_PATHNAME(pv, len, opname) (((len)>1)&&memchr((pv), 0, (len)-1)?(SETERRNO(ENOENT, LIB_INVARG),WARNEMU(opname),FALSE):(TRUE)) + #endif + + MODULE = Time::HiRes PACKAGE = Time::HiRes +@@ -1018,33 +1104,31 @@ MODULE = Time::HiRes PACKAGE = Time::HiRes + PROTOTYPES: ENABLE + + BOOT: +-{ ++ { + #ifdef MY_CXT_KEY +- MY_CXT_INIT; ++ MY_CXT_INIT; + #endif +-#ifdef ATLEASTFIVEOHOHFIVE +-# ifdef HAS_GETTIMEOFDAY +- { +- (void) hv_store(PL_modglobal, "Time::NVtime", 12, +- newSViv(PTR2IV(myNVtime)), 0); +- (void) hv_store(PL_modglobal, "Time::U2time", 12, +- newSViv(PTR2IV(myU2time)), 0); +- } +-# endif ++#ifdef HAS_GETTIMEOFDAY ++ { ++ (void) hv_store(PL_modglobal, "Time::NVtime", 12, ++ newSViv(PTR2IV(myNVtime)), 0); ++ (void) hv_store(PL_modglobal, "Time::U2time", 12, ++ newSViv(PTR2IV(myU2time)), 0); ++ } + #endif + #if defined(PERL_DARWIN) + # if defined(USE_ITHREADS) && defined(PERL_DARWIN_MUTEX) +- MUTEX_INIT(&darwin_time_mutex); ++ MUTEX_INIT(&darwin_time_mutex); + # endif + #endif +-} ++ } + + #if defined(USE_ITHREADS) && defined(MY_CXT_KEY) + + void + CLONE(...) + CODE: +- MY_CXT_CLONE; ++ MY_CXT_CLONE; + + #endif + +@@ -1054,122 +1138,125 @@ INCLUDE: const-xs.inc + + NV + usleep(useconds) +- NV useconds +- PREINIT: +- struct timeval Ta, Tb; +- CODE: +- gettimeofday(&Ta, NULL); +- if (items > 0) { +- if (useconds >= NV_1E6) { +- IV seconds = (IV) (useconds / NV_1E6); +- /* If usleep() has been implemented using setitimer() +- * then this contortion is unnecessary-- but usleep() +- * may be implemented in some other way, so let's contort. */ +- if (seconds) { +- sleep(seconds); +- useconds -= NV_1E6 * seconds; +- } +- } else if (useconds < 0.0) +- croak("Time::HiRes::usleep(%" NVgf ++ NV useconds ++ PREINIT: ++ struct timeval Ta, Tb; ++ CODE: ++ gettimeofday(&Ta, NULL); ++ if (items > 0) { ++ if (useconds >= NV_1E6) { ++ IV seconds = (IV) (useconds / NV_1E6); ++ /* If usleep() has been implemented using setitimer() ++ * then this contortion is unnecessary-- but usleep() ++ * may be implemented in some other way, so let's contort. */ ++ if (seconds) { ++ sleep(seconds); ++ useconds -= NV_1E6 * seconds; ++ } ++ } else if (useconds < 0.0) ++ croak("Time::HiRes::usleep(%" NVgf + "): negative time not invented yet", useconds); +- usleep((U32)useconds); +- } else +- PerlProc_pause(); +- gettimeofday(&Tb, NULL); +-#if 0 +- printf("[%ld %ld] [%ld %ld]\n", Tb.tv_sec, Tb.tv_usec, Ta.tv_sec, Ta.tv_usec); +-#endif +- RETVAL = NV_1E6*(Tb.tv_sec-Ta.tv_sec)+(NV)((IV)Tb.tv_usec-(IV)Ta.tv_usec); + +- OUTPUT: +- RETVAL ++ usleep((U32)useconds); ++ } else ++ PerlProc_pause(); + +-#if defined(TIME_HIRES_NANOSLEEP) ++ gettimeofday(&Tb, NULL); ++# if 0 ++ printf("[%ld %ld] [%ld %ld]\n", Tb.tv_sec, Tb.tv_usec, Ta.tv_sec, Ta.tv_usec); ++# endif ++ RETVAL = NV_1E6*(Tb.tv_sec-Ta.tv_sec)+(NV)((IV)Tb.tv_usec-(IV)Ta.tv_usec); ++ ++ OUTPUT: ++ RETVAL ++ ++# if defined(TIME_HIRES_NANOSLEEP) + + NV + nanosleep(nsec) +- NV nsec +- PREINIT: +- struct timespec sleepfor, unslept; +- CODE: +- if (nsec < 0.0) +- croak("Time::HiRes::nanosleep(%" NVgf ++ NV nsec ++ PREINIT: ++ struct timespec sleepfor, unslept; ++ CODE: ++ if (nsec < 0.0) ++ croak("Time::HiRes::nanosleep(%" NVgf + "): negative time not invented yet", nsec); + nanosleep_init(nsec, &sleepfor, &unslept); +- if (nanosleep(&sleepfor, &unslept) == 0) { +- RETVAL = nsec; +- } else { ++ if (nanosleep(&sleepfor, &unslept) == 0) { ++ RETVAL = nsec; ++ } else { + RETVAL = nsec_without_unslept(&sleepfor, &unslept); +- } ++ } + OUTPUT: +- RETVAL ++ RETVAL + +-#else /* #if defined(TIME_HIRES_NANOSLEEP) */ ++# else /* #if defined(TIME_HIRES_NANOSLEEP) */ + + NV + nanosleep(nsec) +- NV nsec ++ NV nsec + CODE: +- PERL_UNUSED_ARG(nsec); ++ PERL_UNUSED_ARG(nsec); + croak("Time::HiRes::nanosleep(): unimplemented in this platform"); + RETVAL = 0.0; + OUTPUT: +- RETVAL ++ RETVAL + +-#endif /* #if defined(TIME_HIRES_NANOSLEEP) */ ++# endif /* #if defined(TIME_HIRES_NANOSLEEP) */ + + NV + sleep(...) +- PREINIT: +- struct timeval Ta, Tb; +- CODE: +- gettimeofday(&Ta, NULL); +- if (items > 0) { +- NV seconds = SvNV(ST(0)); +- if (seconds >= 0.0) { +- UV useconds = (UV)(1E6 * (seconds - (UV)seconds)); +- if (seconds >= 1.0) +- sleep((U32)seconds); +- if ((IV)useconds < 0) { +-#if defined(__sparc64__) && defined(__GNUC__) +- /* Sparc64 gcc 2.95.3 (e.g. on NetBSD) has a bug +- * where (0.5 - (UV)(0.5)) will under certain +- * circumstances (if the double is cast to UV more +- * than once?) evaluate to -0.5, instead of 0.5. */ +- useconds = -(IV)useconds; +-#endif /* #if defined(__sparc64__) && defined(__GNUC__) */ +- if ((IV)useconds < 0) +- croak("Time::HiRes::sleep(%" NVgf +- "): internal error: useconds < 0 (unsigned %" UVuf +- " signed %" IVdf ")", +- seconds, useconds, (IV)useconds); +- } +- usleep(useconds); +- } else +- croak("Time::HiRes::sleep(%" NVgf ++ PREINIT: ++ struct timeval Ta, Tb; ++ CODE: ++ gettimeofday(&Ta, NULL); ++ if (items > 0) { ++ NV seconds = SvNV(ST(0)); ++ if (seconds >= 0.0) { ++ UV useconds = (UV)(1E6 * (seconds - (UV)seconds)); ++ if (seconds >= 1.0) ++ sleep((U32)seconds); ++ if ((IV)useconds < 0) { ++# if defined(__sparc64__) && defined(__GNUC__) ++ /* Sparc64 gcc 2.95.3 (e.g. on NetBSD) has a bug ++ * where (0.5 - (UV)(0.5)) will under certain ++ * circumstances (if the double is cast to UV more ++ * than once?) evaluate to -0.5, instead of 0.5. */ ++ useconds = -(IV)useconds; ++# endif /* #if defined(__sparc64__) && defined(__GNUC__) */ ++ if ((IV)useconds < 0) ++ croak("Time::HiRes::sleep(%" NVgf ++ "): internal error: useconds < 0 (unsigned %" UVuf ++ " signed %" IVdf ")", ++ seconds, useconds, (IV)useconds); ++ } ++ usleep(useconds); ++ } else ++ croak("Time::HiRes::sleep(%" NVgf + "): negative time not invented yet", seconds); +- } else +- PerlProc_pause(); +- gettimeofday(&Tb, NULL); +-#if 0 +- printf("[%ld %ld] [%ld %ld]\n", Tb.tv_sec, Tb.tv_usec, Ta.tv_sec, Ta.tv_usec); +-#endif +- RETVAL = (NV)(Tb.tv_sec-Ta.tv_sec)+0.000001*(NV)(Tb.tv_usec-Ta.tv_usec); ++ } else ++ PerlProc_pause(); ++ ++ gettimeofday(&Tb, NULL); ++# if 0 ++ printf("[%ld %ld] [%ld %ld]\n", Tb.tv_sec, Tb.tv_usec, Ta.tv_sec, Ta.tv_usec); ++# endif ++ RETVAL = (NV)(Tb.tv_sec-Ta.tv_sec)+0.000001*(NV)(Tb.tv_usec-Ta.tv_usec); + +- OUTPUT: +- RETVAL ++ OUTPUT: ++ RETVAL + + #else /* #if defined(HAS_USLEEP) && defined(HAS_GETTIMEOFDAY) */ + + NV + usleep(useconds) +- NV useconds ++ NV useconds + CODE: +- PERL_UNUSED_ARG(useconds); ++ PERL_UNUSED_ARG(useconds); + croak("Time::HiRes::usleep(): unimplemented in this platform"); + RETVAL = 0.0; + OUTPUT: +- RETVAL ++ RETVAL + + #endif /* #if defined(HAS_USLEEP) && defined(HAS_GETTIMEOFDAY) */ + +@@ -1177,241 +1264,204 @@ usleep(useconds) + + IV + ualarm(useconds,uinterval=0) +- int useconds +- int uinterval +- CODE: +- if (useconds < 0 || uinterval < 0) +- croak("Time::HiRes::ualarm(%d, %d): negative time not invented yet", useconds, uinterval); +-#if defined(HAS_SETITIMER) && defined(ITIMER_REAL) +- { +- struct itimerval itv; +- if (hrt_ualarm_itimero(&itv, useconds, uinterval)) { +- /* To conform to ualarm's interface, we're actually ignoring +- an error here. */ +- RETVAL = 0; +- } else { +- RETVAL = itv.it_value.tv_sec * IV_1E6 + itv.it_value.tv_usec; +- } +- } +-#else +- if (useconds >= IV_1E6 || uinterval >= IV_1E6) +- croak("Time::HiRes::ualarm(%d, %d): useconds or uinterval" +- " equal to or more than %" IVdf, +- useconds, uinterval, IV_1E6); +- RETVAL = ualarm(useconds, uinterval); +-#endif ++ int useconds ++ int uinterval ++ CODE: ++ if (useconds < 0 || uinterval < 0) ++ croak("Time::HiRes::ualarm(%d, %d): negative time not invented yet", useconds, uinterval); ++# if defined(HAS_SETITIMER) && defined(ITIMER_REAL) ++ { ++ struct itimerval itv; ++ if (hrt_ualarm_itimero(&itv, useconds, uinterval)) { ++ /* To conform to ualarm's interface, we're actually ignoring ++ an error here. */ ++ RETVAL = 0; ++ } else { ++ RETVAL = itv.it_value.tv_sec * IV_1E6 + itv.it_value.tv_usec; ++ } ++ } ++# else ++ if (useconds >= IV_1E6 || uinterval >= IV_1E6) ++ croak("Time::HiRes::ualarm(%d, %d): useconds or uinterval" ++ " equal to or more than %" IVdf, ++ useconds, uinterval, IV_1E6); ++ ++ RETVAL = ualarm(useconds, uinterval); ++# endif + +- OUTPUT: +- RETVAL ++ OUTPUT: ++ RETVAL + + NV + alarm(seconds,interval=0) +- NV seconds +- NV interval +- CODE: +- if (seconds < 0.0 || interval < 0.0) +- croak("Time::HiRes::alarm(%" NVgf ", %" NVgf ++ NV seconds ++ NV interval ++ CODE: ++ if (seconds < 0.0 || interval < 0.0) ++ croak("Time::HiRes::alarm(%" NVgf ", %" NVgf + "): negative time not invented yet", seconds, interval); +- { +- IV iseconds = (IV)seconds; +- IV iinterval = (IV)interval; +- NV fseconds = seconds - iseconds; +- NV finterval = interval - iinterval; +- IV useconds, uinterval; +- if (fseconds >= 1.0 || finterval >= 1.0) +- croak("Time::HiRes::alarm(%" NVgf ", %" NVgf ++ ++ { ++ IV iseconds = (IV)seconds; ++ IV iinterval = (IV)interval; ++ NV fseconds = seconds - iseconds; ++ NV finterval = interval - iinterval; ++ IV useconds, uinterval; ++ if (fseconds >= 1.0 || finterval >= 1.0) ++ croak("Time::HiRes::alarm(%" NVgf ", %" NVgf + "): seconds or interval too large to split correctly", + seconds, interval); +- useconds = IV_1E6 * fseconds; +- uinterval = IV_1E6 * finterval; +-#if defined(HAS_SETITIMER) && defined(ITIMER_REAL) +- { +- struct itimerval nitv, oitv; +- nitv.it_value.tv_sec = iseconds; +- nitv.it_value.tv_usec = useconds; +- nitv.it_interval.tv_sec = iinterval; +- nitv.it_interval.tv_usec = uinterval; +- if (setitimer(ITIMER_REAL, &nitv, &oitv)) { +- /* To conform to alarm's interface, we're actually ignoring +- an error here. */ +- RETVAL = 0; +- } else { +- RETVAL = oitv.it_value.tv_sec + ((NV)oitv.it_value.tv_usec) / NV_1E6; +- } +- } +-#else +- if (iseconds || iinterval) +- croak("Time::HiRes::alarm(%" NVgf ", %" NVgf ++ ++ useconds = IV_1E6 * fseconds; ++ uinterval = IV_1E6 * finterval; ++# if defined(HAS_SETITIMER) && defined(ITIMER_REAL) ++ { ++ struct itimerval nitv, oitv; ++ nitv.it_value.tv_sec = iseconds; ++ nitv.it_value.tv_usec = useconds; ++ nitv.it_interval.tv_sec = iinterval; ++ nitv.it_interval.tv_usec = uinterval; ++ if (setitimer(ITIMER_REAL, &nitv, &oitv)) { ++ /* To conform to alarm's interface, we're actually ignoring ++ an error here. */ ++ RETVAL = 0; ++ } else { ++ RETVAL = oitv.it_value.tv_sec + ((NV)oitv.it_value.tv_usec) / NV_1E6; ++ } ++ } ++# else ++ if (iseconds || iinterval) ++ croak("Time::HiRes::alarm(%" NVgf ", %" NVgf + "): seconds or interval equal to or more than 1.0 ", + seconds, interval); +- RETVAL = (NV)ualarm( useconds, uinterval ) / NV_1E6; +-#endif +- } + +- OUTPUT: +- RETVAL ++ RETVAL = (NV)ualarm( useconds, uinterval ) / NV_1E6; ++# endif ++ } + +-#else ++ OUTPUT: ++ RETVAL ++ ++#else /* #ifdef HAS_UALARM */ + + int + ualarm(useconds,interval=0) +- int useconds +- int interval ++ int useconds ++ int interval + CODE: +- PERL_UNUSED_ARG(useconds); +- PERL_UNUSED_ARG(interval); ++ PERL_UNUSED_ARG(useconds); ++ PERL_UNUSED_ARG(interval); + croak("Time::HiRes::ualarm(): unimplemented in this platform"); +- RETVAL = -1; ++ RETVAL = -1; + OUTPUT: +- RETVAL ++ RETVAL + + NV + alarm(seconds,interval=0) +- NV seconds +- NV interval ++ NV seconds ++ NV interval + CODE: +- PERL_UNUSED_ARG(seconds); +- PERL_UNUSED_ARG(interval); ++ PERL_UNUSED_ARG(seconds); ++ PERL_UNUSED_ARG(interval); + croak("Time::HiRes::alarm(): unimplemented in this platform"); +- RETVAL = 0.0; ++ RETVAL = 0.0; + OUTPUT: +- RETVAL ++ RETVAL + + #endif /* #ifdef HAS_UALARM */ + + #ifdef HAS_GETTIMEOFDAY +-# ifdef MACOS_TRADITIONAL /* fix epoch TZ and use unsigned time_t */ +-void +-gettimeofday() +- PREINIT: +- struct timeval Tp; +- struct timezone Tz; +- PPCODE: +- int status; +- status = gettimeofday (&Tp, &Tz); +- +- if (status == 0) { +- Tp.tv_sec += Tz.tz_minuteswest * 60; /* adjust for TZ */ +- if (GIMME == G_ARRAY) { +- EXTEND(sp, 2); +- /* Mac OS (Classic) has unsigned time_t */ +- PUSHs(sv_2mortal(newSVuv(Tp.tv_sec))); +- PUSHs(sv_2mortal(newSViv(Tp.tv_usec))); +- } else { +- EXTEND(sp, 1); +- PUSHs(sv_2mortal(newSVnv(Tp.tv_sec + (Tp.tv_usec / NV_1E6)))); +- } +- } + +-NV +-time() +- PREINIT: +- struct timeval Tp; +- struct timezone Tz; +- CODE: +- int status; +- status = gettimeofday (&Tp, &Tz); +- if (status == 0) { +- Tp.tv_sec += Tz.tz_minuteswest * 60; /* adjust for TZ */ +- RETVAL = Tp.tv_sec + (Tp.tv_usec / NV_1E6); +- } else { +- RETVAL = -1.0; +- } +- OUTPUT: +- RETVAL +- +-# else /* MACOS_TRADITIONAL */ + void + gettimeofday() +- PREINIT: ++ PREINIT: + struct timeval Tp; +- PPCODE: +- int status; ++ PPCODE: ++ int status; + status = gettimeofday (&Tp, NULL); +- if (status == 0) { +- if (GIMME == G_ARRAY) { +- EXTEND(sp, 2); +- PUSHs(sv_2mortal(newSViv(Tp.tv_sec))); +- PUSHs(sv_2mortal(newSViv(Tp.tv_usec))); +- } else { +- EXTEND(sp, 1); +- PUSHs(sv_2mortal(newSVnv(Tp.tv_sec + (Tp.tv_usec / NV_1E6)))); +- } ++ if (status == 0) { ++ if (GIMME == G_ARRAY) { ++ EXTEND(sp, 2); ++ PUSHs(sv_2mortal(newSViv(Tp.tv_sec))); ++ PUSHs(sv_2mortal(newSViv(Tp.tv_usec))); ++ } else { ++ EXTEND(sp, 1); ++ PUSHs(sv_2mortal(newSVnv(Tp.tv_sec + (Tp.tv_usec / NV_1E6)))); ++ } + } + + NV + time() +- PREINIT: ++ PREINIT: + struct timeval Tp; +- CODE: +- int status; ++ CODE: ++ int status; + status = gettimeofday (&Tp, NULL); +- if (status == 0) { ++ if (status == 0) { + RETVAL = Tp.tv_sec + (Tp.tv_usec / NV_1E6); +- } else { +- RETVAL = -1.0; +- } +- OUTPUT: +- RETVAL ++ } else { ++ RETVAL = -1.0; ++ } ++ OUTPUT: ++ RETVAL + +-# endif /* MACOS_TRADITIONAL */ + #endif /* #ifdef HAS_GETTIMEOFDAY */ + + #if defined(HAS_GETITIMER) && defined(HAS_SETITIMER) + +-#define TV2NV(tv) ((NV)((tv).tv_sec) + 0.000001 * (NV)((tv).tv_usec)) ++# define TV2NV(tv) ((NV)((tv).tv_sec) + 0.000001 * (NV)((tv).tv_usec)) + + void + setitimer(which, seconds, interval = 0) +- int which +- NV seconds +- NV interval ++ int which ++ NV seconds ++ NV interval + PREINIT: +- struct itimerval newit; +- struct itimerval oldit; ++ struct itimerval newit; ++ struct itimerval oldit; + PPCODE: +- if (seconds < 0.0 || interval < 0.0) +- croak("Time::HiRes::setitimer(%" IVdf ", %" NVgf ", %" NVgf ++ if (seconds < 0.0 || interval < 0.0) ++ croak("Time::HiRes::setitimer(%" IVdf ", %" NVgf ", %" NVgf + "): negative time not invented yet", + (IV)which, seconds, interval); +- newit.it_value.tv_sec = (IV)seconds; +- newit.it_value.tv_usec = +- (IV)((seconds - (NV)newit.it_value.tv_sec) * NV_1E6); +- newit.it_interval.tv_sec = (IV)interval; +- newit.it_interval.tv_usec = +- (IV)((interval - (NV)newit.it_interval.tv_sec) * NV_1E6); ++ newit.it_value.tv_sec = (IV)seconds; ++ newit.it_value.tv_usec = ++ (IV)((seconds - (NV)newit.it_value.tv_sec) * NV_1E6); ++ newit.it_interval.tv_sec = (IV)interval; ++ newit.it_interval.tv_usec = ++ (IV)((interval - (NV)newit.it_interval.tv_sec) * NV_1E6); + /* on some platforms the 1st arg to setitimer is an enum, which + * causes -Wc++-compat to complain about passing an int instead + */ + GCC_DIAG_IGNORE_STMT(-Wc++-compat); +- if (setitimer(which, &newit, &oldit) == 0) { +- EXTEND(sp, 1); +- PUSHs(sv_2mortal(newSVnv(TV2NV(oldit.it_value)))); +- if (GIMME == G_ARRAY) { +- EXTEND(sp, 1); +- PUSHs(sv_2mortal(newSVnv(TV2NV(oldit.it_interval)))); +- } +- } ++ if (setitimer(which, &newit, &oldit) == 0) { ++ EXTEND(sp, 1); ++ PUSHs(sv_2mortal(newSVnv(TV2NV(oldit.it_value)))); ++ if (GIMME == G_ARRAY) { ++ EXTEND(sp, 1); ++ PUSHs(sv_2mortal(newSVnv(TV2NV(oldit.it_interval)))); ++ } ++ } + GCC_DIAG_RESTORE_STMT; + + void + getitimer(which) +- int which ++ int which + PREINIT: +- struct itimerval nowit; ++ struct itimerval nowit; + PPCODE: + /* on some platforms the 1st arg to getitimer is an enum, which + * causes -Wc++-compat to complain about passing an int instead + */ + GCC_DIAG_IGNORE_STMT(-Wc++-compat); +- if (getitimer(which, &nowit) == 0) { +- EXTEND(sp, 1); +- PUSHs(sv_2mortal(newSVnv(TV2NV(nowit.it_value)))); +- if (GIMME == G_ARRAY) { +- EXTEND(sp, 1); +- PUSHs(sv_2mortal(newSVnv(TV2NV(nowit.it_interval)))); +- } +- } ++ if (getitimer(which, &nowit) == 0) { ++ EXTEND(sp, 1); ++ PUSHs(sv_2mortal(newSVnv(TV2NV(nowit.it_value)))); ++ if (GIMME == G_ARRAY) { ++ EXTEND(sp, 1); ++ PUSHs(sv_2mortal(newSVnv(TV2NV(nowit.it_interval)))); ++ } ++ } + GCC_DIAG_RESTORE_STMT; + + #endif /* #if defined(HAS_GETITIMER) && defined(HAS_SETITIMER) */ +@@ -1422,82 +1472,83 @@ I32 + utime(accessed, modified, ...) + PROTOTYPE: $$@ + PREINIT: +- SV* accessed; +- SV* modified; +- SV* file; ++ SV* accessed; ++ SV* modified; ++ SV* file; + +- struct timespec utbuf[2]; +- struct timespec *utbufp = utbuf; +- int tot; ++ struct timespec utbuf[2]; ++ struct timespec *utbufp = utbuf; ++ int tot; + + CODE: +- accessed = ST(0); +- modified = ST(1); +- items -= 2; +- tot = 0; +- +- if ( accessed == &PL_sv_undef && modified == &PL_sv_undef ) +- utbufp = NULL; +- else { +- if (SvNV(accessed) < 0.0 || SvNV(modified) < 0.0) +- croak("Time::HiRes::utime(%" NVgf ", %" NVgf +- "): negative time not invented yet", +- SvNV(accessed), SvNV(modified)); +- Zero(&utbuf, sizeof utbuf, char); +- +- utbuf[0].tv_sec = (Time_t)SvNV(accessed); /* time accessed */ +- utbuf[0].tv_nsec = (long)( +- (SvNV(accessed) - (NV)utbuf[0].tv_sec) +- * NV_1E9 + (NV)0.5); +- +- utbuf[1].tv_sec = (Time_t)SvNV(modified); /* time modified */ +- utbuf[1].tv_nsec = (long)( +- (SvNV(modified) - (NV)utbuf[1].tv_sec) +- * NV_1E9 + (NV)0.5); +- } +- +- while (items > 0) { +- file = POPs; items--; +- +- if (SvROK(file) && GvIO(SvRV(file)) && IoIFP(sv_2io(SvRV(file)))) { +- int fd = PerlIO_fileno(IoIFP(sv_2io(file))); +- if (fd < 0) { +- SETERRNO(EBADF,RMS_IFI); +- } else { +-#ifdef HAS_FUTIMENS +- if (FUTIMENS_AVAILABLE) { +- if (futimens(fd, utbufp) == 0) { +- tot++; +- } +- } else { +- croak("futimens unimplemented in this platform"); +- } +-#else /* HAS_FUTIMENS */ +- croak("futimens unimplemented in this platform"); +-#endif /* HAS_FUTIMENS */ ++ accessed = ST(0); ++ modified = ST(1); ++ items -= 2; ++ tot = 0; ++ ++ if ( accessed == &PL_sv_undef && modified == &PL_sv_undef ) ++ utbufp = NULL; ++ else { ++ if (SvNV(accessed) < 0.0 || SvNV(modified) < 0.0) ++ croak("Time::HiRes::utime(%" NVgf ", %" NVgf ++ "): negative time not invented yet", ++ SvNV(accessed), SvNV(modified)); ++ Zero(&utbuf, sizeof utbuf, char); ++ ++ utbuf[0].tv_sec = (Time_t)SvNV(accessed); /* time accessed */ ++ utbuf[0].tv_nsec = (long)( ++ (SvNV(accessed) - (NV)utbuf[0].tv_sec) ++ * NV_1E9 + (NV)0.5); ++ ++ utbuf[1].tv_sec = (Time_t)SvNV(modified); /* time modified */ ++ utbuf[1].tv_nsec = (long)( ++ (SvNV(modified) - (NV)utbuf[1].tv_sec) ++ * NV_1E9 + (NV)0.5); ++ } ++ ++ while (items > 0) { ++ file = POPs; items--; ++ ++ if (SvROK(file) && GvIO(SvRV(file)) && IoIFP(sv_2io(SvRV(file)))) { ++ int fd = PerlIO_fileno(IoIFP(sv_2io(file))); ++ if (fd < 0) { ++ SETERRNO(EBADF,RMS_IFI); ++ } else { ++# ifdef HAS_FUTIMENS ++ if (FUTIMENS_AVAILABLE) { ++ if (futimens(fd, utbufp) == 0) { ++ tot++; + } +- } +- else { +-#ifdef HAS_UTIMENSAT +- if (UTIMENSAT_AVAILABLE) { ++ } else { ++ croak("futimens unimplemented in this platform"); ++ } ++# else /* HAS_FUTIMENS */ ++ croak("futimens unimplemented in this platform"); ++# endif /* HAS_FUTIMENS */ ++ } ++ } ++ else { ++# ifdef HAS_UTIMENSAT ++ if (UTIMENSAT_AVAILABLE) { + STRLEN len; + char * name = SvPV(file, len); + if (IS_SAFE_PATHNAME(name, len, "utime") && + utimensat(AT_FDCWD, name, utbufp, 0) == 0) { +- tot++; ++ ++ tot++; + } +- } else { ++ } else { + croak("utimensat unimplemented in this platform"); +- } +-#else /* HAS_UTIMENSAT */ +- croak("utimensat unimplemented in this platform"); +-#endif /* HAS_UTIMENSAT */ +- } +- } /* while items */ +- RETVAL = tot; ++ } ++# else /* HAS_UTIMENSAT */ ++ croak("utimensat unimplemented in this platform"); ++# endif /* HAS_UTIMENSAT */ ++ } ++ } /* while items */ ++ RETVAL = tot; + + OUTPUT: +- RETVAL ++ RETVAL + + #else /* #if defined(TIME_HIRES_UTIME) */ + +@@ -1507,7 +1558,7 @@ utime(accessed, modified, ...) + croak("Time::HiRes::utime(): unimplemented in this platform"); + RETVAL = 0; + OUTPUT: +- RETVAL ++ RETVAL + + #endif /* #if defined(TIME_HIRES_UTIME) */ + +@@ -1515,32 +1566,32 @@ utime(accessed, modified, ...) + + NV + clock_gettime(clock_id = CLOCK_REALTIME) +- clockid_t clock_id ++ clockid_t clock_id + PREINIT: +- struct timespec ts; +- int status = -1; ++ struct timespec ts; ++ int status = -1; + CODE: +-#ifdef TIME_HIRES_CLOCK_GETTIME_SYSCALL +- status = syscall(SYS_clock_gettime, clock_id, &ts); +-#else +- status = clock_gettime(clock_id, &ts); +-#endif +- RETVAL = status == 0 ? ts.tv_sec + (NV) ts.tv_nsec / NV_1E9 : -1; ++# ifdef TIME_HIRES_CLOCK_GETTIME_SYSCALL ++ status = syscall(SYS_clock_gettime, clock_id, &ts); ++# else ++ status = clock_gettime(clock_id, &ts); ++# endif ++ RETVAL = status == 0 ? ts.tv_sec + (NV) ts.tv_nsec / NV_1E9 : -1; + + OUTPUT: +- RETVAL ++ RETVAL + + #else /* if defined(TIME_HIRES_CLOCK_GETTIME) */ + + NV + clock_gettime(clock_id = 0) +- clockid_t clock_id ++ clockid_t clock_id + CODE: +- PERL_UNUSED_ARG(clock_id); ++ PERL_UNUSED_ARG(clock_id); + croak("Time::HiRes::clock_gettime(): unimplemented in this platform"); + RETVAL = 0.0; + OUTPUT: +- RETVAL ++ RETVAL + + #endif /* #if defined(TIME_HIRES_CLOCK_GETTIME) */ + +@@ -1548,32 +1599,32 @@ clock_gettime(clock_id = 0) + + NV + clock_getres(clock_id = CLOCK_REALTIME) +- clockid_t clock_id ++ clockid_t clock_id + PREINIT: +- int status = -1; +- struct timespec ts; ++ int status = -1; ++ struct timespec ts; + CODE: +-#ifdef TIME_HIRES_CLOCK_GETRES_SYSCALL +- status = syscall(SYS_clock_getres, clock_id, &ts); +-#else +- status = clock_getres(clock_id, &ts); +-#endif +- RETVAL = status == 0 ? ts.tv_sec + (NV) ts.tv_nsec / NV_1E9 : -1; ++# ifdef TIME_HIRES_CLOCK_GETRES_SYSCALL ++ status = syscall(SYS_clock_getres, clock_id, &ts); ++# else ++ status = clock_getres(clock_id, &ts); ++# endif ++ RETVAL = status == 0 ? ts.tv_sec + (NV) ts.tv_nsec / NV_1E9 : -1; + + OUTPUT: +- RETVAL ++ RETVAL + + #else /* if defined(TIME_HIRES_CLOCK_GETRES) */ + + NV + clock_getres(clock_id = 0) +- clockid_t clock_id ++ clockid_t clock_id + CODE: +- PERL_UNUSED_ARG(clock_id); ++ PERL_UNUSED_ARG(clock_id); + croak("Time::HiRes::clock_getres(): unimplemented in this platform"); + RETVAL = 0.0; + OUTPUT: +- RETVAL ++ RETVAL + + #endif /* #if defined(TIME_HIRES_CLOCK_GETRES) */ + +@@ -1581,39 +1632,39 @@ clock_getres(clock_id = 0) + + NV + clock_nanosleep(clock_id, nsec, flags = 0) +- clockid_t clock_id +- NV nsec +- int flags ++ clockid_t clock_id ++ NV nsec ++ int flags + PREINIT: +- struct timespec sleepfor, unslept; ++ struct timespec sleepfor, unslept; + CODE: +- if (nsec < 0.0) +- croak("Time::HiRes::clock_nanosleep(..., %" NVgf ++ if (nsec < 0.0) ++ croak("Time::HiRes::clock_nanosleep(..., %" NVgf + "): negative time not invented yet", nsec); + nanosleep_init(nsec, &sleepfor, &unslept); +- if (clock_nanosleep(clock_id, flags, &sleepfor, &unslept) == 0) { +- RETVAL = nsec; +- } else { ++ if (clock_nanosleep(clock_id, flags, &sleepfor, &unslept) == 0) { ++ RETVAL = nsec; ++ } else { + RETVAL = nsec_without_unslept(&sleepfor, &unslept); +- } ++ } + OUTPUT: +- RETVAL ++ RETVAL + + #else /* if defined(TIME_HIRES_CLOCK_NANOSLEEP) && defined(TIMER_ABSTIME) */ + + NV + clock_nanosleep(clock_id, nsec, flags = 0) +- clockid_t clock_id +- NV nsec +- int flags ++ clockid_t clock_id ++ NV nsec ++ int flags + CODE: +- PERL_UNUSED_ARG(clock_id); +- PERL_UNUSED_ARG(nsec); +- PERL_UNUSED_ARG(flags); ++ PERL_UNUSED_ARG(clock_id); ++ PERL_UNUSED_ARG(nsec); ++ PERL_UNUSED_ARG(flags); + croak("Time::HiRes::clock_nanosleep(): unimplemented in this platform"); + RETVAL = 0.0; + OUTPUT: +- RETVAL ++ RETVAL + + #endif /* #if defined(TIME_HIRES_CLOCK_NANOSLEEP) && defined(TIMER_ABSTIME) */ + +@@ -1622,13 +1673,13 @@ clock_nanosleep(clock_id, nsec, flags = 0) + NV + clock() + PREINIT: +- clock_t clocks; ++ clock_t clocks; + CODE: +- clocks = clock(); +- RETVAL = clocks == (clock_t) -1 ? (clock_t) -1 : (NV)clocks / (NV)CLOCKS_PER_SEC; ++ clocks = clock(); ++ RETVAL = clocks == (clock_t) -1 ? (clock_t) -1 : (NV)clocks / (NV)CLOCKS_PER_SEC; + + OUTPUT: +- RETVAL ++ RETVAL + + #else /* if defined(TIME_HIRES_CLOCK) && defined(CLOCKS_PER_SEC) */ + +@@ -1638,7 +1689,7 @@ clock() + croak("Time::HiRes::clock(): unimplemented in this platform"); + RETVAL = 0.0; + OUTPUT: +- RETVAL ++ RETVAL + + #endif /* #if defined(TIME_HIRES_CLOCK) && defined(CLOCKS_PER_SEC) */ + +@@ -1646,39 +1697,39 @@ void + stat(...) + PROTOTYPE: ;$ + PREINIT: +- OP fakeop; +- int nret; ++ OP fakeop; ++ int nret; + ALIAS: +- Time::HiRes::lstat = 1 ++ Time::HiRes::lstat = 1 + PPCODE: +- XPUSHs(sv_2mortal(newSVsv(items == 1 ? ST(0) : DEFSV))); +- PUTBACK; +- ENTER; +- PL_laststatval = -1; +- SAVEOP(); +- 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 : +- GIMME_V == G_SCALAR ? OPf_WANT_SCALAR : OPf_WANT_VOID; +- PL_op = &fakeop; +- (void)fakeop.op_ppaddr(aTHX); +- SPAGAIN; +- LEAVE; +- nret = SP+1 - &ST(0); +- if (nret == 13) { +- UV atime = SvUV(ST( 8)); +- UV mtime = SvUV(ST( 9)); +- UV ctime = SvUV(ST(10)); +- UV atime_nsec; +- UV mtime_nsec; +- UV ctime_nsec; +- hrstatns(&atime_nsec, &mtime_nsec, &ctime_nsec); +- if (atime_nsec) +- ST( 8) = sv_2mortal(newSVnv(atime + (NV) atime_nsec / NV_1E9)); +- if (mtime_nsec) +- ST( 9) = sv_2mortal(newSVnv(mtime + (NV) mtime_nsec / NV_1E9)); +- if (ctime_nsec) +- ST(10) = sv_2mortal(newSVnv(ctime + (NV) ctime_nsec / NV_1E9)); +- } +- XSRETURN(nret); ++ XPUSHs(sv_2mortal(newSVsv(items == 1 ? ST(0) : DEFSV))); ++ PUTBACK; ++ ENTER; ++ PL_laststatval = -1; ++ SAVEOP(); ++ 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 : ++ GIMME_V == G_SCALAR ? OPf_WANT_SCALAR : OPf_WANT_VOID; ++ PL_op = &fakeop; ++ (void)fakeop.op_ppaddr(aTHX); ++ SPAGAIN; ++ LEAVE; ++ nret = SP+1 - &ST(0); ++ if (nret == 13) { ++ UV atime = SvUV(ST( 8)); ++ UV mtime = SvUV(ST( 9)); ++ UV ctime = SvUV(ST(10)); ++ UV atime_nsec; ++ UV mtime_nsec; ++ UV ctime_nsec; ++ hrstatns(&atime_nsec, &mtime_nsec, &ctime_nsec); ++ if (atime_nsec) ++ ST( 8) = sv_2mortal(newSVnv(atime + (NV) atime_nsec / NV_1E9)); ++ if (mtime_nsec) ++ ST( 9) = sv_2mortal(newSVnv(mtime + (NV) mtime_nsec / NV_1E9)); ++ if (ctime_nsec) ++ ST(10) = sv_2mortal(newSVnv(ctime + (NV) ctime_nsec / NV_1E9)); ++ } ++ XSRETURN(nret); +diff --git a/Makefile.PL b/Makefile.PL +index 4e7018a..b635092 100644 +--- a/Makefile.PL ++++ b/Makefile.PL +@@ -11,6 +11,8 @@ use Config; + use ExtUtils::MakeMaker; + use strict; + ++use File::Spec; ++ + my $VERBOSE = $ENV{VERBOSE}; + my $DEFINE; + my $LIBS = []; +@@ -29,55 +31,6 @@ unless($ENV{PERL_CORE}) { + $ENV{PERL_CORE} = 1 if grep { $_ eq 'PERL_CORE=1' } @ARGV; + } + +-# Perls 5.002 and 5.003 did not have File::Spec, fake what we need. +- +-sub my_dirsep { +- $^O eq 'VMS' ? '.' : +- $^O =~ /mswin32|netware|djgpp/i ? '\\' : +- $^O eq 'MacOS' ? ':' +- : '/'; +-} +- +-sub my_catdir { +- shift; +- my $catdir = join(my_dirsep, @_); +- $^O eq 'VMS' ? "[$catdir]" : $catdir; +-} +- +-sub my_catfile { +- shift; +- return join(my_dirsep, @_) unless $^O eq 'VMS'; +- my $file = pop; +- return my_catdir (undef, @_) . $file; +-} +- +-sub my_updir { +- shift; +- $^O eq 'VMS' ? "-" : ".."; +-} +- +-BEGIN { +- eval { require File::Spec }; +- if ($@) { +- *File::Spec::catdir = \&my_catdir; +- *File::Spec::updir = \&my_updir; +- *File::Spec::catfile = \&my_catfile; +- } +-} +- +-# Avoid 'used only once' warnings. +-my $nop1 = *File::Spec::catdir; +-my $nop2 = *File::Spec::updir; +-my $nop3 = *File::Spec::catfile; +- +-# if you have 5.004_03 (and some slightly older versions?), xsubpp +-# tries to generate line numbers in the C code generated from the .xs. +-# unfortunately, it is a little buggy around #ifdef'd code. +-# my choice is leave it in and have people with old perls complain +-# about the "Usage" bug, or leave it out and be unable to compile myself +-# without changing it, and then I'd always forget to change it before a +-# release. Sorry, Edward :) +- + sub try_compile_and_link { + my ($c, %args) = @_; + +@@ -89,25 +42,25 @@ sub try_compile_and_link { + unlink("$tmp.c", "$tmp$obj_ext"); + + if (open(TMPC, '>', "$tmp.c")) { +- print TMPC $c; +- close(TMPC); ++ print TMPC $c; ++ close(TMPC); + +- my $cccmd = $args{cccmd}; ++ my $cccmd = $args{cccmd}; + +- my $errornull; ++ my $errornull; + +- my $COREincdir; ++ my $COREincdir; + +- if ($ENV{PERL_CORE}) { +- my $updir = File::Spec->updir; +- $COREincdir = File::Spec->catdir(($updir) x 2); +- } else { +- $COREincdir = File::Spec->catdir($Config{'archlibexp'}, 'CORE'); +- } ++ if ($ENV{PERL_CORE}) { ++ my $updir = File::Spec->updir; ++ $COREincdir = File::Spec->catdir(($updir) x 2); ++ } else { ++ $COREincdir = File::Spec->catdir($Config{'archlibexp'}, 'CORE'); ++ } + +- if ($ENV{PERL_CORE}) { +- unless (-f File::Spec->catfile($COREincdir, "EXTERN.h")) { +- die <<__EOD__; ++ if ($ENV{PERL_CORE}) { ++ unless (-f File::Spec->catfile($COREincdir, "EXTERN.h")) { ++ die <<__EOD__; + Your environment variable PERL_CORE is '$ENV{PERL_CORE}' but there + is no EXTERN.h in $COREincdir. + Cannot continue, aborting. +@@ -115,62 +68,62 @@ __EOD__ + } + } + +- my $ccflags = $Config{'ccflags'} . ' ' . "-I$COREincdir" +- . ' -DPERL_NO_INLINE_FUNCTIONS'; ++ my $ccflags = $Config{'ccflags'} . ' ' . "-I$COREincdir" ++ . ' -DPERL_NO_INLINE_FUNCTIONS'; + +- if ($^O eq 'VMS') { ++ if ($^O eq 'VMS') { + $cccmd = "$Config{'cc'} /include=($COREincdir) $tmp.c"; + } + + if ($args{silent} || !$VERBOSE) { +- $errornull = "2>/dev/null" unless defined $errornull; +- } else { +- $errornull = ''; +- } ++ $errornull = "2>/dev/null" unless defined $errornull; ++ } else { ++ $errornull = ''; ++ } + + $cccmd = "$Config{'cc'} -o $tmp $ccflags $tmp.c @$LIBS $errornull" +- unless defined $cccmd; ++ unless defined $cccmd; + + if ($^O eq 'VMS') { +- open( CMDFILE, '>', "$tmp.com" ); +- print CMDFILE "\$ SET MESSAGE/NOFACILITY/NOSEVERITY/NOIDENT/NOTEXT\n"; +- print CMDFILE "\$ $cccmd\n"; +- print CMDFILE "\$ IF \$SEVERITY .NE. 1 THEN EXIT 44\n"; # escalate +- close CMDFILE; +- system("\@ $tmp.com"); +- $ok = $?==0; +- for ("$tmp.c", "$tmp$obj_ext", "$tmp.com", "$tmp$Config{exe_ext}") { +- 1 while unlink $_; +- } ++ open( CMDFILE, '>', "$tmp.com" ); ++ print CMDFILE "\$ SET MESSAGE/NOFACILITY/NOSEVERITY/NOIDENT/NOTEXT\n"; ++ print CMDFILE "\$ $cccmd\n"; ++ print CMDFILE "\$ IF \$SEVERITY .NE. 1 THEN EXIT 44\n"; # escalate ++ close CMDFILE; ++ system("\@ $tmp.com"); ++ $ok = $?==0; ++ for ("$tmp.c", "$tmp$obj_ext", "$tmp.com", "$tmp$Config{exe_ext}") { ++ 1 while unlink $_; ++ } + } + else + { +- my $tmp_exe = "$tmp$ld_exeext"; +- printf "cccmd = $cccmd\n" if $VERBOSE; +- my $res = system($cccmd); +- $ok = defined($res) && $res == 0 && -s $tmp_exe && -x _; +- +- if ( $ok && exists $args{run} && $args{run} && !$ENV{TIME_HIRES_DONT_RUN_PROBES} ) { +- my $tmp_exe = +- File::Spec->catfile(File::Spec->curdir, $tmp_exe); +- my @run = $tmp_exe; +- unshift @run, $Config{run} if $Config{run} && -e $Config{run}; +- printf "Running $tmp_exe..." if $VERBOSE; +- if (system(@run) == 0) { +- $ok = 1; +- } else { +- $ok = 0; +- my $errno = $? >> 8; +- local $! = $errno; +- printf <catfile(File::Spec->curdir, $tmp_exe); ++ my @run = $tmp_exe; ++ unshift @run, $Config{run} if $Config{run} && -e $Config{run}; ++ printf "Running $tmp_exe..." if $VERBOSE; ++ if (system(@run) == 0) { ++ $ok = 1; ++ } else { ++ $ok = 0; ++ my $errno = $? >> 8; ++ local $! = $errno; ++ printf < + #endif + #ifdef I_SYS_SELECT +-# include /* struct timeval might be hidden in here */ ++# include /* struct timeval might be hidden in here */ + #endif + EOH + +@@ -233,7 +186,7 @@ sub has_x { + + int main(int argc, char** argv) + { +- $x; ++ $x; + } + EOM + return 0; +@@ -276,7 +229,7 @@ sub has_include { + #include <$inc> + int main(int argc, char** argv) + { +- return 0; ++ return 0; + } + EOM + return 0; +@@ -422,56 +375,56 @@ sub DEFINE { + my ($def, $val) = @_; + my $define = defined $val ? "$def=$val" : $def ; + unless ($DEFINE =~ /(?:^| )-D\Q$define\E(?: |$)/) { +- $DEFINE .= " -D$define"; ++ $DEFINE .= " -D$define"; + } + } + + sub init { + my $hints = File::Spec->catfile("hints", "$^O.pl"); + if (-f $hints) { +- print "Using hints $hints...\n"; +- local $self; +- do "./$hints"; +- if (exists $self->{LIBS}) { +- $LIBS = $self->{LIBS}; +- print "Extra libraries: @$LIBS...\n"; +- } ++ print "Using hints $hints...\n"; ++ local $self; ++ do "./$hints"; ++ if (exists $self->{LIBS}) { ++ $LIBS = $self->{LIBS}; ++ print "Extra libraries: @$LIBS...\n"; ++ } + } + + $DEFINE = ''; + + if ($Config{d_syscall}) { +- print "Have syscall()... looking for syscall.h... "; +- if (has_include('syscall.h')) { +- $SYSCALL_H = 'syscall.h'; +- } elsif (has_include('sys/syscall.h')) { +- $SYSCALL_H = 'sys/syscall.h'; +- } ++ print "Have syscall()... looking for syscall.h... "; ++ if (has_include('syscall.h')) { ++ $SYSCALL_H = 'syscall.h'; ++ } elsif (has_include('sys/syscall.h')) { ++ $SYSCALL_H = 'sys/syscall.h'; ++ } + } else { +- print "No syscall()...\n"; ++ print "No syscall()...\n"; + } + + if ($Config{d_syscall}) { +- if (defined $SYSCALL_H) { +- print "found <$SYSCALL_H>.\n"; +- } else { +- print "NOT found.\n"; +- } ++ if (defined $SYSCALL_H) { ++ print "found <$SYSCALL_H>.\n"; ++ } else { ++ print "NOT found.\n"; ++ } + } + + print "Looking for gettimeofday()... "; + my $has_gettimeofday; + if (exists $Config{d_gettimeod}) { +- $has_gettimeofday++ if $Config{d_gettimeod}; ++ $has_gettimeofday++ if $Config{d_gettimeod}; + } elsif (has_gettimeofday()) { +- $DEFINE .= ' -DHAS_GETTIMEOFDAY'; +- $has_gettimeofday++; ++ $DEFINE .= ' -DHAS_GETTIMEOFDAY'; ++ $has_gettimeofday++; + } + + if ($has_gettimeofday) { +- print "found.\n"; ++ print "found.\n"; + } else { +- die <... "; + if (has_include('w32api/windows.h')) { +- $has_w32api_windows_h++; +- DEFINE('HAS_W32API_WINDOWS_H'); +- } ++ $has_w32api_windows_h++; ++ DEFINE('HAS_W32API_WINDOWS_H'); ++ } + if ($has_w32api_windows_h) { +- print "found.\n"; +- } else { +- print "NOT found.\n"; +- } ++ print "found.\n"; ++ } else { ++ print "NOT found.\n"; ++ } + } + + if ($DEFINE) { + $DEFINE =~ s/^\s+//; + if (open(XDEFINE, '>', 'xdefine')) { +- print XDEFINE $DEFINE, "\n"; +- close(XDEFINE); ++ print XDEFINE $DEFINE, "\n"; ++ close(XDEFINE); + } + } + } +@@ -892,74 +842,82 @@ EOM + sub doMakefile { + my @makefileopts = (); + +- if ($] >= 5.005) { +- push (@makefileopts, +- 'AUTHOR' => 'Jarkko Hietaniemi ', +- 'ABSTRACT_FROM' => 'HiRes.pm', +- ); +- DEFINE('ATLEASTFIVEOHOHFIVE'); +- } + DEFINE('USE_PPPORT_H') unless $ENV{PERL_CORE}; + + push (@makefileopts, +- 'NAME' => 'Time::HiRes', +- 'VERSION_FROM' => 'HiRes.pm', # finds $VERSION +- 'LIBS' => $LIBS, # e.g., '-lm' +- 'DEFINE' => $DEFINE, # e.g., '-DHAS_SOMETHING' +- 'XSOPT' => $XSOPT, +- # Do not even think about 'INC' => '-I/usr/ucbinclude', +- # Solaris will avenge. +- 'INC' => '', # e.g., '-I/usr/include/other' +- 'INSTALLDIRS' => ($] >= 5.008 && $] < 5.011 ? 'perl' : 'site'), +- 'PREREQ_PM' => { +- 'Carp' => 0, +- 'Config' => 0, +- 'Exporter' => 0, +- 'ExtUtils::MakeMaker' => 0, +- 'Test::More' => 0, +- 'XSLoader' => 0, +- 'strict' => 0, +- }, +- 'dist' => { +- 'CI' => 'ci -l', +- 'COMPRESS' => 'gzip -9f', +- 'SUFFIX' => 'gz', +- }, ++ 'NAME' => 'Time::HiRes', ++ 'AUTHOR' => 'Jarkko Hietaniemi ', ++ 'ABSTRACT_FROM' => 'HiRes.pm', ++ 'VERSION_FROM' => 'HiRes.pm', # finds $VERSION ++ 'LIBS' => $LIBS, # e.g., '-lm' ++ 'DEFINE' => $DEFINE, # e.g., '-DHAS_SOMETHING' ++ 'XSOPT' => $XSOPT, ++ # Do not even think about 'INC' => '-I/usr/ucbinclude', ++ # Solaris will avenge. ++ 'INC' => '', # e.g., '-I/usr/include/other' ++ 'INSTALLDIRS' => ($] >= 5.008 && $] < 5.011 ? 'perl' : 'site'), ++ 'PREREQ_PM' => { ++ 'Carp' => 0, ++ 'Config' => 0, ++ 'Exporter' => 0, ++ 'ExtUtils::MakeMaker' => 0, ++ 'Test::More' => 0, ++ 'XSLoader' => 0, ++ 'strict' => 0, ++ 'File::Spec' => 0, ++ }, ++ 'dist' => { ++ 'CI' => 'ci -l', ++ 'COMPRESS' => 'gzip -9f', ++ 'SUFFIX' => 'gz', ++ }, + clean => { FILES => "xdefine" }, + realclean => { FILES=> 'const-c.inc const-xs.inc' }, + ); + + if ($^O eq "MSWin32" && !(grep { /\ALD[A-Z]*=/ } @ARGV)) { +- my $libperl = $Config{libperl} || ""; +- my $gccversion = $Config{gccversion} || ""; +- if ($gccversion =~ /\A3\.4\.[0-9]+/ and $libperl =~ /\.lib\z/) { +- # Avoid broken linkage with ActivePerl, by linking directly +- # against the Perl DLL rather than the import library. +- (my $llibperl = "-l$libperl") =~ s/\.lib\z//; +- my $lddlflags = $Config{lddlflags} || ""; +- my $ldflags = $Config{ldflags} || ""; +- s/-L(?:".*?"|\S+)//g foreach $lddlflags, $ldflags; +- my $libdirs = join ' ', +- map { s/(? { +- LDDLFLAGS => "$lddlflags $libdirs $llibperl", +- LDFLAGS => "$ldflags $libdirs $llibperl", +- PERL_ARCHIVE => "", +- }; +- } ++ my $libperl = $Config{libperl} || ""; ++ my $gccversion = $Config{gccversion} || ""; ++ if ($gccversion =~ /\A3\.4\.[0-9]+/ and $libperl =~ /\.lib\z/) { ++ # Avoid broken linkage with ActivePerl, by linking directly ++ # against the Perl DLL rather than the import library. ++ (my $llibperl = "-l$libperl") =~ s/\.lib\z//; ++ my $lddlflags = $Config{lddlflags} || ""; ++ my $ldflags = $Config{ldflags} || ""; ++ s/-L(?:".*?"|\S+)//g foreach $lddlflags, $ldflags; ++ my $libdirs = join ' ', ++ map { s/(? { ++ LDDLFLAGS => "$lddlflags $libdirs $llibperl", ++ LDFLAGS => "$ldflags $libdirs $llibperl", ++ PERL_ARCHIVE => "", ++ }; ++ } + } + + if ($ENV{PERL_CORE}) { +- push @makefileopts, MAN3PODS => {}; ++ push @makefileopts, MAN3PODS => {}; + } + + if ($ExtUtils::MakeMaker::VERSION >= 6.48) { +- push @makefileopts, (MIN_PERL_VERSION => '5.006',); ++ push @makefileopts, (MIN_PERL_VERSION => '5.006',); + } + + if ($ExtUtils::MakeMaker::VERSION >= 6.31) { +- push @makefileopts, (LICENSE => 'perl_5'); ++ push @makefileopts, (LICENSE => 'perl_5'); ++ } ++ ++ if ($ExtUtils::MakeMaker::VERSION >= 6.46) { ++ push @makefileopts, ( ++ META_MERGE => { ++ resources => { ++ repository => 'git://perl5.git.perl.org/perl.git', ++ bugtracker => 'https://rt.perl.org/rt3/', ++ homepage => "http://dev.perl.org/", ++ }, ++ }, ++ ) + } + + WriteMakefile(@makefileopts); +@@ -968,119 +926,122 @@ sub doMakefile { + sub doConstants { + if (eval {require ExtUtils::Constant; 1}) { + # More or less this same list is in HiRes.pm. Should unify. +- my @names = qw( +- CLOCKS_PER_SEC +- CLOCK_BOOTTIME +- CLOCK_HIGHRES +- CLOCK_MONOTONIC +- CLOCK_MONOTONIC_COARSE +- CLOCK_MONOTONIC_FAST +- CLOCK_MONOTONIC_PRECISE +- CLOCK_MONOTONIC_RAW +- CLOCK_PROF +- CLOCK_PROCESS_CPUTIME_ID +- CLOCK_REALTIME +- CLOCK_REALTIME_COARSE +- CLOCK_REALTIME_FAST +- CLOCK_REALTIME_PRECISE +- CLOCK_REALTIME_RAW +- CLOCK_SECOND +- CLOCK_SOFTTIME +- CLOCK_THREAD_CPUTIME_ID +- CLOCK_TIMEOFDAY +- CLOCK_UPTIME +- CLOCK_UPTIME_COARSE +- CLOCK_UPTIME_FAST +- CLOCK_UPTIME_PRECISE +- CLOCK_UPTIME_RAW +- CLOCK_VIRTUAL +- ITIMER_PROF +- ITIMER_REAL +- ITIMER_REALPROF +- ITIMER_VIRTUAL +- TIMER_ABSTIME ++ my @names = qw( ++ CLOCKS_PER_SEC ++ CLOCK_BOOTTIME ++ CLOCK_HIGHRES ++ CLOCK_MONOTONIC ++ CLOCK_MONOTONIC_COARSE ++ CLOCK_MONOTONIC_FAST ++ CLOCK_MONOTONIC_PRECISE ++ CLOCK_MONOTONIC_RAW ++ CLOCK_PROF ++ CLOCK_PROCESS_CPUTIME_ID ++ CLOCK_REALTIME ++ CLOCK_REALTIME_COARSE ++ CLOCK_REALTIME_FAST ++ CLOCK_REALTIME_PRECISE ++ CLOCK_REALTIME_RAW ++ CLOCK_SECOND ++ CLOCK_SOFTTIME ++ CLOCK_THREAD_CPUTIME_ID ++ CLOCK_TIMEOFDAY ++ CLOCK_UPTIME ++ CLOCK_UPTIME_COARSE ++ CLOCK_UPTIME_FAST ++ CLOCK_UPTIME_PRECISE ++ CLOCK_UPTIME_RAW ++ CLOCK_VIRTUAL ++ ITIMER_PROF ++ ITIMER_REAL ++ ITIMER_REALPROF ++ ITIMER_VIRTUAL ++ TIMER_ABSTIME + ); +- foreach (qw (d_usleep d_ualarm d_gettimeofday d_getitimer d_setitimer +- d_nanosleep d_clock_gettime d_clock_getres +- d_clock d_clock_nanosleep d_hires_stat ++ foreach (qw (d_usleep d_ualarm d_gettimeofday d_getitimer d_setitimer ++ d_nanosleep d_clock_gettime d_clock_getres ++ d_clock d_clock_nanosleep d_hires_stat + d_futimens d_utimensat d_hires_utime)) { +- my $macro = $_; +- if ($macro =~ /^(d_nanosleep|d_clock)$/) { +- $macro =~ s/^d_(.+)/TIME_HIRES_\U$1/; +- } elsif ($macro =~ /^(d_hires_stat)$/) { +- my $d_hires_stat = $1 if ($DEFINE =~ /-DTIME_HIRES_STAT=(\d+)/); ++ my $macro = $_; ++ if ($macro =~ /^(d_nanosleep|d_clock)$/) { ++ $macro =~ s/^d_(.+)/TIME_HIRES_\U$1/; ++ } elsif ($macro =~ /^(d_hires_stat)$/) { ++ my $d_hires_stat = $1 if ($DEFINE =~ /-DTIME_HIRES_STAT=(\d+)/); + if (defined $d_hires_stat) { + push @names, {name => $_, macro => "TIME_HIRES_STAT", value => $d_hires_stat, + default => ["IV", "0"]}; + next; + } +- } elsif ($macro =~ /^(d_hires_utime)$/) { +- my $d_hires_utime = +- ($DEFINE =~ /-DHAS_FUTIMENS/ || +- $DEFINE =~ /-DHAS_UTIMENSAT/); +- push @names, {name => $_, macro => "TIME_HIRES_UTIME", value => $d_hires_utime, +- default => ["IV", "0"]}; +- next; +- } elsif ($macro =~ /^(d_clock_gettime|d_clock_getres|d_clock_nanosleep)$/) { +- $macro =~ s/^d_(.+)/TIME_HIRES_\U$1/; +- my $val = ($DEFINE =~ /-D$macro\b/) ? 1 : 0; +- push @names, {name => $_, macro => $macro, value => $val, +- default => ["IV", "0"]}; +- next; +- } else { +- $macro =~ s/^d_(.+)/HAS_\U$1/; +- } +- push @names, {name => $_, macro => $macro, value => 1, +- default => ["IV", "0"]}; +- } +- ExtUtils::Constant::WriteConstants( +- NAME => 'Time::HiRes', +- NAMES => \@names, +- ); ++ } elsif ($macro =~ /^(d_hires_utime)$/) { ++ my $d_hires_utime = ++ ($DEFINE =~ /-DHAS_FUTIMENS/ || ++ $DEFINE =~ /-DHAS_UTIMENSAT/); ++ push @names, {name => $_, macro => "TIME_HIRES_UTIME", value => $d_hires_utime, ++ default => ["IV", "0"]}; ++ next; ++ } elsif ($macro =~ /^(d_clock_gettime|d_clock_getres|d_clock_nanosleep)$/) { ++ $macro =~ s/^d_(.+)/TIME_HIRES_\U$1/; ++ my $val = ($DEFINE =~ /-D$macro\b/) ? 1 : 0; ++ push @names, {name => $_, macro => $macro, value => $val, ++ default => ["IV", "0"]}; ++ next; ++ } else { ++ $macro =~ s/^d_(.+)/HAS_\U$1/; ++ } ++ push @names, {name => $_, macro => $macro, value => 1, ++ default => ["IV", "0"]}; ++ } ++ ExtUtils::Constant::WriteConstants( ++ NAME => 'Time::HiRes', ++ NAMES => \@names, ++ ); + } else { + my $file; +- foreach $file ('const-c.inc', 'const-xs.inc') { +- my $fallback = File::Spec->catfile('fallback', $file); +- local $/; +- open IN, '<', $fallback or die "Can't open $fallback: $!"; +- open OUT, '>', $file or die "Can't open $file: $!"; +- print OUT or die $!; +- close OUT or die "Can't close $file: $!"; +- close IN or die "Can't close $fallback: $!"; +- } ++ foreach $file ('const-c.inc', 'const-xs.inc') { ++ my $fallback = File::Spec->catfile('fallback', $file); ++ local $/; ++ open IN, '<', $fallback or die "Can't open $fallback: $!"; ++ open OUT, '>', $file or die "Can't open $file: $!"; ++ print OUT or die $!; ++ close OUT or die "Can't close $file: $!"; ++ close IN or die "Can't close $fallback: $!"; ++ } + } + } + + sub main { + if (-f "xdefine" && !(@ARGV && $ARGV[0] =~ /^--(?:configure|force)$/)) { +- print qq[$0: The "xdefine" exists, skipping the configure step.\n]; +- print qq[Use "$^X $0 --configure"\n]; +- print qq[or: "$^X $0 --force\n]; +- print qq[to force the configure step.\n]; ++ print qq[$0: The "xdefine" exists, skipping the configure step.\n]; ++ print qq[Use "$^X $0 --configure"\n]; ++ print qq[or: "$^X $0 --force\n]; ++ print qq[to force the configure step.\n]; + } else { +- print "Configuring Time::HiRes...\n"; +- 1 while unlink("define"); +- if ($^O =~ /Win32/i) { +- DEFINE('SELECT_IS_BROKEN'); +- $LIBS = []; +- print "System is $^O, skipping full configure...\n"; +- open(XDEFINE, '>', 'xdefine') or die "$0: Cannot create xdefine: $!\n"; +- close(XDEFINE); +- } else { +- init(); +- } +- doMakefile; +- doConstants; ++ print "Configuring Time::HiRes...\n"; ++ 1 while unlink("define"); ++ if ($^O =~ /Win32/i) { ++ DEFINE('SELECT_IS_BROKEN'); ++ # we provide our own implementations of those functions on win32 ++ DEFINE('TIME_HIRES_CLOCK_GETTIME'); ++ DEFINE('TIME_HIRES_CLOCK_GETRES'); ++ $LIBS = []; ++ print "System is $^O, skipping full configure...\n"; ++ open(XDEFINE, '>', 'xdefine') or die "$0: Cannot create xdefine: $!\n"; ++ close(XDEFINE); ++ } else { ++ init(); ++ } ++ doMakefile; ++ doConstants; + } + my $make = $Config{'make'} || "make"; + unless (exists $ENV{PERL_CORE} && $ENV{PERL_CORE}) { +- print < || ""); + close(XDEFINE); + } + + my $can_subsecond_alarm = +- defined &Time::HiRes::gettimeofday && +- defined &Time::HiRes::ualarm && +- defined &Time::HiRes::usleep && +- ($Config{d_ualarm} || $xdefine =~ /-DHAS_UALARM/); ++ defined &Time::HiRes::gettimeofday && ++ defined &Time::HiRes::ualarm && ++ defined &Time::HiRes::usleep && ++ ($Config{d_ualarm} || $xdefine =~ /-DHAS_UALARM/); + + SKIP: { + skip "no subsecond alarm", 1 unless $can_subsecond_alarm; + eval { require POSIX }; + my $use_sigaction = +- !$@ && defined &POSIX::sigaction && &POSIX::SIGALRM > 0; ++ !$@ && defined &POSIX::sigaction && &POSIX::SIGALRM > 0; + + my ($r, $i, $not, $ok); + +@@ -36,80 +36,80 @@ SKIP: { + $i = 5; + my $oldaction; + if ($use_sigaction) { +- $oldaction = new POSIX::SigAction; +- printf("# sigaction tick, ALRM = %d\n", &POSIX::SIGALRM); ++ $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. ++ # Perl's deferred signals may be too wimpy to break through ++ # a restartable select(), so use POSIX::sigaction if available. + + # In perl 5.6.2 you will get a likely bogus warning of + # "Use of uninitialized value in subroutine entry" from + # the following line. +- POSIX::sigaction(&POSIX::SIGALRM, +- POSIX::SigAction->new("tick"), +- $oldaction) +- or die "Error setting SIGALRM handler with sigaction: $!\n"; ++ 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"; ++ print("# SIG tick\n"); ++ $SIG{ALRM} = "tick"; + } + + # On VMS timers can not interrupt select. + if ($^O eq 'VMS') { +- $ok = "Skip: VMS select() does not get interrupted."; ++ $ok = "Skip: VMS select() does not get interrupted."; + } else { +- while ($i > 0) { +- Time::HiRes::alarm(0.3); +- select (undef, undef, undef, 3); +- my $ival = Time::HiRes::tv_interval ($r); +- print("# Select returned! $i $ival\n"); +- printf("# %s\n", abs($ival/3 - 1)); +- # 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); +- if ($exp == 0) { +- $not = "while: divisor became zero"; +- last; +- } +- # This test is more sensitive, so impose a softer limit. +- if (abs($ival/$exp - 1) > 4*$limit) { +- my $ratio = abs($ival/$exp); +- $not = "while: $exp sleep took $ival ratio $ratio"; +- last; +- } +- $ok = $i; +- } ++ while ($i > 0) { ++ Time::HiRes::alarm(0.3); ++ select (undef, undef, undef, 3); ++ my $ival = Time::HiRes::tv_interval ($r); ++ print("# Select returned! $i $ival\n"); ++ printf("# %s\n", abs($ival/3 - 1)); ++ # 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); ++ if ($exp == 0) { ++ $not = "while: divisor became zero"; ++ last; ++ } ++ # This test is more sensitive, so impose a softer limit. ++ if (abs($ival/$exp - 1) > 4*$limit) { ++ my $ratio = abs($ival/$exp); ++ $not = "while: $exp sleep took $ival ratio $ratio"; ++ last; ++ } ++ $ok = $i; ++ } + } + + sub tick { +- $i--; +- my $ival = Time::HiRes::tv_interval ($r); +- print("# Tick! $i $ival\n"); +- my $exp = 0.3 * (5 - $i); +- if ($exp == 0) { +- $not = "tick: divisor became zero"; +- last; +- } +- # This test is more sensitive, so impose a softer limit. +- if (abs($ival/$exp - 1) > 4*$limit) { +- my $ratio = abs($ival/$exp); +- $not = "tick: $exp sleep took $ival ratio $ratio"; +- $i = 0; +- } ++ $i--; ++ my $ival = Time::HiRes::tv_interval ($r); ++ print("# Tick! $i $ival\n"); ++ my $exp = 0.3 * (5 - $i); ++ if ($exp == 0) { ++ $not = "tick: divisor became zero"; ++ last; ++ } ++ # This test is more sensitive, so impose a softer limit. ++ if (abs($ival/$exp - 1) > 4*$limit) { ++ my $ratio = abs($ival/$exp); ++ $not = "tick: $exp sleep took $ival ratio $ratio"; ++ $i = 0; ++ } + } + + if ($use_sigaction) { +- POSIX::sigaction(&POSIX::SIGALRM, $oldaction); ++ POSIX::sigaction(&POSIX::SIGALRM, $oldaction); + } else { +- Time::HiRes::alarm(0); # can't cancel usig %SIG ++ Time::HiRes::alarm(0); # can't cancel usig %SIG + } + + print("# $not\n"); +@@ -120,7 +120,7 @@ SKIP: { + skip "no ualarm", 1 unless &Time::HiRes::d_ualarm; + eval { Time::HiRes::alarm(-3) }; + like $@, qr/::alarm\(-3, 0\): negative time not invented yet/, +- "negative time error"; ++ "negative time error"; + } + + # Find the loop size N (a for() loop 0..N-1) +@@ -139,22 +139,22 @@ SKIP: { + my $i; + N: { + do { +- my $t0 = Time::HiRes::time(); +- for ($i = 0; $i < $DelayN; $i++) { } +- my $t1 = Time::HiRes::time(); +- my $dt = $t1 - $t0; +- print("# N = $DelayN, t1 = $t1, t0 = $t0, dt = $dt\n"); +- last N if $dt > $T; +- $DelayN *= 2; ++ my $t0 = Time::HiRes::time(); ++ for ($i = 0; $i < $DelayN; $i++) { } ++ my $t1 = Time::HiRes::time(); ++ my $dt = $t1 - $t0; ++ print("# N = $DelayN, t1 = $t1, t0 = $t0, dt = $dt\n"); ++ last N if $dt > $T; ++ $DelayN *= 2; + } while (1); + } + + # The time-burner which takes at least T (default 1) seconds. + my $Delay = sub { +- my $c = @_ ? shift : 1; +- my $n = $c * $DelayN; +- my $i; +- for ($i = 0; $i < $n; $i++) { } ++ my $c = @_ ? shift : 1; ++ my $n = $c * $DelayN; ++ my $i; ++ for ($i = 0; $i < $n; $i++) { } + }; + + # Next setup a periodic timer (the two-argument alarm() of +@@ -174,11 +174,11 @@ SKIP: { + # (We may well get $A + 1 alarms.) + + $SIG{ALRM} = sub { +- $a++; +- printf("# Alarm $a - %s\n", Time::HiRes::time()); +- Time::HiRes::alarm(0) if $a >= $A; # Disarm the alarm. +- $Delay->(2); # Try burning CPU at least for 2T seconds. +- }; ++ $a++; ++ printf("# Alarm $a - %s\n", Time::HiRes::time()); ++ Time::HiRes::alarm(0) if $a >= $A; # Disarm the alarm. ++ $Delay->(2); # Try burning CPU at least for 2T seconds. ++ }; + + Time::HiRes::alarm($T, $T); # Arm the alarm. + +@@ -190,38 +190,38 @@ SKIP: { + SKIP: { + skip "no subsecond alarm", 6 unless $can_subsecond_alarm; + { +- my $alrm; +- $SIG{ALRM} = sub { $alrm++ }; +- Time::HiRes::alarm(0.1); +- my $t0 = Time::HiRes::time(); +- 1 while Time::HiRes::time() - $t0 <= 1; +- ok $alrm; ++ my $alrm; ++ $SIG{ALRM} = sub { $alrm++ }; ++ Time::HiRes::alarm(0.1); ++ my $t0 = Time::HiRes::time(); ++ 1 while Time::HiRes::time() - $t0 <= 1; ++ ok $alrm; + } + { +- my $alrm; +- $SIG{ALRM} = sub { $alrm++ }; +- Time::HiRes::alarm(1.1); +- my $t0 = Time::HiRes::time(); +- 1 while Time::HiRes::time() - $t0 <= 2; +- ok $alrm; ++ my $alrm; ++ $SIG{ALRM} = sub { $alrm++ }; ++ Time::HiRes::alarm(1.1); ++ my $t0 = Time::HiRes::time(); ++ 1 while Time::HiRes::time() - $t0 <= 2; ++ ok $alrm; + } + + { +- my $alrm = 0; +- $SIG{ALRM} = sub { $alrm++ }; +- my $got = Time::HiRes::alarm(2.7); +- ok $got == 0 or print("# $got\n"); ++ my $alrm = 0; ++ $SIG{ALRM} = sub { $alrm++ }; ++ my $got = Time::HiRes::alarm(2.7); ++ ok $got == 0 or print("# $got\n"); + +- my $t0 = Time::HiRes::time(); +- 1 while Time::HiRes::time() - $t0 <= 1; ++ my $t0 = Time::HiRes::time(); ++ 1 while Time::HiRes::time() - $t0 <= 1; + +- $got = Time::HiRes::alarm(0); +- ok $got > 0 && $got < 1.8 or print("# $got\n"); ++ $got = Time::HiRes::alarm(0); ++ ok $got > 0 && $got < 1.8 or print("# $got\n"); + +- ok $alrm == 0 or print("# $alrm\n"); ++ ok $alrm == 0 or print("# $alrm\n"); + +- $got = Time::HiRes::alarm(0); +- ok $got == 0 or print("# $got\n"); ++ $got = Time::HiRes::alarm(0); ++ ok $got == 0 or print("# $got\n"); + } + } + +diff --git a/t/clock.t b/t/clock.t +index 64478b0..810d63a 100644 +--- a/t/clock.t ++++ b/t/clock.t +@@ -22,7 +22,7 @@ printf("# have_clock = %d\n", &Time::HiRes::d_clock); + # Ideally, we'd like to test that the timers are rather precise. + # However, if the system is busy, there are no guarantees on how + # quickly we will return. This limit used to be 10%, but that +-# was occasionally triggered falsely. ++# was occasionally triggered falsely. + # So let's try 25%. + # Another possibility might be to print "ok" if the test completes fine + # with (say) 10% slosh, "skip - system may have been busy?" if the test +@@ -33,31 +33,31 @@ my $limit = 0.25; # 25% is acceptable slosh for testing timers + + SKIP: { + skip "no clock_gettime", 1 +- unless &Time::HiRes::d_clock_gettime && has_symbol("CLOCK_REALTIME"); ++ unless &Time::HiRes::d_clock_gettime && has_symbol("CLOCK_REALTIME"); + my $ok = 0; + TRY: { +- for my $try (1..3) { +- print("# CLOCK_REALTIME: try = $try\n"); +- my $t0 = Time::HiRes::clock_gettime(&CLOCK_REALTIME); +- my $T = 1.5; +- Time::HiRes::sleep($T); +- my $t1 = Time::HiRes::clock_gettime(&CLOCK_REALTIME); +- if ($t0 > 0 && $t1 > $t0) { +- print("# t1 = $t1, t0 = $t0\n"); +- my $dt = $t1 - $t0; +- my $rt = abs(1 - $dt / $T); +- print("# dt = $dt, rt = $rt\n"); +- if ($rt <= 2 * $limit) { +- $ok = 1; +- last TRY; +- } +- } else { +- print("# Error: t0 = $t0, t1 = $t1\n"); +- } +- my $r = rand() + rand(); +- printf("# Sleeping for %.6f seconds...\n", $r); +- Time::HiRes::sleep($r); +- } ++ for my $try (1..3) { ++ print("# CLOCK_REALTIME: try = $try\n"); ++ my $t0 = Time::HiRes::clock_gettime(&CLOCK_REALTIME); ++ my $T = 1.5; ++ Time::HiRes::sleep($T); ++ my $t1 = Time::HiRes::clock_gettime(&CLOCK_REALTIME); ++ if ($t0 > 0 && $t1 > $t0) { ++ print("# t1 = $t1, t0 = $t0\n"); ++ my $dt = $t1 - $t0; ++ my $rt = abs(1 - $dt / $T); ++ print("# dt = $dt, rt = $rt\n"); ++ if ($rt <= 2 * $limit) { ++ $ok = 1; ++ last TRY; ++ } ++ } else { ++ print("# Error: t0 = $t0, t1 = $t1\n"); ++ } ++ my $r = rand() + rand(); ++ printf("# Sleeping for %.6f seconds...\n", $r); ++ Time::HiRes::sleep($r); ++ } + } + ok $ok; + } +@@ -70,7 +70,7 @@ SKIP: { + + SKIP: { + skip "no clock_nanosleep", 1 +- unless &Time::HiRes::d_clock_nanosleep && has_symbol("CLOCK_REALTIME"); ++ unless &Time::HiRes::d_clock_nanosleep && has_symbol("CLOCK_REALTIME"); + my $s = 1.5e9; + my $t = Time::HiRes::clock_nanosleep(&CLOCK_REALTIME, $s); + my $r = abs(1 - $t / $s); +@@ -79,7 +79,7 @@ SKIP: { + + SKIP: { + skip "no clock", 1 unless &Time::HiRes::d_clock; +- skip "no CLOCKS_PER_SEC", 1 unless has_symbol("CLOCKS_PER_SEC"); ++ skip "no CLOCKS_PER_SEC", 1 unless has_symbol("CLOCKS_PER_SEC"); + my @clock = Time::HiRes::clock(); + # If we have a relatively low precision clock() and we haven't seen much + # CPU usage thus far with clock(), we will want to have a bit longer delay. +@@ -89,13 +89,13 @@ SKIP: { + print("# clock = @clock\n"); + for my $i (1..3) { + for (my $j = 0; $j < $delay; $j++) { } +- push @clock, Time::HiRes::clock(); +- print("# clock = @clock\n"); ++ push @clock, Time::HiRes::clock(); ++ print("# clock = @clock\n"); + } + ok $clock[0] >= 0 && +- $clock[1] > $clock[0] && +- $clock[2] > $clock[1] && +- $clock[3] > $clock[2]; ++ $clock[1] > $clock[0] && ++ $clock[2] > $clock[1] && ++ $clock[3] > $clock[2]; + } + + 1; +diff --git a/t/gettimeofday.t b/t/gettimeofday.t +index 9f2fd7e..05cebbb 100644 +--- a/t/gettimeofday.t ++++ b/t/gettimeofday.t +@@ -3,8 +3,8 @@ use strict; + BEGIN { + require Time::HiRes; + unless(&Time::HiRes::d_gettimeofday) { +- require Test::More; +- Test::More::plan(skip_all => "no gettimeofday()"); ++ require Test::More; ++ Test::More::plan(skip_all => "no gettimeofday()"); + } + } + +@@ -21,7 +21,7 @@ sleep 1; + + my @two = Time::HiRes::gettimeofday(); + ok $two[0] > $one[0] || ($two[0] == $one[0] && $two[1] > $one[1]) +- or print("# @two is not greater than @one\n"); ++ or print("# @two is not greater than @one\n"); + + my $f = Time::HiRes::time(); + ok $f > 850_000_000 or print("# $f too small\n"); +diff --git a/t/itimer.t b/t/itimer.t +index 432b224..4e4ce6d 100644 +--- a/t/itimer.t ++++ b/t/itimer.t +@@ -13,15 +13,15 @@ use Config; + BEGIN { + require Time::HiRes; + unless(defined &Time::HiRes::setitimer +- && defined &Time::HiRes::getitimer +- && has_symbol('ITIMER_VIRTUAL') +- && $Config{sig_name} =~ m/\bVTALRM\b/ +- && $^O ne 'nto' # nto: QNX 6 has the API but no implementation +- && $^O ne 'haiku' # haiku: has the API but no implementation +- && $^O ne 'gnu' # GNU/Hurd: has the API but no implementation ++ && defined &Time::HiRes::getitimer ++ && has_symbol('ITIMER_VIRTUAL') ++ && $Config{sig_name} =~ m/\bVTALRM\b/ ++ && $^O ne 'nto' # nto: QNX 6 has the API but no implementation ++ && $^O ne 'haiku' # haiku: has the API but no implementation ++ && $^O ne 'gnu' # GNU/Hurd: has the API but no implementation + ) { +- require Test::More; +- Test::More::plan(skip_all => "no itimer"); ++ require Test::More; ++ Test::More::plan(skip_all => "no itimer"); + } + } + +@@ -37,7 +37,7 @@ my $r = [Time::HiRes::gettimeofday()]; + $SIG{VTALRM} = sub { + $i ? $i-- : Time::HiRes::setitimer(&Time::HiRes::ITIMER_VIRTUAL, 0); + printf("# Tick! $i %s\n", Time::HiRes::tv_interval($r)); +-}; ++}; + + printf("# setitimer: %s\n", join(" ", + Time::HiRes::setitimer(&Time::HiRes::ITIMER_VIRTUAL, 0.5, 0.4))); +diff --git a/t/nanosleep.t b/t/nanosleep.t +index 98cc8d9..ff05637 100644 +--- a/t/nanosleep.t ++++ b/t/nanosleep.t +@@ -3,8 +3,8 @@ use strict; + BEGIN { + require Time::HiRes; + unless(&Time::HiRes::d_nanosleep) { +- require Test::More; +- Test::More::plan(skip_all => "no nanosleep()"); ++ require Test::More; ++ Test::More::plan(skip_all => "no nanosleep()"); + } + } + +@@ -14,7 +14,7 @@ use t::Watchdog; + + eval { Time::HiRes::nanosleep(-5) }; + like $@, qr/::nanosleep\(-5\): negative time not invented yet/, +- "negative time error"; ++ "negative time error"; + + my $one = CORE::time; + Time::HiRes::nanosleep(10_000_000); +diff --git a/t/sleep.t b/t/sleep.t +index 0ab6340..0451650 100644 +--- a/t/sleep.t ++++ b/t/sleep.t +@@ -8,7 +8,7 @@ BEGIN { require_ok "Time::HiRes"; } + + use Config; + +-my $xdefine = ''; ++my $xdefine = ''; + if (open(XDEFINE, "<", "xdefine")) { + chomp($xdefine = || ""); + close(XDEFINE); +@@ -22,11 +22,11 @@ my $can_subsecond_alarm = + + eval { Time::HiRes::sleep(-1) }; + like $@, qr/::sleep\(-1\): negative time not invented yet/, +- "negative time error"; ++ "negative time error"; + + SKIP: { + skip "no subsecond alarm", 2 unless $can_subsecond_alarm; +- my $f = Time::HiRes::time; ++ my $f = Time::HiRes::time; + print("# time...$f\n"); + ok 1; + +diff --git a/t/stat.t b/t/stat.t +index d5e22ac..f2f8e87 100644 +--- a/t/stat.t ++++ b/t/stat.t +@@ -3,13 +3,13 @@ use strict; + BEGIN { + require Time::HiRes; + unless(&Time::HiRes::d_hires_stat) { +- require Test::More; +- Test::More::plan(skip_all => "no hi-res stat"); ++ require Test::More; ++ Test::More::plan(skip_all => "no hi-res stat"); + } + if($^O =~ /\A(?:cygwin|MSWin)/) { +- require Test::More; +- Test::More::plan(skip_all => +- "$^O file timestamps not reliable enough for stat test"); ++ require Test::More; ++ Test::More::plan(skip_all => ++ "$^O file timestamps not reliable enough for stat test"); + } + } + +@@ -50,18 +50,18 @@ my $mi = 0; + my $ss = 0; + for (my $i = 1; $i < @atime; $i++) { + if ($atime[$i] >= $atime[$i-1]) { +- $ai++; ++ $ai++; + } + if ($atime[$i] > int($atime[$i])) { +- $ss++; ++ $ss++; + } + } + for (my $i = 1; $i < @mtime; $i++) { + if ($mtime[$i] >= $mtime[$i-1]) { +- $mi++; ++ $mi++; + } + if ($mtime[$i] > int($mtime[$i])) { +- $ss++; ++ $ss++; + } + } + print("# ai = $ai, mi = $mi, ss = $ss\n"); +@@ -70,7 +70,7 @@ print("# ai = $ai, mi = $mi, ss = $ss\n"); + SKIP: { + skip "no subsecond timestamps detected", 1 if $ss == 0; + ok $mi/(@mtime-1) >= 0.75 && $ai/(@atime-1) >= 0.75 && +- $ss/(@mtime+@atime) >= 0.2; ++ $ss/(@mtime+@atime) >= 0.2; + } + + my $targetname = "tgt$$"; +diff --git a/t/time.t b/t/time.t +index 5db016f..ad42f47 100644 +--- a/t/time.t ++++ b/t/time.t +@@ -10,14 +10,14 @@ SKIP: { + skip "no gettimeofday", 1 unless &Time::HiRes::d_gettimeofday; + my ($s, $n, $i) = (0); + for $i (1 .. 100) { +- $s += Time::HiRes::time() - CORE::time(); +- $n++; ++ $s += Time::HiRes::time() - CORE::time(); ++ $n++; + } + # $s should be, at worst, equal to $n + # (CORE::time() may be rounding down, up, or closest), + # but allow 10% of slop. + ok abs($s) / $n <= 1.10 +- or print("# Time::HiRes::time() not close to CORE::time()\n"); ++ or print("# Time::HiRes::time() not close to CORE::time()\n"); + printf("# s = $s, n = $n, s/n = %s\n", abs($s)/$n); + } + +diff --git a/t/ualarm.t b/t/ualarm.t +index 0f9a829..d478224 100644 +--- a/t/ualarm.t ++++ b/t/ualarm.t +@@ -3,8 +3,8 @@ use strict; + BEGIN { + require Time::HiRes; + unless(&Time::HiRes::d_ualarm) { +- require Test::More; +- Test::More::plan(skip_all => "no ualarm()"); ++ require Test::More; ++ Test::More::plan(skip_all => "no ualarm()"); + } + } + +@@ -25,7 +25,7 @@ SKIP: { + $tick = 0; Time::HiRes::ualarm(10_000); while ($tick == 0) { } + my $three = CORE::time; + ok $one == $two || $two == $three +- or print("# slept too long, $one $two $three\n"); ++ or print("# slept too long, $one $two $three\n"); + print("# tick = $tick, one = $one, two = $two, three = $three\n"); + + $tick = 0; Time::HiRes::ualarm(10_000, 10_000); while ($tick < 3) { } +@@ -36,7 +36,7 @@ SKIP: { + + eval { Time::HiRes::ualarm(-4) }; + like $@, qr/::ualarm\(-4, 0\): negative time not invented yet/, +- "negative time error"; ++ "negative time error"; + + # Find the loop size N (a for() loop 0..N-1) + # that will take more than T seconds. +@@ -44,9 +44,9 @@ like $@, qr/::ualarm\(-4, 0\): negative time not invented yet/, + sub bellish { # Cheap emulation of a bell curve. + my ($min, $max) = @_; + my $rand = ($max - $min) / 5; +- my $sum = 0; ++ my $sum = 0; + for my $i (0..4) { +- $sum += rand($rand); ++ $sum += rand($rand); + } + return $min + $sum; + } +@@ -57,25 +57,25 @@ sub bellish { # Cheap emulation of a bell curve. + for my $n (100_000, 1_100_000, 2_200_000, 4_300_000) { + my $ok; + for my $retry (1..10) { +- my $alarmed = 0; +- local $SIG{ ALRM } = sub { $alarmed++ }; +- my $t0 = Time::HiRes::time(); +- print("# t0 = $t0\n"); +- print("# ualarm($n)\n"); +- Time::HiRes::ualarm($n); 1 while $alarmed == 0; +- my $t1 = Time::HiRes::time(); +- print("# t1 = $t1\n"); +- my $dt = $t1 - $t0; +- print("# dt = $dt\n"); +- my $r = $dt / ($n/1e6); +- print("# r = $r\n"); +- $ok = +- ($n < 1_000_000 || # Too much noise. +- ($r >= 0.8 && $r <= 1.6)); +- last if $ok; +- my $nap = bellish(3, 15); +- printf("# Retrying in %.1f seconds...\n", $nap); +- Time::HiRes::sleep($nap); ++ my $alarmed = 0; ++ local $SIG{ ALRM } = sub { $alarmed++ }; ++ my $t0 = Time::HiRes::time(); ++ print("# t0 = $t0\n"); ++ print("# ualarm($n)\n"); ++ Time::HiRes::ualarm($n); 1 while $alarmed == 0; ++ my $t1 = Time::HiRes::time(); ++ print("# t1 = $t1\n"); ++ my $dt = $t1 - $t0; ++ print("# dt = $dt\n"); ++ my $r = $dt / ($n/1e6); ++ print("# r = $r\n"); ++ $ok = ++ ($n < 1_000_000 || # Too much noise. ++ ($r >= 0.8 && $r <= 1.6)); ++ last if $ok; ++ my $nap = bellish(3, 15); ++ printf("# Retrying in %.1f seconds...\n", $nap); ++ Time::HiRes::sleep($nap); + } + ok $ok or print("# ualarm($n) close enough\n"); + } +@@ -89,8 +89,8 @@ for my $n (100_000, 1_100_000, 2_200_000, 4_300_000) { + + my($alrm, $t1); + do { +- $alrm = $alrm0; +- $t1 = Time::HiRes::time(); ++ $alrm = $alrm0; ++ $t1 = Time::HiRes::time(); + } while $t1 - $t0 <= 0.3; + my $got1 = Time::HiRes::ualarm(0); + +@@ -101,9 +101,9 @@ for my $n (100_000, 1_100_000, 2_200_000, 4_300_000) { + print("# got1 = $got1\n"); + ok $got0 == 0 or print("# $got0\n"); + SKIP: { +- skip "alarm interval exceeded", 2 if $t1 - $t0 >= 0.5; +- ok $got1 > 0; +- ok $alrm == 0; ++ skip "alarm interval exceeded", 2 if $t1 - $t0 >= 0.5; ++ ok $got1 > 0; ++ ok $alrm == 0; + } + ok $got1 < 300_000; + my $got2 = Time::HiRes::ualarm(0); +diff --git a/t/usleep.t b/t/usleep.t +index bb66cbe..396341d 100644 +--- a/t/usleep.t ++++ b/t/usleep.t +@@ -3,8 +3,8 @@ use strict; + BEGIN { + require Time::HiRes; + unless(&Time::HiRes::d_usleep) { +- require Test::More; +- Test::More::plan(skip_all => "no usleep()"); ++ require Test::More; ++ Test::More::plan(skip_all => "no usleep()"); + } + } + +@@ -14,7 +14,7 @@ use t::Watchdog; + + eval { Time::HiRes::usleep(-2) }; + like $@, qr/::usleep\(-2\): negative time not invented yet/, +- "negative time error"; ++ "negative time error"; + + my $limit = 0.25; # 25% is acceptable slosh for testing timers + +@@ -59,8 +59,8 @@ SKIP: { + $msg = "$td went by while sleeping $sleep, ratio $ratio.\n"; + + SKIP: { +- skip $msg, 1 unless $td < $sleep * (1 + $limit); +- ok $a < $limit or print("# $msg\n"); ++ skip $msg, 1 unless $td < $sleep * (1 + $limit); ++ ok $a < $limit or print("# $msg\n"); + } + + $t0 = Time::HiRes::gettimeofday(); +@@ -71,8 +71,8 @@ SKIP: { + $msg = "$td went by while sleeping $sleep, ratio $ratio.\n"; + + SKIP: { +- skip $msg, 1 unless $td < $sleep * (1 + $limit); +- ok $a < $limit or print("# $msg\n"); ++ skip $msg, 1 unless $td < $sleep * (1 + $limit); ++ ok $a < $limit or print("# $msg\n"); + } + } + +diff --git a/t/utime.t b/t/utime.t +index bb4621a..e2399b8 100644 +--- a/t/utime.t ++++ b/t/utime.t +@@ -1,92 +1,92 @@ + use strict; + + sub has_subsecond_file_times { +- require File::Temp; +- require Time::HiRes; +- my ($fh, $filename) = File::Temp::tempfile( "Time-HiRes-utime-XXXXXXXXX" ); +- use File::Basename qw[dirname]; +- my $dirname = dirname($filename); +- require Cwd; +- $dirname = &Cwd::getcwd if $dirname eq '.'; +- print("\n# Testing for subsecond file timestamps (mtime) in $dirname\n"); +- close $fh; +- my @mtimes; +- for (1..2) { +- open $fh, '>', $filename; +- print $fh "foo"; ++ require File::Temp; ++ require Time::HiRes; ++ my ($fh, $filename) = File::Temp::tempfile( "Time-HiRes-utime-XXXXXXXXX" ); ++ use File::Basename qw[dirname]; ++ my $dirname = dirname($filename); ++ require Cwd; ++ $dirname = &Cwd::getcwd if $dirname eq '.'; ++ print("\n# Testing for subsecond file timestamps (mtime) in $dirname\n"); + close $fh; +- push @mtimes, (Time::HiRes::stat($filename))[9]; +- Time::HiRes::sleep(.1) if $_ == 1; +- } +- my $delta = $mtimes[1] - $mtimes[0]; +- # print STDERR "mtimes = @mtimes, delta = $delta\n"; +- unlink $filename; +- my $ok = $delta > 0 && $delta < 1; +- printf("# Subsecond file timestamps in $dirname: %s\n", +- $ok ? "OK" : "NO"); +- return $ok; ++ my @mtimes; ++ for (1..2) { ++ open $fh, '>', $filename; ++ print $fh "foo"; ++ close $fh; ++ push @mtimes, (Time::HiRes::stat($filename))[9]; ++ Time::HiRes::sleep(.1) if $_ == 1; ++ } ++ my $delta = $mtimes[1] - $mtimes[0]; ++ # print STDERR "mtimes = @mtimes, delta = $delta\n"; ++ unlink $filename; ++ my $ok = $delta > 0 && $delta < 1; ++ printf("# Subsecond file timestamps in $dirname: %s\n", ++ $ok ? "OK" : "NO"); ++ return $ok; + } + + sub get_filesys_of_tempfile { +- require File::Temp; +- require Time::HiRes; +- my ($fh, $filename) = File::Temp::tempfile( "Time-HiRes-utime-XXXXXXXXX" ); +- my $filesys; +- if (open(my $df, "df $filename |")) { +- my @fs; +- while (<$df>) { +- next if /^Filesystem/; +- chomp; +- push @fs, $_; +- } +- if (@fs == 1) { +- if (defined $fs[0] && length($fs[0])) { +- $filesys = $fs[0]; +- } else { +- printf("# Got empty result from 'df'\n"); +- } ++ require File::Temp; ++ require Time::HiRes; ++ my ($fh, $filename) = File::Temp::tempfile( "Time-HiRes-utime-XXXXXXXXX" ); ++ my $filesys; ++ if (open(my $df, "df $filename |")) { ++ my @fs; ++ while (<$df>) { ++ next if /^Filesystem/; ++ chomp; ++ push @fs, $_; ++ } ++ if (@fs == 1) { ++ if (defined $fs[0] && length($fs[0])) { ++ $filesys = $fs[0]; ++ } else { ++ printf("# Got empty result from 'df'\n"); ++ } ++ } else { ++ printf("# Expected one result from 'df', got %d\n", scalar(@fs)); ++ } + } else { +- printf("# Expected one result from 'df', got %d\n", scalar(@fs)); ++ # Too noisy to show by default. ++ # Can fail for too many reasons. ++ print "# Failed to run 'df $filename |': $!\n"; + } +- } else { +- # Too noisy to show by default. +- # Can fail for too many reasons. +- print "# Failed to run 'df $filename |': $!\n"; +- } +- return $filesys; ++ return $filesys; + } + + sub get_mount_of_filesys { +- my ($filesys) = @_; +- # netbsd has /sbin/mount +- local $ENV{PATH} = "$ENV{PATH}:/sbin" if $^O =~ /^(?:netbsd)$/; +- if (defined $filesys) { +- my @fs = split(' ', $filesys); +- if (open(my $mount, "mount |")) { +- while (<$mount>) { +- chomp; +- my @mnt = split(' '); +- if ($mnt[0] eq $fs[0]) { +- return $_; ++ my ($filesys) = @_; ++ # netbsd has /sbin/mount ++ local $ENV{PATH} = "$ENV{PATH}:/sbin" if $^O =~ /^(?:netbsd)$/; ++ if (defined $filesys) { ++ my @fs = split(' ', $filesys); ++ if (open(my $mount, "mount |")) { ++ while (<$mount>) { ++ chomp; ++ my @mnt = split(' '); ++ if ($mnt[0] eq $fs[0]) { ++ return $_; ++ } ++ } ++ } else { ++ # Too noisy to show by default. ++ # The mount(8) might not be in the PATH, for example. ++ # Or this might be a completely non-UNIX system. ++ # print "# Failed to run 'mount |': $!\n"; + } +- } +- } else { +- # Too noisy to show by default. +- # The mount(8) might not be in the PATH, for example. +- # Or this might be a completely non-UNIX system. +- # print "# Failed to run 'mount |': $!\n"; + } +- } +- return; ++ return; + } + + sub get_mount_of_tempfile { +- return get_mount_of_filesys(get_filesys_of_tempfile()); ++ return get_mount_of_filesys(get_filesys_of_tempfile()); + } + + sub tempfile_has_noatime_mount { +- my ($mount) = get_mount_of_tempfile(); +- return $mount =~ /\bnoatime\b/; ++ my ($mount) = get_mount_of_tempfile(); ++ return $mount =~ /\bnoatime\b/; + } + + BEGIN { +@@ -94,21 +94,21 @@ BEGIN { + require Test::More; + require File::Temp; + unless(&Time::HiRes::d_hires_utime) { +- Test::More::plan(skip_all => "no hires_utime"); ++ Test::More::plan(skip_all => "no hires_utime"); + } + unless(&Time::HiRes::d_hires_stat) { + # Being able to read subsecond timestamps is a reasonable +- # prerequisite for being able to write them. +- Test::More::plan(skip_all => "no hires_stat"); ++ # prerequisite for being able to write them. ++ Test::More::plan(skip_all => "no hires_stat"); + } + unless (&Time::HiRes::d_futimens) { +- Test::More::plan(skip_all => "no futimens()"); ++ Test::More::plan(skip_all => "no futimens()"); + } + unless (&Time::HiRes::d_utimensat) { +- Test::More::plan(skip_all => "no utimensat()"); ++ Test::More::plan(skip_all => "no utimensat()"); + } + unless (has_subsecond_file_times()) { +- Test::More::plan(skip_all => "No subsecond file timestamps"); ++ Test::More::plan(skip_all => "No subsecond file timestamps"); + } + } + +@@ -128,117 +128,117 @@ my $atime = 1.111111111; + my $mtime = 2.222222222; + + if ($^O eq 'cygwin') { +- # Cygwin timestamps have less precision. +- $atime = 1.1111111; +- $mtime = 2.2222222; ++ # Cygwin timestamps have less precision. ++ $atime = 1.1111111; ++ $mtime = 2.2222222; + } + print "# \$^O = $^O, atime = $atime, mtime = $mtime\n"; + + my $skip_atime = $^O eq 'netbsd' && tempfile_has_noatime_mount(); + + if ($skip_atime) { +- printf("# Skipping atime tests because tempfiles seem to be in a filesystem mounted with 'noatime' ($^O)\n'"); ++ printf("# Skipping atime tests because tempfiles seem to be in a filesystem mounted with 'noatime' ($^O)\n'"); + } + + print "# utime \$fh\n"; + { +- my ($fh, $filename) = tempfile( "Time-HiRes-utime-XXXXXXXXX", UNLINK => 1 ); +- is Time::HiRes::utime($atime, $mtime, $fh), 1, "One file changed"; +- my ($got_atime, $got_mtime) = ( Time::HiRes::stat($filename) )[8, 9]; +- SKIP: { +- skip("noatime mount", 1) if $skip_atime; +- is $got_atime, $atime, "atime set correctly"; +- } +- is $got_mtime, $mtime, "mtime set correctly"; ++ my ($fh, $filename) = tempfile( "Time-HiRes-utime-XXXXXXXXX", UNLINK => 1 ); ++ is Time::HiRes::utime($atime, $mtime, $fh), 1, "One file changed"; ++ my ($got_atime, $got_mtime) = ( Time::HiRes::stat($filename) )[8, 9]; ++ SKIP: { ++ skip("noatime mount", 1) if $skip_atime; ++ is $got_atime, $atime, "atime set correctly"; ++ } ++ is $got_mtime, $mtime, "mtime set correctly"; + }; + + print "#utime \$filename\n"; + { +- my ($fh, $filename) = tempfile( "Time-HiRes-utime-XXXXXXXXX", UNLINK => 1 ); +- is Time::HiRes::utime($atime, $mtime, $filename), 1, "One file changed"; +- my ($got_atime, $got_mtime) = ( Time::HiRes::stat($fh) )[8, 9]; +- SKIP: { +- skip("noatime mount", 1) if $skip_atime; +- is $got_atime, $atime, "atime set correctly"; +- } +- is $got_mtime, $mtime, "mtime set correctly"; ++ my ($fh, $filename) = tempfile( "Time-HiRes-utime-XXXXXXXXX", UNLINK => 1 ); ++ is Time::HiRes::utime($atime, $mtime, $filename), 1, "One file changed"; ++ my ($got_atime, $got_mtime) = ( Time::HiRes::stat($fh) )[8, 9]; ++ SKIP: { ++ skip("noatime mount", 1) if $skip_atime; ++ is $got_atime, $atime, "atime set correctly"; ++ } ++ is $got_mtime, $mtime, "mtime set correctly"; + }; + + print "#utime \$filename round-trip\n"; + { +- my ($fh, $filename) = tempfile( "Time-HiRes-utime-XXXXXXXXX", UNLINK => 1 ); +- # this fractional part is not exactly representable +- my $t = 1000000000.12345; +- is Time::HiRes::utime($t, $t, $filename), 1, "One file changed"; +- my ($got_atime, $got_mtime) = ( Time::HiRes::stat($fh) )[8, 9]; +- is Time::HiRes::utime($got_atime, $got_mtime, $filename), 1, "One file changed"; +- my ($got_atime2, $got_mtime2) = ( Time::HiRes::stat($fh) )[8, 9]; +- is $got_atime, $got_atime2, "atime round trip ok"; +- is $got_mtime, $got_mtime2, "mtime round trip ok"; ++ my ($fh, $filename) = tempfile( "Time-HiRes-utime-XXXXXXXXX", UNLINK => 1 ); ++ # this fractional part is not exactly representable ++ my $t = 1000000000.12345; ++ is Time::HiRes::utime($t, $t, $filename), 1, "One file changed"; ++ my ($got_atime, $got_mtime) = ( Time::HiRes::stat($fh) )[8, 9]; ++ is Time::HiRes::utime($got_atime, $got_mtime, $filename), 1, "One file changed"; ++ my ($got_atime2, $got_mtime2) = ( Time::HiRes::stat($fh) )[8, 9]; ++ is $got_atime, $got_atime2, "atime round trip ok"; ++ is $got_mtime, $got_mtime2, "mtime round trip ok"; + }; + + print "utime \$filename and \$fh\n"; + { +- my ($fh1, $filename1) = tempfile( "Time-HiRes-utime-XXXXXXXXX", UNLINK => 1 ); +- my ($fh2, $filename2) = tempfile( "Time-HiRes-utime-XXXXXXXXX", UNLINK => 1 ); +- is Time::HiRes::utime($atime, $mtime, $filename1, $fh2), 2, "Two files changed"; +- { +- my ($got_atime, $got_mtime) = ( Time::HiRes::stat($fh1) )[8, 9]; +- SKIP: { +- skip("noatime mount", 1) if $skip_atime; +- is $got_atime, $atime, "File 1 atime set correctly"; +- } +- is $got_mtime, $mtime, "File 1 mtime set correctly"; +- } +- { +- my ($got_atime, $got_mtime) = ( Time::HiRes::stat($filename2) )[8, 9]; +- SKIP: { +- skip("noatime mount", 1) if $skip_atime; +- is $got_atime, $atime, "File 2 atime set correctly"; +- } +- is $got_mtime, $mtime, "File 2 mtime set correctly"; +- } ++ my ($fh1, $filename1) = tempfile( "Time-HiRes-utime-XXXXXXXXX", UNLINK => 1 ); ++ my ($fh2, $filename2) = tempfile( "Time-HiRes-utime-XXXXXXXXX", UNLINK => 1 ); ++ is Time::HiRes::utime($atime, $mtime, $filename1, $fh2), 2, "Two files changed"; ++ { ++ my ($got_atime, $got_mtime) = ( Time::HiRes::stat($fh1) )[8, 9]; ++ SKIP: { ++ skip("noatime mount", 1) if $skip_atime; ++ is $got_atime, $atime, "File 1 atime set correctly"; ++ } ++ is $got_mtime, $mtime, "File 1 mtime set correctly"; ++ } ++ { ++ my ($got_atime, $got_mtime) = ( Time::HiRes::stat($filename2) )[8, 9]; ++ SKIP: { ++ skip("noatime mount", 1) if $skip_atime; ++ is $got_atime, $atime, "File 2 atime set correctly"; ++ } ++ is $got_mtime, $mtime, "File 2 mtime set correctly"; ++ } + }; + + print "# utime undef sets time to now\n"; + { +- my ($fh1, $filename1) = tempfile( "Time-HiRes-utime-XXXXXXXXX", UNLINK => 1 ); +- my ($fh2, $filename2) = tempfile( "Time-HiRes-utime-XXXXXXXXX", UNLINK => 1 ); +- +- my $now = Time::HiRes::time; +- sleep(1); +- is Time::HiRes::utime(undef, undef, $filename1, $fh2), 2, "Two files changed"; +- +- { +- my ($got_atime, $got_mtime) = ( Time::HiRes::stat($fh1) )[8, 9]; +- SKIP: { +- skip("noatime mount", 1) if $skip_atime; +- cmp_ok $got_atime, '>=', $now, "File 1 atime set correctly"; +- } +- cmp_ok $got_mtime, '>=', $now, "File 1 mtime set correctly"; +- } +- { +- my ($got_atime, $got_mtime) = ( Time::HiRes::stat($filename2) )[8, 9]; +- SKIP: { +- skip("noatime mount", 1) if $skip_atime; +- cmp_ok $got_atime, '>=', $now, "File 2 atime set correctly"; +- } +- cmp_ok $got_mtime, '>=', $now, "File 2 mtime set correctly"; +- } ++ my ($fh1, $filename1) = tempfile( "Time-HiRes-utime-XXXXXXXXX", UNLINK => 1 ); ++ my ($fh2, $filename2) = tempfile( "Time-HiRes-utime-XXXXXXXXX", UNLINK => 1 ); ++ ++ my $now = Time::HiRes::time; ++ sleep(1); ++ is Time::HiRes::utime(undef, undef, $filename1, $fh2), 2, "Two files changed"; ++ ++ { ++ my ($got_atime, $got_mtime) = ( Time::HiRes::stat($fh1) )[8, 9]; ++ SKIP: { ++ skip("noatime mount", 1) if $skip_atime; ++ cmp_ok $got_atime, '>=', $now, "File 1 atime set correctly"; ++ } ++ cmp_ok $got_mtime, '>=', $now, "File 1 mtime set correctly"; ++ } ++ { ++ my ($got_atime, $got_mtime) = ( Time::HiRes::stat($filename2) )[8, 9]; ++ SKIP: { ++ skip("noatime mount", 1) if $skip_atime; ++ cmp_ok $got_atime, '>=', $now, "File 2 atime set correctly"; ++ } ++ cmp_ok $got_mtime, '>=', $now, "File 2 mtime set correctly"; ++ } + }; + + print "# negative atime dies\n"; + { +- eval { Time::HiRes::utime(-4, $mtime) }; +- like $@, qr/::utime\(-4, 2\.22222\): negative time not invented yet/, +- "negative time error"; ++ eval { Time::HiRes::utime(-4, $mtime) }; ++ like $@, qr/::utime\(-4, 2\.22222\): negative time not invented yet/, ++ "negative time error"; + }; + + print "# negative mtime dies;\n"; + { +- eval { Time::HiRes::utime($atime, -4) }; +- like $@, qr/::utime\(1.11111, -4\): negative time not invented yet/, +- "negative time error"; ++ eval { Time::HiRes::utime($atime, -4) }; ++ like $@, qr/::utime\(1.11111, -4\): negative time not invented yet/, ++ "negative time error"; + }; + + done_testing(); +diff --git a/typemap b/typemap +index ffe60e3..2772c92 100644 +--- a/typemap ++++ b/typemap +@@ -1,319 +1,319 @@ + # basic C types +-int T_IV +-unsigned T_UV +-unsigned int T_UV +-long T_IV +-unsigned long T_UV +-short T_IV +-unsigned short T_UV +-char T_CHAR +-unsigned char T_U_CHAR +-char * T_PV +-unsigned char * T_PV +-const char * T_PV +-caddr_t T_PV +-wchar_t * T_PV +-wchar_t T_IV +-bool_t T_IV +-size_t T_UV +-ssize_t T_IV +-time_t T_NV +-unsigned long * T_OPAQUEPTR +-char ** T_PACKEDARRAY +-void * T_PTR +-Time_t * T_PV +-SV * T_SV +-SVREF T_SVREF +-AV * T_AVREF +-HV * T_HVREF +-CV * T_CVREF ++int T_IV ++unsigned T_UV ++unsigned int T_UV ++long T_IV ++unsigned long T_UV ++short T_IV ++unsigned short T_UV ++char T_CHAR ++unsigned char T_U_CHAR ++char * T_PV ++unsigned char * T_PV ++const char * T_PV ++caddr_t T_PV ++wchar_t * T_PV ++wchar_t T_IV ++bool_t T_IV ++size_t T_UV ++ssize_t T_IV ++time_t T_NV ++unsigned long * T_OPAQUEPTR ++char ** T_PACKEDARRAY ++void * T_PTR ++Time_t * T_PV ++SV * T_SV ++SVREF T_SVREF ++AV * T_AVREF ++HV * T_HVREF ++CV * T_CVREF + + clockid_t T_IV + +-IV T_IV +-UV T_UV ++IV T_IV ++UV T_UV + NV T_NV +-I32 T_IV +-I16 T_IV +-I8 T_IV +-STRLEN T_UV +-U32 T_U_LONG +-U16 T_U_SHORT +-U8 T_UV +-Result T_U_CHAR +-Boolean T_BOOL ++I32 T_IV ++I16 T_IV ++I8 T_IV ++STRLEN T_UV ++U32 T_U_LONG ++U16 T_U_SHORT ++U8 T_UV ++Result T_U_CHAR ++Boolean T_BOOL + float T_FLOAT +-double T_DOUBLE +-SysRet T_SYSRET +-SysRetLong T_SYSRET +-FILE * T_STDIO +-PerlIO * T_INOUT +-FileHandle T_PTROBJ +-InputStream T_IN +-InOutStream T_INOUT +-OutputStream T_OUT +-bool T_BOOL ++double T_DOUBLE ++SysRet T_SYSRET ++SysRetLong T_SYSRET ++FILE * T_STDIO ++PerlIO * T_INOUT ++FileHandle T_PTROBJ ++InputStream T_IN ++InOutStream T_INOUT ++OutputStream T_OUT ++bool T_BOOL + + ############################################################################# + INPUT + T_SV +- $var = $arg ++ $var = $arg + T_SVREF +- if (SvROK($arg)) +- $var = (SV*)SvRV($arg); +- else +- Perl_croak(aTHX_ \"$var is not a reference\") ++ if (SvROK($arg)) ++ $var = (SV*)SvRV($arg); ++ else ++ Perl_croak(aTHX_ \"$var is not a reference\") + T_AVREF +- if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVAV) +- $var = (AV*)SvRV($arg); +- else +- Perl_croak(aTHX_ \"$var is not an array reference\") ++ if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVAV) ++ $var = (AV*)SvRV($arg); ++ else ++ Perl_croak(aTHX_ \"$var is not an array reference\") + T_HVREF +- if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVHV) +- $var = (HV*)SvRV($arg); +- else +- Perl_croak(aTHX_ \"$var is not a hash reference\") ++ if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVHV) ++ $var = (HV*)SvRV($arg); ++ else ++ Perl_croak(aTHX_ \"$var is not a hash reference\") + T_CVREF +- if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVCV) +- $var = (CV*)SvRV($arg); +- else +- Perl_croak(aTHX_ \"$var is not a code reference\") ++ if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVCV) ++ $var = (CV*)SvRV($arg); ++ else ++ Perl_croak(aTHX_ \"$var is not a code reference\") + T_SYSRET +- $var NOT IMPLEMENTED ++ $var NOT IMPLEMENTED + T_UV +- $var = ($type)SvUV($arg) ++ $var = ($type)SvUV($arg) + T_IV +- $var = ($type)SvIV($arg) ++ $var = ($type)SvIV($arg) + T_INT +- $var = (int)SvIV($arg) ++ $var = (int)SvIV($arg) + T_ENUM +- $var = ($type)SvIV($arg) ++ $var = ($type)SvIV($arg) + T_BOOL +- $var = (bool)SvTRUE($arg) ++ $var = (bool)SvTRUE($arg) + T_U_INT +- $var = (unsigned int)SvUV($arg) ++ $var = (unsigned int)SvUV($arg) + T_SHORT +- $var = (short)SvIV($arg) ++ $var = (short)SvIV($arg) + T_U_SHORT +- $var = (unsigned short)SvUV($arg) ++ $var = (unsigned short)SvUV($arg) + T_LONG +- $var = (long)SvIV($arg) ++ $var = (long)SvIV($arg) + T_U_LONG +- $var = (unsigned long)SvUV($arg) ++ $var = (unsigned long)SvUV($arg) + T_CHAR +- $var = (char)*SvPV_nolen($arg) ++ $var = (char)*SvPV_nolen($arg) + T_U_CHAR +- $var = (unsigned char)SvUV($arg) ++ $var = (unsigned char)SvUV($arg) + T_FLOAT +- $var = (float)SvNV($arg) ++ $var = (float)SvNV($arg) + T_NV +- $var = ($type)SvNV($arg) ++ $var = ($type)SvNV($arg) + T_DOUBLE +- $var = (double)SvNV($arg) ++ $var = (double)SvNV($arg) + T_PV +- $var = ($type)SvPV_nolen($arg) ++ $var = ($type)SvPV_nolen($arg) + T_PTR +- $var = INT2PTR($type,SvIV($arg)) ++ $var = INT2PTR($type,SvIV($arg)) + T_PTRREF +- if (SvROK($arg)) { +- IV tmp = SvIV((SV*)SvRV($arg)); +- $var = INT2PTR($type,tmp); +- } +- else +- Perl_croak(aTHX_ \"$var is not a reference\") ++ if (SvROK($arg)) { ++ IV tmp = SvIV((SV*)SvRV($arg)); ++ $var = INT2PTR($type,tmp); ++ } ++ else ++ Perl_croak(aTHX_ \"$var is not a reference\") + T_REF_IV_REF +- if (sv_isa($arg, \"${ntype}\")) { +- IV tmp = SvIV((SV*)SvRV($arg)); +- $var = *INT2PTR($type *, tmp); +- } +- else +- Perl_croak(aTHX_ \"$var is not of type ${ntype}\") ++ if (sv_isa($arg, \"${ntype}\")) { ++ IV tmp = SvIV((SV*)SvRV($arg)); ++ $var = *INT2PTR($type *, tmp); ++ } ++ else ++ Perl_croak(aTHX_ \"$var is not of type ${ntype}\") + T_REF_IV_PTR +- if (sv_isa($arg, \"${ntype}\")) { +- IV tmp = SvIV((SV*)SvRV($arg)); +- $var = INT2PTR($type, tmp); +- } +- else +- Perl_croak(aTHX_ \"$var is not of type ${ntype}\") ++ if (sv_isa($arg, \"${ntype}\")) { ++ IV tmp = SvIV((SV*)SvRV($arg)); ++ $var = INT2PTR($type, tmp); ++ } ++ else ++ Perl_croak(aTHX_ \"$var is not of type ${ntype}\") + T_PTROBJ +- if (sv_derived_from($arg, \"${ntype}\")) { +- IV tmp = SvIV((SV*)SvRV($arg)); +- $var = INT2PTR($type,tmp); +- } +- else +- Perl_croak(aTHX_ \"$var is not of type ${ntype}\") ++ if (sv_derived_from($arg, \"${ntype}\")) { ++ IV tmp = SvIV((SV*)SvRV($arg)); ++ $var = INT2PTR($type,tmp); ++ } ++ else ++ Perl_croak(aTHX_ \"$var is not of type ${ntype}\") + T_PTRDESC +- if (sv_isa($arg, \"${ntype}\")) { +- IV tmp = SvIV((SV*)SvRV($arg)); +- ${type}_desc = (\U${type}_DESC\E*) tmp; +- $var = ${type}_desc->ptr; +- } +- else +- Perl_croak(aTHX_ \"$var is not of type ${ntype}\") ++ if (sv_isa($arg, \"${ntype}\")) { ++ IV tmp = SvIV((SV*)SvRV($arg)); ++ ${type}_desc = (\U${type}_DESC\E*) tmp; ++ $var = ${type}_desc->ptr; ++ } ++ else ++ Perl_croak(aTHX_ \"$var is not of type ${ntype}\") + T_REFREF +- if (SvROK($arg)) { +- IV tmp = SvIV((SV*)SvRV($arg)); +- $var = *INT2PTR($type,tmp); +- } +- else +- Perl_croak(aTHX_ \"$var is not a reference\") ++ if (SvROK($arg)) { ++ IV tmp = SvIV((SV*)SvRV($arg)); ++ $var = *INT2PTR($type,tmp); ++ } ++ else ++ Perl_croak(aTHX_ \"$var is not a reference\") + T_REFOBJ +- if (sv_isa($arg, \"${ntype}\")) { +- IV tmp = SvIV((SV*)SvRV($arg)); +- $var = *INT2PTR($type,tmp); +- } +- else +- Perl_croak(aTHX_ \"$var is not of type ${ntype}\") ++ if (sv_isa($arg, \"${ntype}\")) { ++ IV tmp = SvIV((SV*)SvRV($arg)); ++ $var = *INT2PTR($type,tmp); ++ } ++ else ++ Perl_croak(aTHX_ \"$var is not of type ${ntype}\") + T_OPAQUE +- $var = *($type *)SvPV_nolen($arg) ++ $var = *($type *)SvPV_nolen($arg) + T_OPAQUEPTR +- $var = ($type)SvPV_nolen($arg) ++ $var = ($type)SvPV_nolen($arg) + T_PACKED +- $var = XS_unpack_$ntype($arg) ++ $var = XS_unpack_$ntype($arg) + T_PACKEDARRAY +- $var = XS_unpack_$ntype($arg) ++ $var = XS_unpack_$ntype($arg) + T_CALLBACK +- $var = make_perl_cb_$type($arg) ++ $var = make_perl_cb_$type($arg) + T_ARRAY +- U32 ix_$var = $argoff; +- $var = $ntype(items -= $argoff); +- while (items--) { +- DO_ARRAY_ELEM; +- ix_$var++; +- } +- /* this is the number of elements in the array */ +- ix_$var -= $argoff ++ U32 ix_$var = $argoff; ++ $var = $ntype(items -= $argoff); ++ while (items--) { ++ DO_ARRAY_ELEM; ++ ix_$var++; ++ } ++ /* this is the number of elements in the array */ ++ ix_$var -= $argoff + T_STDIO +- $var = PerlIO_findFILE(IoIFP(sv_2io($arg))) ++ $var = PerlIO_findFILE(IoIFP(sv_2io($arg))) + T_IN +- $var = IoIFP(sv_2io($arg)) ++ $var = IoIFP(sv_2io($arg)) + T_INOUT +- $var = IoIFP(sv_2io($arg)) ++ $var = IoIFP(sv_2io($arg)) + T_OUT +- $var = IoOFP(sv_2io($arg)) ++ $var = IoOFP(sv_2io($arg)) + ############################################################################# + OUTPUT + T_SV +- $arg = $var; ++ $arg = $var; + T_SVREF +- $arg = newRV((SV*)$var); ++ $arg = newRV((SV*)$var); + T_AVREF +- $arg = newRV((SV*)$var); ++ $arg = newRV((SV*)$var); + T_HVREF +- $arg = newRV((SV*)$var); ++ $arg = newRV((SV*)$var); + T_CVREF +- $arg = newRV((SV*)$var); ++ $arg = newRV((SV*)$var); + T_IV +- sv_setiv($arg, (IV)$var); ++ sv_setiv($arg, (IV)$var); + T_UV +- sv_setuv($arg, (UV)$var); ++ sv_setuv($arg, (UV)$var); + T_INT +- sv_setiv($arg, (IV)$var); ++ sv_setiv($arg, (IV)$var); + T_SYSRET +- if ($var != -1) { +- if ($var == 0) +- sv_setpvn($arg, "0 but true", 10); +- else +- sv_setiv($arg, (IV)$var); +- } ++ if ($var != -1) { ++ if ($var == 0) ++ sv_setpvn($arg, "0 but true", 10); ++ else ++ sv_setiv($arg, (IV)$var); ++ } + T_ENUM +- sv_setiv($arg, (IV)$var); ++ sv_setiv($arg, (IV)$var); + T_BOOL +- $arg = boolSV($var); ++ $arg = boolSV($var); + T_U_INT +- sv_setuv($arg, (UV)$var); ++ sv_setuv($arg, (UV)$var); + T_SHORT +- sv_setiv($arg, (IV)$var); ++ sv_setiv($arg, (IV)$var); + T_U_SHORT +- sv_setuv($arg, (UV)$var); ++ sv_setuv($arg, (UV)$var); + T_LONG +- sv_setiv($arg, (IV)$var); ++ sv_setiv($arg, (IV)$var); + T_U_LONG +- sv_setuv($arg, (UV)$var); ++ sv_setuv($arg, (UV)$var); + T_CHAR +- sv_setpvn($arg, (char *)&$var, 1); ++ sv_setpvn($arg, (char *)&$var, 1); + T_U_CHAR +- sv_setuv($arg, (UV)$var); ++ sv_setuv($arg, (UV)$var); + T_FLOAT +- sv_setnv($arg, (double)$var); ++ sv_setnv($arg, (double)$var); + T_NV +- sv_setnv($arg, (NV)$var); ++ sv_setnv($arg, (NV)$var); + T_DOUBLE +- sv_setnv($arg, (double)$var); ++ sv_setnv($arg, (double)$var); + T_PV +- sv_setpv((SV*)$arg, $var); ++ sv_setpv((SV*)$arg, $var); + T_PTR +- sv_setiv($arg, PTR2IV($var)); ++ sv_setiv($arg, PTR2IV($var)); + T_PTRREF +- sv_setref_pv($arg, Nullch, (void*)$var); ++ sv_setref_pv($arg, Nullch, (void*)$var); + T_REF_IV_REF +- sv_setref_pv($arg, \"${ntype}\", (void*)new $ntype($var)); ++ sv_setref_pv($arg, \"${ntype}\", (void*)new $ntype($var)); + T_REF_IV_PTR +- sv_setref_pv($arg, \"${ntype}\", (void*)$var); ++ sv_setref_pv($arg, \"${ntype}\", (void*)$var); + T_PTROBJ +- sv_setref_pv($arg, \"${ntype}\", (void*)$var); ++ sv_setref_pv($arg, \"${ntype}\", (void*)$var); + T_PTRDESC +- sv_setref_pv($arg, \"${ntype}\", (void*)new\U${type}_DESC\E($var)); ++ sv_setref_pv($arg, \"${ntype}\", (void*)new\U${type}_DESC\E($var)); + T_REFREF +- NOT_IMPLEMENTED ++ NOT_IMPLEMENTED + T_REFOBJ +- NOT IMPLEMENTED ++ NOT IMPLEMENTED + T_OPAQUE +- sv_setpvn($arg, (char *)&$var, sizeof($var)); ++ sv_setpvn($arg, (char *)&$var, sizeof($var)); + T_OPAQUEPTR +- sv_setpvn($arg, (char *)$var, sizeof(*$var)); ++ sv_setpvn($arg, (char *)$var, sizeof(*$var)); + T_PACKED +- XS_pack_$ntype($arg, $var); ++ XS_pack_$ntype($arg, $var); + T_PACKEDARRAY +- XS_pack_$ntype($arg, $var, count_$ntype); +-T_DATAUNIT +- sv_setpvn($arg, $var.chp(), $var.size()); ++ XS_pack_$ntype($arg, $var, count_$ntype); ++T_DATAUNIT ++ sv_setpvn($arg, $var.chp(), $var.size()); + T_CALLBACK +- sv_setpvn($arg, $var.context.value().chp(), +- $var.context.value().size()); ++ sv_setpvn($arg, $var.context.value().chp(), ++ $var.context.value().size()); + T_ARRAY +- { +- U32 ix_$var; +- EXTEND(SP,size_$var); +- for (ix_$var = 0; ix_$var < size_$var; ix_$var++) { +- ST(ix_$var) = sv_newmortal(); +- DO_ARRAY_ELEM +- } ++ { ++ U32 ix_$var; ++ EXTEND(SP,size_$var); ++ for (ix_$var = 0; ix_$var < size_$var; ix_$var++) { ++ ST(ix_$var) = sv_newmortal(); ++ DO_ARRAY_ELEM + } ++ } + T_STDIO +- { +- GV *gv = (GV *)sv_newmortal(); +- PerlIO *fp = PerlIO_importFILE($var,0); +- gv_init(gv, gv_stashpv("$Package",1),"__ANONIO__",10,0); +- if ( fp && do_open(gv, "+<&", 3, FALSE, 0, 0, fp) ) +- sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1))); +- else +- $arg = &PL_sv_undef; +- } ++ { ++ GV *gv = (GV *)sv_newmortal(); ++ PerlIO *fp = PerlIO_importFILE($var,0); ++ gv_init(gv, gv_stashpv("$Package",1),"__ANONIO__",10,0); ++ if ( fp && do_open(gv, "+<&", 3, FALSE, 0, 0, fp) ) ++ sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1))); ++ else ++ $arg = &PL_sv_undef; ++ } + T_IN +- { +- GV *gv = (GV *)sv_newmortal(); +- gv_init(gv, gv_stashpv("$Package",1),"__ANONIO__",10,0); +- if ( do_open(gv, "<&", 2, FALSE, 0, 0, $var) ) +- sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1))); +- else +- $arg = &PL_sv_undef; +- } ++ { ++ GV *gv = (GV *)sv_newmortal(); ++ gv_init(gv, gv_stashpv("$Package",1),"__ANONIO__",10,0); ++ if ( do_open(gv, "<&", 2, FALSE, 0, 0, $var) ) ++ sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1))); ++ else ++ $arg = &PL_sv_undef; ++ } + T_INOUT +- { +- GV *gv = (GV *)sv_newmortal(); +- gv_init(gv, gv_stashpv("$Package",1),"__ANONIO__",10,0); +- if ( do_open(gv, "+<&", 3, FALSE, 0, 0, $var) ) +- sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1))); +- else +- $arg = &PL_sv_undef; +- } ++ { ++ GV *gv = (GV *)sv_newmortal(); ++ gv_init(gv, gv_stashpv("$Package",1),"__ANONIO__",10,0); ++ if ( do_open(gv, "+<&", 3, FALSE, 0, 0, $var) ) ++ sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1))); ++ else ++ $arg = &PL_sv_undef; ++ } + T_OUT +- { +- GV *gv = (GV *)sv_newmortal(); +- gv_init(gv, gv_stashpv("$Package",1),"__ANONIO__",10,0); +- if ( do_open(gv, "+>&", 3, FALSE, 0, 0, $var) ) +- sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1))); +- else +- $arg = &PL_sv_undef; +- } ++ { ++ GV *gv = (GV *)sv_newmortal(); ++ gv_init(gv, gv_stashpv("$Package",1),"__ANONIO__",10,0); ++ if ( do_open(gv, "+>&", 3, FALSE, 0, 0, $var) ) ++ sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1))); ++ else ++ $arg = &PL_sv_undef; ++ } +-- +2.21.1 + diff --git a/perl-Time-HiRes.spec b/perl-Time-HiRes.spec index 52f71b4..f265425 100644 --- a/perl-Time-HiRes.spec +++ b/perl-Time-HiRes.spec @@ -1,10 +1,14 @@ +%global base_version 1.9760 + Name: perl-Time-HiRes -Version: 1.9760 -Release: 440%{?dist} +Version: 1.9764 +Release: 456%{?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-%{version}.tar.gz +Source0: https://cpan.metacpan.org/authors/id/A/AT/ATOOMIC/Time-HiRes-%{base_version}.tar.gz +# Unbundled from perl 5.32.0 +Patch0: Time-HiRes-1.9760-Upgrade-to-1.9764.patch BuildRequires: findutils BuildRequires: gcc BuildRequires: make @@ -37,7 +41,8 @@ ualarm, gettimeofday, and setitimer/getitimer system calls, in other words, high resolution time and timers. %prep -%setup -q -n Time-HiRes-%{version} +%setup -q -n Time-HiRes-%{base_version} +%patch0 -p1 %build unset PERL_CORE @@ -59,6 +64,9 @@ make test %{_mandir}/man3/* %changelog +* Mon Jun 22 2020 Jitka Plesnikova - 1.9764-456 +- Upgrade to 1.9764 as provided in perl-5.32.0 + * Thu Jan 30 2020 Fedora Release Engineering - 1.9760-440 - Rebuilt for https://fedoraproject.org/wiki/Fedora_32_Mass_Rebuild