From dc4abce0a2bf837552a5b8b0daa24d5b11512472 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= Date: Mon, 24 Aug 2020 14:16:09 +0200 Subject: [PATCH] Remove an unused patch --- Time-HiRes-1.9760-Upgrade-to-1.9764.patch | 5431 --------------------- 1 file changed, 5431 deletions(-) delete mode 100644 Time-HiRes-1.9760-Upgrade-to-1.9764.patch diff --git a/Time-HiRes-1.9760-Upgrade-to-1.9764.patch b/Time-HiRes-1.9760-Upgrade-to-1.9764.patch deleted file mode 100644 index 1bae891..0000000 --- a/Time-HiRes-1.9760-Upgrade-to-1.9764.patch +++ /dev/null @@ -1,5431 +0,0 @@ -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 -