From: afresh1 Date: Thu, 30 Jun 2016 21:16:13 +0000 (+0000) Subject: Update perl Time::HiRes to 1.9739 X-Git-Url: http://artulab.com/gitweb/?a=commitdiff_plain;h=4d89aaebdca7d1aff9179b5d074c31d49c0727e4;p=openbsd Update perl Time::HiRes to 1.9739 Which provides hires `utime` requested by espie@ OK millert@ --- diff --git a/gnu/usr.bin/perl/cpan/Time-HiRes/HiRes.pm b/gnu/usr.bin/perl/cpan/Time-HiRes/HiRes.pm index cf64bc1fbba..2071e5e83dc 100644 --- a/gnu/usr.bin/perl/cpan/Time-HiRes/HiRes.pm +++ b/gnu/usr.bin/perl/cpan/Time-HiRes/HiRes.pm @@ -12,18 +12,23 @@ our @EXPORT = qw( ); our @EXPORT_OK = qw (usleep sleep ualarm alarm gettimeofday time tv_interval getitimer setitimer nanosleep clock_gettime clock_getres clock clock_nanosleep - CLOCK_HIGHRES CLOCK_MONOTONIC CLOCK_PROCESS_CPUTIME_ID - CLOCK_REALTIME CLOCK_SOFTTIME CLOCK_THREAD_CPUTIME_ID + CLOCK_BOOTTIME CLOCK_HIGHRES + CLOCK_MONOTONIC CLOCK_MONOTONIC_COARSE + CLOCK_MONOTONIC_PRECISE CLOCK_MONOTONIC_RAW + CLOCK_PROCESS_CPUTIME_ID + CLOCK_REALTIME CLOCK_REALTIME_COARSE + CLOCK_REALTIME_FAST CLOCK_REALTIME_PRECISE + CLOCK_SECOND CLOCK_SOFTTIME CLOCK_THREAD_CPUTIME_ID CLOCK_TIMEOFDAY CLOCKS_PER_SEC ITIMER_REAL ITIMER_VIRTUAL ITIMER_PROF ITIMER_REALPROF TIMER_ABSTIME d_usleep d_ualarm d_gettimeofday d_getitimer d_setitimer - d_nanosleep d_clock_gettime d_clock_getres + d_nanosleep d_clock_gettime d_clock_getres d_hires_utime d_clock d_clock_nanosleep - stat lstat + stat lstat utime ); -our $VERSION = '1.9726'; +our $VERSION = '1.9739'; our $XS_VERSION = $VERSION; $VERSION = eval $VERSION; @@ -55,6 +60,7 @@ sub import { ($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"); @@ -87,7 +93,7 @@ Time::HiRes - High resolution alarm, sleep, gettimeofday, interval timers use Time::HiRes qw( usleep ualarm gettimeofday tv_interval nanosleep clock_gettime clock_getres clock_nanosleep clock - stat lstat ); + stat lstat utime); usleep ($microseconds); nanosleep ($nanoseconds); @@ -115,7 +121,8 @@ 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_REALPROF ); + ITIMER_REAL ITIMER_VIRTUAL ITIMER_PROF + ITIMER_REALPROF ); $realtime = clock_gettime(CLOCK_REALTIME); $resolution = clock_getres(CLOCK_REALTIME); @@ -131,6 +138,9 @@ Time::HiRes - High resolution alarm, sleep, gettimeofday, interval timers my @stat = stat(FH); my @stat = lstat("file"); + use Time::HiRes qw( utime ); + utime $floating_seconds, $floating_seconds, file...; + =head1 DESCRIPTION The C module implements a Perl interface to the @@ -356,6 +366,13 @@ specified by C<$which>. All implementations that support POSIX high resolution timers are supposed to support at least the C<$which> value of C, see L. +B: the resolution returned may be highly optimistic. Even if +the resolution is high (a small number), all it means is that you'll +be able to specify the arguments to clock_gettime() and clock_nanosleep() +with that resolution. The system might not actually be able to measure +events at that resolution, and the various overheads and the overall system +load are certain to affect any timings. + =item clock_nanosleep ( $which, $nanoseconds, $flags = 0) Sleeps for the number of nanoseconds (1e9ths of a second) specified. @@ -433,6 +450,26 @@ if the operations are the access time stamp from t2 need not be greater-than the modify time stamp from t1: it may be equal or I. +=item utime LIST + +As L +but with the ability to set the access/modify file timestamps +in subsecond resolution, if the operating system and the filesystem +both support such timestamps. To override the standard utime(): + + use Time::HiRes qw(utime); + +Test for the value of &Time::HiRes::d_hires_utime to find out whether +the operating system supports setting subsecond file timestamps. + +As with CORE::utime(), passing undef as both the atime and mtime will +call the syscall with a NULL argument. + +The actual achievable subsecond resolution depends on the combination +of the operating system and the filesystem. + +Returns the number of files successfully changed. + =back =head1 EXAMPLES @@ -510,7 +547,7 @@ modglobal hash: name C prototype --------------- ---------------------- - Time::NVtime double (*)() + Time::NVtime NV (*)() Time::U2time void (*)(pTHX_ UV ret[2]) Both functions return equivalent information (like C) @@ -521,12 +558,12 @@ VMS have emulations for it.) Here is an example of using C from C: - double (*myNVtime)(); /* Returns -1 on failure. */ + NV (*myNVtime)(); /* Returns -1 on failure. */ SV **svp = hv_fetch(PL_modglobal, "Time::NVtime", 12, 0); if (!svp) croak("Time::HiRes is required"); if (!SvIOK(*svp)) croak("Time::NVtime isn't a function pointer"); - myNVtime = INT2PTR(double(*)(), SvIV(*svp)); - printf("The current time is: %f\n", (*myNVtime)()); + myNVtime = INT2PTR(NV(*)(), SvIV(*svp)); + printf("The current time is: %" NVff "\n", (*myNVtime)()); =head1 DIAGNOSTICS @@ -573,6 +610,14 @@ might help in this (in case your system supports CLOCK_MONOTONIC). Some systems have APIs but not implementations: for example QNX and Haiku have the interval timer APIs but not the functionality. +In pre-Sierra macOS (pre-10.12, OS X) clock_getres(), clock_gettime() +and clock_nanosleep() are emulated using the Mach timers; as a side +effect of being emulated the CLOCK_REALTIME and CLOCK_MONOTONIC are +the same timer. + +gnukfreebsd seems to have non-functional futimens() and utimensat() +(at least as of 10.1): therefore the hires utime() does not work. + =head1 SEE ALSO Perl modules L, L. diff --git a/gnu/usr.bin/perl/cpan/Time-HiRes/HiRes.xs b/gnu/usr.bin/perl/cpan/Time-HiRes/HiRes.xs index 96640e9b03c..3a5c7a1d63c 100644 --- a/gnu/usr.bin/perl/cpan/Time-HiRes/HiRes.xs +++ b/gnu/usr.bin/perl/cpan/Time-HiRes/HiRes.xs @@ -179,6 +179,7 @@ _gettimeofday(pTHX_ struct timeval *tp, void *not_used) 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) { QueryPerformanceFrequency((LARGE_INTEGER*)&MY_CXT.tick_frequency); @@ -417,7 +418,7 @@ gettimeofday (struct timeval *tp, void *tpz) #define HAS_USLEEP #define usleep hrt_usleep /* could conflict with ncurses for static build */ -void +static void hrt_usleep(unsigned long usec) /* This is used to emulate usleep. */ { struct timespec res; @@ -433,7 +434,7 @@ hrt_usleep(unsigned long usec) /* This is used to emulate usleep. */ #define HAS_USLEEP #define usleep hrt_usleep /* could conflict with ncurses for static build */ -void +static void hrt_usleep(unsigned long usec) { struct timeval tv; @@ -449,7 +450,7 @@ hrt_usleep(unsigned long usec) #define HAS_USLEEP #define usleep hrt_usleep /* could conflict with ncurses for static build */ -void +static void hrt_usleep(unsigned long usec) { long msec; @@ -462,7 +463,7 @@ hrt_usleep(unsigned long usec) #define HAS_USLEEP #define usleep hrt_usleep /* could conflict with ncurses for static build */ -void +static void hrt_usleep(unsigned long usec) { int msec = usec / 1000; @@ -484,19 +485,6 @@ hrt_ualarm_itimero(struct itimerval *oitv, int usec, int uinterval) return setitimer(ITIMER_REAL, &itv, oitv); } -int -hrt_ualarm_itimer(int usec, int uinterval) -{ - return hrt_ualarm_itimero(NULL, usec, uinterval); -} - -#ifdef HAS_UALARM -int -hrt_ualarm(int usec, int interval) /* for binary compat before 1.91 */ -{ - return hrt_ualarm_itimer(usec, interval); -} -#endif /* #ifdef HAS_UALARM */ #endif /* #if !defined(HAS_UALARM) && defined(HAS_SETITIMER) */ #if !defined(HAS_UALARM) && defined(HAS_SETITIMER) @@ -731,7 +719,7 @@ myNVtime() static void hrstatns(UV *atime_nsec, UV *mtime_nsec, UV *ctime_nsec) { - dTHXR; + dTHX; #if TIME_HIRES_STAT == 1 *atime_nsec = PL_statcache.st_atimespec.tv_nsec; *mtime_nsec = PL_statcache.st_mtimespec.tv_nsec; @@ -759,8 +747,214 @@ hrstatns(UV *atime_nsec, UV *mtime_nsec, UV *ctime_nsec) #endif /* !TIME_HIRES_STAT */ } +/* Until Apple implements clock_gettime() + * (ditto clock_getres() and clock_nanosleep()) + * we will emulate them using the Mach kernel interfaces. */ +#if defined(PERL_DARWIN) && \ + (defined(TIME_HIRES_CLOCK_GETTIME_EMULATION) || \ + 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 TIMER_ABSTIME +# define TIMER_ABSTIME 0x01 +#endif + +#ifdef USE_ITHREADS +# define PERL_DARWIN_MUTEX +#endif + +#ifdef PERL_DARWIN_MUTEX +STATIC perl_mutex darwin_time_mutex; +#endif + +#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; + } + } + } +#ifdef PERL_DARWIN_MUTEX + MUTEX_UNLOCK(&darwin_time_mutex); +#endif + return success; +} + +#ifdef TIME_HIRES_CLOCK_GETTIME_EMULATION +static int clock_gettime(int 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; + } + } + + SETERRNO(EINVAL, LIB_INVARG); + return -1; +} +#endif /* TIME_HIRES_CLOCK_GETTIME_EMULATION */ + +#ifdef TIME_HIRES_CLOCK_GETRES_EMULATION +static int clock_getres(int 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; + } + } + + SETERRNO(EINVAL, LIB_INVARG); + return -1; +} +#endif /* TIME_HIRES_CLOCK_GETRES_EMULATION */ + +#ifdef TIME_HIRES_CLOCK_NANOSLEEP_EMULATION +static int clock_nanosleep(int 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; + } + + default: + break; + } + } + + SETERRNO(EINVAL, LIB_INVARG); + return -1; +} +#endif /* TIME_HIRES_CLOCK_NANOSLEEP_EMULATION */ + +#endif /* PERL_DARWIN */ + #include "const-c.inc" +#if (defined(TIME_HIRES_NANOSLEEP)) || \ + (defined(TIME_HIRES_CLOCK_NANOSLEEP) && defined(TIMER_ABSTIME)) + +static void +nanosleep_init(NV nsec, + struct timespec *sleepfor, + struct timespec *unslept) { + sleepfor->tv_sec = (Time_t)(nsec / NV_1E9); + sleepfor->tv_nsec = (long)(nsec - ((NV)sleepfor->tv_sec) * NV_1E9); + unslept->tv_sec = 0; + unslept->tv_nsec = 0; +} + +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; + } else { + 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); +} + +#endif + +/* 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)) +#endif + MODULE = Time::HiRes PACKAGE = Time::HiRes PROTOTYPES: ENABLE @@ -780,6 +974,11 @@ BOOT: } # endif #endif +#if defined(PERL_DARWIN) +# if defined(USE_ITHREADS) && defined(PERL_DARWIN_MUTEX) + MUTEX_INIT(&darwin_time_mutex); +# endif +#endif } #if defined(USE_ITHREADS) && defined(MY_CXT_KEY) @@ -803,14 +1002,14 @@ usleep(useconds) CODE: gettimeofday(&Ta, NULL); if (items > 0) { - if (useconds >= 1E6) { - IV seconds = (IV) (useconds / 1E6); + 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 -= 1E6 * seconds; + useconds -= NV_1E6 * seconds; } } else if (useconds < 0.0) croak("Time::HiRes::usleep(%"NVgf"): negative time not invented yet", useconds); @@ -821,7 +1020,7 @@ usleep(useconds) #if 0 printf("[%ld %ld] [%ld %ld]\n", Tb.tv_sec, Tb.tv_usec, Ta.tv_sec, Ta.tv_usec); #endif - RETVAL = 1E6*(Tb.tv_sec-Ta.tv_sec)+(NV)((IV)Tb.tv_usec-(IV)Ta.tv_usec); + RETVAL = NV_1E6*(Tb.tv_sec-Ta.tv_sec)+(NV)((IV)Tb.tv_usec-(IV)Ta.tv_usec); OUTPUT: RETVAL @@ -836,18 +1035,11 @@ nanosleep(nsec) CODE: if (nsec < 0.0) croak("Time::HiRes::nanosleep(%"NVgf"): negative time not invented yet", nsec); - sleepfor.tv_sec = (Time_t)(nsec / 1e9); - sleepfor.tv_nsec = (long)(nsec - ((NV)sleepfor.tv_sec) * 1e9); - if (!nanosleep(&sleepfor, &unslept)) { + nanosleep_init(nsec, &sleepfor, &unslept); + if (nanosleep(&sleepfor, &unslept) == 0) { RETVAL = nsec; } else { - sleepfor.tv_sec -= unslept.tv_sec; - sleepfor.tv_nsec -= unslept.tv_nsec; - if (sleepfor.tv_nsec < 0) { - sleepfor.tv_sec--; - sleepfor.tv_nsec += 1000000000; - } - RETVAL = ((NV)sleepfor.tv_sec) * 1e9 + ((NV)sleepfor.tv_nsec); + RETVAL = nsec_without_unslept(&sleepfor, &unslept); } OUTPUT: RETVAL @@ -858,6 +1050,7 @@ NV nanosleep(nsec) NV nsec CODE: + PERL_UNUSED_ARG(nsec); croak("Time::HiRes::nanosleep(): unimplemented in this platform"); RETVAL = 0.0; OUTPUT: @@ -908,6 +1101,7 @@ NV usleep(useconds) NV useconds CODE: + PERL_UNUSED_ARG(useconds); croak("Time::HiRes::usleep(): unimplemented in this platform"); RETVAL = 0.0; OUTPUT: @@ -993,6 +1187,8 @@ ualarm(useconds,interval=0) int useconds int interval CODE: + PERL_UNUSED_ARG(useconds); + PERL_UNUSED_ARG(interval); croak("Time::HiRes::ualarm(): unimplemented in this platform"); RETVAL = -1; OUTPUT: @@ -1003,6 +1199,8 @@ alarm(seconds,interval=0) NV seconds NV interval CODE: + PERL_UNUSED_ARG(seconds); + PERL_UNUSED_ARG(interval); croak("Time::HiRes::alarm(): unimplemented in this platform"); RETVAL = 0.0; OUTPUT: @@ -1109,6 +1307,12 @@ setitimer(which, seconds, interval = 0) 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 + */ +#ifdef GCC_DIAG_IGNORE + GCC_DIAG_IGNORE(-Wc++-compat); +#endif if (setitimer(which, &newit, &oldit) == 0) { EXTEND(sp, 1); PUSHs(sv_2mortal(newSVnv(TV2NV(oldit.it_value)))); @@ -1117,6 +1321,9 @@ setitimer(which, seconds, interval = 0) PUSHs(sv_2mortal(newSVnv(TV2NV(oldit.it_interval)))); } } +#ifdef GCC_DIAG_RESTORE + GCC_DIAG_RESTORE; +#endif void getitimer(which) @@ -1124,6 +1331,12 @@ getitimer(which) PREINIT: 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 + */ +#ifdef GCC_DIAG_IGNORE + GCC_DIAG_IGNORE(-Wc++-compat); +#endif if (getitimer(which, &nowit) == 0) { EXTEND(sp, 1); PUSHs(sv_2mortal(newSVnv(TV2NV(nowit.it_value)))); @@ -1132,9 +1345,88 @@ getitimer(which) PUSHs(sv_2mortal(newSVnv(TV2NV(nowit.it_interval)))); } } +#ifdef GCC_DIAG_RESTORE + GCC_DIAG_RESTORE; +#endif #endif /* #if defined(HAS_GETITIMER) && defined(HAS_SETITIMER) */ +#if defined(TIME_HIRES_UTIME) + +I32 +utime(accessed, modified, ...) +PROTOTYPE: $$@ + PREINIT: + SV* accessed; + SV* modified; + SV* file; + + 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) - utbuf[0].tv_sec ) * 1e9 ); + utbuf[1].tv_sec = (Time_t)SvNV(modified); /* time modified */ + utbuf[1].tv_nsec = (long)( ( SvNV(modified) - utbuf[1].tv_sec ) * 1e9 ); + } + + 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(fd, utbufp) == 0) + tot++; +#else /* HAS_FUTIMES */ + croak("futimens unimplemented in this platform"); +#endif /* HAS_FUTIMES */ + } + else { +#ifdef HAS_UTIMENSAT + STRLEN len; + char * name = SvPV(file, len); + if (IS_SAFE_PATHNAME(name, len, "utime") && + utimensat(AT_FDCWD, name, utbufp, 0) == 0) + tot++; +#else /* HAS_UTIMENSAT */ + croak("utimensat unimplemented in this platform"); +#endif /* HAS_UTIMENSAT */ + } + } /* while items */ + RETVAL = tot; + + OUTPUT: + RETVAL + +#else /* #if defined(TIME_HIRES_UTIME) */ + +I32 +utime(accessed, modified, ...) + CODE: + croak("Time::HiRes::utime(): unimplemented in this platform"); + RETVAL = 0; + OUTPUT: + RETVAL + +#endif /* #if defined(TIME_HIRES_UTIME) */ + #if defined(TIME_HIRES_CLOCK_GETTIME) NV @@ -1149,7 +1441,7 @@ clock_gettime(clock_id = CLOCK_REALTIME) #else status = clock_gettime(clock_id, &ts); #endif - RETVAL = status == 0 ? ts.tv_sec + (NV) ts.tv_nsec / (NV) 1e9 : -1; + RETVAL = status == 0 ? ts.tv_sec + (NV) ts.tv_nsec / NV_1E9 : -1; OUTPUT: RETVAL @@ -1160,6 +1452,7 @@ NV clock_gettime(clock_id = 0) int clock_id CODE: + PERL_UNUSED_ARG(clock_id); croak("Time::HiRes::clock_gettime(): unimplemented in this platform"); RETVAL = 0.0; OUTPUT: @@ -1181,7 +1474,7 @@ clock_getres(clock_id = CLOCK_REALTIME) #else status = clock_getres(clock_id, &ts); #endif - RETVAL = status == 0 ? ts.tv_sec + (NV) ts.tv_nsec / (NV) 1e9 : -1; + RETVAL = status == 0 ? ts.tv_sec + (NV) ts.tv_nsec / NV_1E9 : -1; OUTPUT: RETVAL @@ -1192,6 +1485,7 @@ NV clock_getres(clock_id = 0) int clock_id CODE: + PERL_UNUSED_ARG(clock_id); croak("Time::HiRes::clock_getres(): unimplemented in this platform"); RETVAL = 0.0; OUTPUT: @@ -1211,18 +1505,11 @@ clock_nanosleep(clock_id, nsec, flags = 0) CODE: if (nsec < 0.0) croak("Time::HiRes::clock_nanosleep(..., %"NVgf"): negative time not invented yet", nsec); - sleepfor.tv_sec = (Time_t)(nsec / 1e9); - sleepfor.tv_nsec = (long)(nsec - ((NV)sleepfor.tv_sec) * 1e9); - if (!clock_nanosleep(clock_id, flags, &sleepfor, &unslept)) { + nanosleep_init(nsec, &sleepfor, &unslept); + if (clock_nanosleep(clock_id, flags, &sleepfor, &unslept) == 0) { RETVAL = nsec; } else { - sleepfor.tv_sec -= unslept.tv_sec; - sleepfor.tv_nsec -= unslept.tv_nsec; - if (sleepfor.tv_nsec < 0) { - sleepfor.tv_sec--; - sleepfor.tv_nsec += 1000000000; - } - RETVAL = ((NV)sleepfor.tv_sec) * 1e9 + ((NV)sleepfor.tv_nsec); + RETVAL = nsec_without_unslept(&sleepfor, &unslept); } OUTPUT: RETVAL @@ -1231,7 +1518,13 @@ clock_nanosleep(clock_id, nsec, flags = 0) NV clock_nanosleep(clock_id, nsec, flags = 0) + int clock_id + NV nsec + int flags CODE: + 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: @@ -1247,7 +1540,7 @@ clock() clock_t clocks; CODE: clocks = clock(); - RETVAL = clocks == -1 ? -1 : (NV)clocks / (NV)CLOCKS_PER_SEC; + RETVAL = clocks == (clock_t) -1 ? (clock_t) -1 : (NV)clocks / (NV)CLOCKS_PER_SEC; OUTPUT: RETVAL @@ -1284,7 +1577,7 @@ PROTOTYPE: ;$ 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(aTHXR); + (void)fakeop.op_ppaddr(aTHX); SPAGAIN; LEAVE; nret = SP+1 - &ST(0); @@ -1297,10 +1590,10 @@ PROTOTYPE: ;$ UV ctime_nsec; hrstatns(&atime_nsec, &mtime_nsec, &ctime_nsec); if (atime_nsec) - ST( 8) = sv_2mortal(newSVnv(atime + 1e-9 * (NV) atime_nsec)); + ST( 8) = sv_2mortal(newSVnv(atime + (NV) atime_nsec / NV_1E9)); if (mtime_nsec) - ST( 9) = sv_2mortal(newSVnv(mtime + 1e-9 * (NV) mtime_nsec)); + ST( 9) = sv_2mortal(newSVnv(mtime + (NV) mtime_nsec / NV_1E9)); if (ctime_nsec) - ST(10) = sv_2mortal(newSVnv(ctime + 1e-9 * (NV) ctime_nsec)); + ST(10) = sv_2mortal(newSVnv(ctime + (NV) ctime_nsec / NV_1E9)); } XSRETURN(nret); diff --git a/gnu/usr.bin/perl/cpan/Time-HiRes/Makefile.PL b/gnu/usr.bin/perl/cpan/Time-HiRes/Makefile.PL index 394cb91b06f..1c1ce1f4dea 100644 --- a/gnu/usr.bin/perl/cpan/Time-HiRes/Makefile.PL +++ b/gnu/usr.bin/perl/cpan/Time-HiRes/Makefile.PL @@ -150,11 +150,13 @@ __EOD__ my $res = system($cccmd); $ok = defined($res) && $res == 0 && -s $tmp_exe && -x _; - if ( $ok && exists $args{run} && $args{run}) { + 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($tmp_exe) == 0) { + if (system(@run) == 0) { $ok = 1; } else { $ok = 0; @@ -352,6 +354,41 @@ int main(int argc, char** argv) EOM } +sub has_futimens { + return 1 if + try_compile_and_link(< +int main(int argc, char** argv) +{ + int ret; + struct timespec ts[2]; + ret = futimens(0, ts); + ret == 0 ? exit(0) : exit(errno ? errno : -1); +} +EOM +} + +sub has_utimensat{ + return 1 if + try_compile_and_link(< +#include +int main(int argc, char** argv) +{ + int ret; + struct timespec ts[2]; + ret = utimensat(AT_FDCWD, 0, ts, 0); + ret == 0 ? exit(0) : exit(errno ? errno : -1); +} +EOM +} + sub DEFINE { my ($def, $val) = @_; my $define = defined $val ? "$def=$val" : $def ; @@ -534,6 +571,7 @@ EOD print "Looking for clock_gettime()... "; my $has_clock_gettime; + my $has_clock_gettime_emulation; if (exists $Config{d_clock_gettime}) { $has_clock_gettime++ if $Config{d_clock_gettime}; # Unlikely... } elsif (has_clock_xxx('gettime')) { @@ -542,11 +580,17 @@ EOD } elsif (defined $SYSCALL_H && has_clock_xxx_syscall('gettime')) { $has_clock_gettime++; $DEFINE .= ' -DTIME_HIRES_CLOCK_GETTIME -DTIME_HIRES_CLOCK_GETTIME_SYSCALL'; + } elsif ($^O eq 'darwin') { + $has_clock_gettime_emulation++; + $has_clock_gettime++; + $DEFINE .= ' -DTIME_HIRES_CLOCK_GETTIME -DTIME_HIRES_CLOCK_GETTIME_EMULATION'; } if ($has_clock_gettime) { if ($DEFINE =~ /-DTIME_HIRES_CLOCK_GETTIME_SYSCALL/) { print "found (via syscall).\n"; + } elsif ($has_clock_gettime_emulation) { + print "found (via emulation).\n"; } else { print "found.\n"; } @@ -556,6 +600,7 @@ EOD print "Looking for clock_getres()... "; my $has_clock_getres; + my $has_clock_getres_emulation; if (exists $Config{d_clock_getres}) { $has_clock_getres++ if $Config{d_clock_getres}; # Unlikely... } elsif (has_clock_xxx('getres')) { @@ -564,11 +609,17 @@ EOD } elsif (defined $SYSCALL_H && has_clock_xxx_syscall('getres')) { $has_clock_getres++; $DEFINE .= ' -DTIME_HIRES_CLOCK_GETRES -DTIME_HIRES_CLOCK_GETRES_SYSCALL'; + } elsif ($^O eq 'darwin') { + $has_clock_getres_emulation++; + $has_clock_getres++; + $DEFINE .= ' -DTIME_HIRES_CLOCK_GETRES -DTIME_HIRES_CLOCK_GETRES_EMULATION'; } if ($has_clock_getres) { if ($DEFINE =~ /-DTIME_HIRES_CLOCK_GETRES_SYSCALL/) { print "found (via syscall).\n"; + } elsif ($has_clock_getres_emulation) { + print "found (via emulation).\n"; } else { print "found.\n"; } @@ -578,15 +629,24 @@ EOD print "Looking for clock_nanosleep()... "; my $has_clock_nanosleep; + my $has_clock_nanosleep_emulation; if (exists $Config{d_clock_nanosleep}) { $has_clock_nanosleep++ if $Config{d_clock_nanosleep}; # Unlikely... } elsif (has_clock_nanosleep()) { $has_clock_nanosleep++; $DEFINE .= ' -DTIME_HIRES_CLOCK_NANOSLEEP'; + } elsif ($^O eq 'darwin') { + $has_clock_nanosleep++; + $has_clock_nanosleep_emulation++; + $DEFINE .= ' -DTIME_HIRES_CLOCK_NANOSLEEP -DTIME_HIRES_CLOCK_NANOSLEEP_EMULATION'; } if ($has_clock_nanosleep) { - print "found.\n"; + if ($has_clock_nanosleep_emulation) { + print "found (via emulation).\n"; + } else { + print "found.\n"; + } } else { print "NOT found.\n"; } @@ -606,6 +666,36 @@ EOD print "NOT found.\n"; } + print "Looking for futimens()... "; + my $has_futimens; + if (has_futimens()) { + $has_futimens++; + $DEFINE .= ' -DHAS_FUTIMENS'; + } + + if ($has_futimens) { + print "found.\n"; + } else { + print "NOT found.\n"; + } + + print "Looking for utimensat()... "; + my $has_utimensat; + if (has_utimensat()) { + $has_utimensat++; + $DEFINE .= ' -DHAS_UTIMENSAT'; + } + + if ($has_utimensat) { + print "found.\n"; + } else { + print "NOT found.\n"; + } + + if ($has_futimens or $has_utimensat) { + $DEFINE .= ' -DTIME_HIRES_UTIME'; + } + print "Looking for stat() subsecond timestamps...\n"; print "Trying struct stat st_atimespec.tv_nsec..."; @@ -619,7 +709,7 @@ int main(int argc, char** argv) { } EOM $has_stat_st_xtimespec++; - DEFINE('TIME_HIRES_STAT', 1); + DEFINE('TIME_HIRES_STAT_ST_XTIMESPEC'); # 1 } if ($has_stat_st_xtimespec) { @@ -639,7 +729,7 @@ int main(int argc, char** argv) { } EOM $has_stat_st_xtimensec++; - DEFINE('TIME_HIRES_STAT', 2); + DEFINE('TIME_HIRES_STAT_ST_XTIMENSEC'); # 2 } if ($has_stat_st_xtimensec) { @@ -659,7 +749,7 @@ int main(int argc, char** argv) { } EOM $has_stat_st_xtime_n++; - DEFINE('TIME_HIRES_STAT', 3); + DEFINE('TIME_HIRES_STAT_ST_XTIME_N'); # 3 } if ($has_stat_st_xtime_n) { @@ -679,7 +769,7 @@ int main(int argc, char** argv) { } EOM $has_stat_st_xtim++; - DEFINE('TIME_HIRES_STAT', 4); + DEFINE('TIME_HIRES_STAT_XTIM'); # 4 } if ($has_stat_st_xtim) { @@ -699,7 +789,7 @@ int main(int argc, char** argv) { } EOM $has_stat_st_uxtime++; - DEFINE('TIME_HIRES_STAT', 5); + DEFINE('TIME_HIRES_STAT_ST_UXTIME'); # 5 } if ($has_stat_st_uxtime) { @@ -708,6 +798,19 @@ EOM print "NOT found.\n"; } + # See HiRes.xs hrstatns() + if ($has_stat_st_xtimespec) { + DEFINE('TIME_HIRES_STAT', 1); + } elsif ($has_stat_st_xtimensec) { + DEFINE('TIME_HIRES_STAT', 2); + } elsif ($has_stat_st_xtime_n) { + DEFINE('TIME_HIRES_STAT', 3); + } elsif ($has_stat_st_xtim) { + DEFINE('TIME_HIRES_STAT', 4); + } elsif ($has_stat_st_uxtime) { + DEFINE('TIME_HIRES_STAT', 5); + } + if ($DEFINE =~ /-DTIME_HIRES_STAT=\d+/) { print "You seem to have stat() subsecond timestamps.\n"; print "(Your struct stat has them, but the filesystems must help.)\n"; @@ -766,7 +869,7 @@ sub doMakefile { 'DynaLoader' => 0, 'Exporter' => 0, 'ExtUtils::MakeMaker' => 0, - 'Test::More' => "0.82", + 'Test::More' => 0, 'strict' => 0, }, 'dist' => { @@ -803,26 +906,51 @@ sub doMakefile { push @makefileopts, MAN3PODS => {}; } + if ($ExtUtils::MakeMaker::VERSION >= 6.48) { + push @makefileopts, (MIN_PERL_VERSION => '5.008',); + } + + if ($ExtUtils::MakeMaker::VERSION >= 6.31) { + push @makefileopts, (LICENSE => 'perl_5'); + } + WriteMakefile(@makefileopts); } sub doConstants { if (eval {require ExtUtils::Constant; 1}) { - my @names = qw(CLOCK_HIGHRES CLOCK_MONOTONIC - CLOCK_PROCESS_CPUTIME_ID - CLOCK_REALTIME - CLOCK_SOFTTIME - CLOCK_THREAD_CPUTIME_ID - CLOCK_TIMEOFDAY - CLOCKS_PER_SEC - ITIMER_REAL ITIMER_VIRTUAL ITIMER_PROF - ITIMER_REALPROF - TIMER_ABSTIME); + my @names = qw( + CLOCKS_PER_SEC + CLOCK_BOOTTIME + CLOCK_HIGHRES + CLOCK_MONOTONIC + CLOCK_MONOTONIC_COARSE + CLOCK_MONOTONIC_PRECISE + CLOCK_MONOTONIC_RAW + CLOCK_PROCESS_CPUTIME_ID + CLOCK_REALTIME + CLOCK_REALTIME_COARSE + CLOCK_REALTIME_FAST + CLOCK_REALTIME_PRECISE + CLOCK_SECOND + CLOCK_SOFTTIME + CLOCK_THREAD_CPUTIME_ID + CLOCK_TIMEOFDAY + CLOCK_UPTIME + CLOCK_UPTIME_FAST + CLOCK_UPTIME_PRECISE + 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)) { + d_clock d_clock_nanosleep d_hires_stat + d_futimens d_utimensat d_hires_utime)) { my $macro = $_; - if ($macro =~ /^(d_nanosleep|d_clock_gettime|d_clock_getres|d_clock|d_clock_nanosleep)$/) { + if ($macro =~ /^(d_nanosleep|d_clock)$/) { $macro =~ s/^d_(.+)/TIME_HIRES_\U$1/; } elsif ($macro =~ /^(d_hires_stat)$/) { my $d_hires_stat = 0; @@ -830,6 +958,19 @@ sub doConstants { 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/) ? 1 : 0; + 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/; } diff --git a/gnu/usr.bin/perl/cpan/Time-HiRes/fallback/const-c.inc b/gnu/usr.bin/perl/cpan/Time-HiRes/fallback/const-c.inc index a8626172af5..524db169a9f 100644 --- a/gnu/usr.bin/perl/cpan/Time-HiRes/fallback/const-c.inc +++ b/gnu/usr.bin/perl/cpan/Time-HiRes/fallback/const-c.inc @@ -19,6 +19,7 @@ typedef double NV; /* 5.6 and later define NVTYPE, and typedef NV to it. */ #ifndef pTHX_ #define pTHX_ /* 5.6 or later define this for threading support. */ #endif + static int constant_11 (pTHX_ const char *name, IV *iv_return) { /* When generated this function returned values for the list of names given @@ -86,6 +87,51 @@ constant_11 (pTHX_ const char *name, IV *iv_return) { return PERL_constant_NOTFOUND; } +static int +constant_13 (pTHX_ const char *name, IV *iv_return) { + /* When generated this function returned values for the list of names given + here. However, subsequent manual editing may have added or removed some. + CLOCK_HIGHRES TIMER_ABSTIME d_hires_utime */ + /* Offset 1 gives the best switch position. */ + switch (name[1]) { + case 'I': + if (memEQ(name, "TIMER_ABSTIME", 13)) { + /* ^ */ +#ifdef TIMER_ABSTIME + *iv_return = TIMER_ABSTIME; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'L': + if (memEQ(name, "CLOCK_HIGHRES", 13)) { + /* ^ */ +#ifdef CLOCK_HIGHRES + *iv_return = CLOCK_HIGHRES; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case '_': + if (memEQ(name, "d_hires_utime", 13)) { + /* ^ */ +#ifdef TIME_HIRES_UTIME + *iv_return = 1; + return PERL_constant_ISIV; +#else + *iv_return = 0; + return PERL_constant_ISIV; +#endif + } + break; + } + return PERL_constant_NOTFOUND; +} + static int constant_14 (pTHX_ const char *name, IV *iv_return) { /* When generated this function returned values for the list of names given @@ -250,16 +296,17 @@ my @names = (qw(CLOCKS_PER_SEC CLOCK_HIGHRES CLOCK_MONOTONIC {name=>"d_getitimer", type=>"IV", macro=>"HAS_GETITIMER", value=>"1", default=>["IV", "0"]}, {name=>"d_gettimeofday", type=>"IV", macro=>"HAS_GETTIMEOFDAY", value=>"1", default=>["IV", "0"]}, {name=>"d_hires_stat", type=>"IV", macro=>"TIME_HIRES_STAT", value=>"1", default=>["IV", "0"]}, + {name=>"d_hires_utime", type=>"IV", macro=>"TIME_HIRES_UTIME", value=>"1", default=>["IV", "0"]}, {name=>"d_nanosleep", type=>"IV", macro=>"TIME_HIRES_NANOSLEEP", value=>"1", default=>["IV", "0"]}, {name=>"d_setitimer", type=>"IV", macro=>"HAS_SETITIMER", value=>"1", default=>["IV", "0"]}, {name=>"d_ualarm", type=>"IV", macro=>"HAS_UALARM", value=>"1", default=>["IV", "0"]}, {name=>"d_usleep", type=>"IV", macro=>"HAS_USLEEP", value=>"1", default=>["IV", "0"]}); -print constant_types(); # macro defs +print constant_types(), "\n"; # macro defs foreach (C_constant ("Time::HiRes", 'constant', 'IV', $types, undef, 3, @names) ) { print $_, "\n"; # C constant subs } -print "#### XS Section:\n"; +print "\n#### XS Section:\n"; print XS_constant ("Time::HiRes", $types); __END__ */ @@ -322,33 +369,7 @@ __END__ } break; case 13: - /* Names all of length 13. */ - /* CLOCK_HIGHRES TIMER_ABSTIME */ - /* Offset 2 gives the best switch position. */ - switch (name[2]) { - case 'M': - if (memEQ(name, "TIMER_ABSTIME", 13)) { - /* ^ */ -#ifdef TIMER_ABSTIME - *iv_return = TIMER_ABSTIME; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'O': - if (memEQ(name, "CLOCK_HIGHRES", 13)) { - /* ^ */ -#ifdef CLOCK_HIGHRES - *iv_return = CLOCK_HIGHRES; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - } + return constant_13 (aTHX_ name, iv_return); break; case 14: return constant_14 (aTHX_ name, iv_return); diff --git a/gnu/usr.bin/perl/cpan/Time-HiRes/t/Watchdog.pm b/gnu/usr.bin/perl/cpan/Time-HiRes/t/Watchdog.pm index 83e854396fd..44ec8081dea 100644 --- a/gnu/usr.bin/perl/cpan/Time-HiRes/t/Watchdog.pm +++ b/gnu/usr.bin/perl/cpan/Time-HiRes/t/Watchdog.pm @@ -10,44 +10,44 @@ my $watchdog_pid; my $TheEnd; if ($Config{d_fork}) { - note "I am the main process $$, starting the watchdog process..."; + print("# I am the main process $$, starting the watchdog process...\n"); $watchdog_pid = fork(); if (defined $watchdog_pid) { if ($watchdog_pid == 0) { # We are the kid, set up the watchdog. my $ppid = getppid(); - note "I am the watchdog process $$, sleeping for $waitfor seconds..."; + print("# I am the watchdog process $$, sleeping for $waitfor seconds...\n"); sleep($waitfor - 2); # Workaround for perlbug #49073 sleep(2); # Wait for parent to exit if (kill(0, $ppid)) { # Check if parent still exists warn "\n$0: overall time allowed for tests (${waitfor}s) exceeded!\n"; - note "Terminating main process $ppid..."; + print("Terminating main process $ppid...\n"); kill('KILL', $ppid); - note "This is the watchdog process $$, over and out."; + print("# This is the watchdog process $$, over and out.\n"); } exit(0); } else { - note "The watchdog process $watchdog_pid launched, continuing testing..."; + print("# The watchdog process $watchdog_pid launched, continuing testing...\n"); $TheEnd = time() + $waitfor; } } else { warn "$0: fork failed: $!\n"; } } else { - note "No watchdog process (need fork)"; + print("# No watchdog process (need fork)\n"); } END { if ($watchdog_pid) { # Only in the main process. my $left = $TheEnd - time(); - note sprintf "I am the main process $$, terminating the watchdog process $watchdog_pid before it terminates me in %d seconds (testing took %d seconds).", $left, $waitfor - $left; + printf("# I am the main process $$, terminating the watchdog process $watchdog_pid before it terminates me in %d seconds (testing took %d seconds).\n", $left, $waitfor - $left); if (kill(0, $watchdog_pid)) { local $? = 0; my $kill = kill('KILL', $watchdog_pid); # We are done, the watchdog can go. wait(); - note sprintf "kill KILL $watchdog_pid = %d", $kill; + printf("# kill KILL $watchdog_pid = %d\n", $kill); } unlink("ktrace.out"); # Used in BSD system call tracing. - note "All done."; + print("# All done.\n"); } } diff --git a/gnu/usr.bin/perl/cpan/Time-HiRes/t/alarm.t b/gnu/usr.bin/perl/cpan/Time-HiRes/t/alarm.t index 841694f67c2..f600f99256c 100644 --- a/gnu/usr.bin/perl/cpan/Time-HiRes/t/alarm.t +++ b/gnu/usr.bin/perl/cpan/Time-HiRes/t/alarm.t @@ -1,6 +1,6 @@ use strict; -use Test::More 0.82 tests => 10; +use Test::More tests => 10; use t::Watchdog; BEGIN { require_ok "Time::HiRes"; } @@ -29,12 +29,14 @@ SKIP: { my ($r, $i, $not, $ok); + $not = ""; + $r = [Time::HiRes::gettimeofday()]; $i = 5; my $oldaction; if ($use_sigaction) { $oldaction = new POSIX::SigAction; - note sprintf "sigaction tick, ALRM = %d", &POSIX::SIGALRM; + 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. @@ -44,7 +46,7 @@ SKIP: { $oldaction) or die "Error setting SIGALRM handler with sigaction: $!\n"; } else { - note "SIG tick"; + print("# SIG tick\n"); $SIG{ALRM} = "tick"; } @@ -56,8 +58,8 @@ SKIP: { Time::HiRes::alarm(0.3); select (undef, undef, undef, 3); my $ival = Time::HiRes::tv_interval ($r); - note "Select returned! $i $ival"; - note abs($ival/3 - 1); + 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 @@ -86,7 +88,7 @@ SKIP: { sub tick { $i--; my $ival = Time::HiRes::tv_interval ($r); - note "Tick! $i $ival"; + print("# Tick! $i $ival\n"); my $exp = 0.3 * (5 - $i); if ($exp == 0) { $not = "tick: divisor became zero"; @@ -106,8 +108,8 @@ SKIP: { Time::HiRes::alarm(0); # can't cancel usig %SIG } + print("# $not\n"); ok !$not; - note $not || $ok; } SKIP: { @@ -126,7 +128,7 @@ SKIP: { # http://groups.google.com/group/perl.perl5.porters/browse_thread/thread/adaffaaf939b042e/20dafc298df737f0%2320dafc298df737f0?sa=X&oi=groupsr&start=0&num=3 # Perl changes [18765] and [18770], perl bug [perl #20920] - note "Finding delay loop..."; + print("# Finding delay loop...\n"); my $T = 0.01; my $DelayN = 1024; @@ -137,7 +139,7 @@ SKIP: { for ($i = 0; $i < $DelayN; $i++) { } my $t1 = Time::HiRes::time(); my $dt = $t1 - $t0; - note "N = $DelayN, t1 = $t1, t0 = $t0, dt = $dt"; + print("# N = $DelayN, t1 = $t1, t0 = $t0, dt = $dt\n"); last N if $dt > $T; $DelayN *= 2; } while (1); @@ -169,7 +171,7 @@ SKIP: { $SIG{ALRM} = sub { $a++; - note "Alarm $a - ", Time::HiRes::time(); + 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. }; @@ -204,18 +206,18 @@ SKIP: { my $alrm = 0; $SIG{ALRM} = sub { $alrm++ }; my $got = Time::HiRes::alarm(2.7); - ok $got == 0 or note $got; + ok $got == 0 or print("# $got\n"); my $t0 = Time::HiRes::time(); 1 while Time::HiRes::time() - $t0 <= 1; $got = Time::HiRes::alarm(0); - ok $got > 0 && $got < 1.8 or note $got; + ok $got > 0 && $got < 1.8 or print("# $got\n"); - ok $alrm == 0 or note $alrm; + ok $alrm == 0 or print("# $alrm\n"); $got = Time::HiRes::alarm(0); - ok $got == 0 or note $got; + ok $got == 0 or print("# $got\n"); } } diff --git a/gnu/usr.bin/perl/cpan/Time-HiRes/t/clock.t b/gnu/usr.bin/perl/cpan/Time-HiRes/t/clock.t index 6d11dd2ca0a..346ca57fbf5 100644 --- a/gnu/usr.bin/perl/cpan/Time-HiRes/t/clock.t +++ b/gnu/usr.bin/perl/cpan/Time-HiRes/t/clock.t @@ -1,6 +1,6 @@ use strict; -use Test::More 0.82 tests => 5; +use Test::More tests => 5; use t::Watchdog; BEGIN { require_ok "Time::HiRes"; } @@ -13,10 +13,10 @@ sub has_symbol { return $@ eq ''; } -note sprintf "have_clock_gettime = %d", &Time::HiRes::d_clock_gettime; -note sprintf "have_clock_getres = %d", &Time::HiRes::d_clock_getres; -note sprintf "have_clock_nanosleep = %d", &Time::HiRes::d_clock_nanosleep; -note sprintf "have_clock = %d", &Time::HiRes::d_clock; +printf("# have_clock_gettime = %d\n", &Time::HiRes::d_clock_gettime); +printf("# have_clock_getres = %d\n", &Time::HiRes::d_clock_getres); +printf("# have_clock_nanosleep = %d\n", &Time::HiRes::d_clock_nanosleep); +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 @@ -36,25 +36,25 @@ SKIP: { my $ok = 0; TRY: { for my $try (1..3) { - note "CLOCK_REALTIME: try = $try"; + 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) { - note "t1 = $t1, t0 = $t0"; + print("# t1 = $t1, t0 = $t0\n"); my $dt = $t1 - $t0; my $rt = abs(1 - $dt / $T); - note "dt = $dt, rt = $rt"; + print("# dt = $dt, rt = $rt\n"); if ($rt <= 2 * $limit) { $ok = 1; last TRY; } } else { - note "Error: t0 = $t0, t1 = $t1"; + print("# Error: t0 = $t0, t1 = $t1\n"); } my $r = rand() + rand(); - note sprintf "Sleeping for %.6f seconds...\n", $r; + printf("# Sleeping for %.6f seconds...\n", $r); Time::HiRes::sleep($r); } } @@ -64,7 +64,7 @@ SKIP: { SKIP: { skip "no clock_getres", 1 unless &Time::HiRes::d_clock_getres; my $tr = Time::HiRes::clock_getres(); - ok $tr > 0 or note "tr = $tr"; + ok $tr > 0 or print("# tr = $tr\n"); } SKIP: { @@ -73,17 +73,17 @@ SKIP: { my $s = 1.5e9; my $t = Time::HiRes::clock_nanosleep(&CLOCK_REALTIME, $s); my $r = abs(1 - $t / $s); - ok $r < 2 * $limit or note "t = $t, r = $r"; + ok $r < 2 * $limit or print("# t = $t, r = $r\n"); } SKIP: { skip "no clock", 1 unless &Time::HiRes::d_clock; my @clock = Time::HiRes::clock(); - note "clock = @clock"; + print("# clock = @clock\n"); for my $i (1..3) { for (my $j = 0; $j < 1e6; $j++) { } push @clock, Time::HiRes::clock(); - note "clock = @clock"; + print("# clock = @clock\n"); } ok $clock[0] >= 0 && $clock[1] > $clock[0] && diff --git a/gnu/usr.bin/perl/cpan/Time-HiRes/t/gettimeofday.t b/gnu/usr.bin/perl/cpan/Time-HiRes/t/gettimeofday.t index 8f7c5f3039a..69defe8672e 100644 --- a/gnu/usr.bin/perl/cpan/Time-HiRes/t/gettimeofday.t +++ b/gnu/usr.bin/perl/cpan/Time-HiRes/t/gettimeofday.t @@ -8,26 +8,26 @@ BEGIN { } } -use Test::More 0.82 tests => 6; +use Test::More tests => 6; use t::Watchdog; my @one = Time::HiRes::gettimeofday(); -note 'gettimeofday returned ', 0+@one, ' args'; +printf("# gettimeofday returned %d args\n", 0+@one); ok @one == 2; -ok $one[0] > 850_000_000 or note "@one too small"; +ok $one[0] > 850_000_000 or print("# @one too small\n"); sleep 1; my @two = Time::HiRes::gettimeofday(); ok $two[0] > $one[0] || ($two[0] == $one[0] && $two[1] > $one[1]) - or note "@two is not greater than @one"; + or print("# @two is not greater than @one\n"); my $f = Time::HiRes::time(); -ok $f > 850_000_000 or note "$f too small"; -ok $f - $two[0] < 2 or note "$f - $two[0] >= 2"; +ok $f > 850_000_000 or print("# $f too small\n"); +ok $f - $two[0] < 2 or print("# $f - $two[0] >= 2\n"); my $r = [Time::HiRes::gettimeofday()]; my $g = Time::HiRes::tv_interval $r; -ok $g < 2 or note $g; +ok $g < 2 or print("# $g\n"); 1; diff --git a/gnu/usr.bin/perl/cpan/Time-HiRes/t/itimer.t b/gnu/usr.bin/perl/cpan/Time-HiRes/t/itimer.t index a9ef80d0a43..31cdd674ae7 100644 --- a/gnu/usr.bin/perl/cpan/Time-HiRes/t/itimer.t +++ b/gnu/usr.bin/perl/cpan/Time-HiRes/t/itimer.t @@ -25,7 +25,7 @@ BEGIN { } } -use Test::More 0.82 tests => 2; +use Test::More tests => 2; use t::Watchdog; my $limit = 0.25; # 25% is acceptable slosh for testing timers @@ -35,29 +35,32 @@ my $r = [Time::HiRes::gettimeofday()]; $SIG{VTALRM} = sub { $i ? $i-- : Time::HiRes::setitimer(&Time::HiRes::ITIMER_VIRTUAL, 0); - note "Tick! $i ", Time::HiRes::tv_interval($r); + printf("# Tick! $i %s\n", Time::HiRes::tv_interval($r)); }; -note "setitimer: ", join(" ", - Time::HiRes::setitimer(&Time::HiRes::ITIMER_VIRTUAL, 0.5, 0.4)); +printf("# setitimer: %s\n", join(" ", + Time::HiRes::setitimer(&Time::HiRes::ITIMER_VIRTUAL, 0.5, 0.4))); # Assume interval timer granularity of $limit * 0.5 seconds. Too bold? my $virt = Time::HiRes::getitimer(&Time::HiRes::ITIMER_VIRTUAL); -ok defined $virt && abs($virt / 0.5) - 1 < $limit; +ok(defined $virt && abs($virt / 0.5) - 1 < $limit, + "ITIMER_VIRTUAL defined with sufficient granularity") + or diag "virt=" . (defined $virt ? $virt : 'undef'); -note "getitimer: ", join(" ", - Time::HiRes::getitimer(&Time::HiRes::ITIMER_VIRTUAL)); +printf("# getitimer: %s\n", join(" ", + Time::HiRes::getitimer(&Time::HiRes::ITIMER_VIRTUAL))); while (Time::HiRes::getitimer(&Time::HiRes::ITIMER_VIRTUAL)) { my $j; for (1..1000) { $j++ } # Can't be unbreakable, must test getitimer(). } -note "getitimer: ", join(" ", - Time::HiRes::getitimer(&Time::HiRes::ITIMER_VIRTUAL)); +printf("# getitimer: %s\n", join(" ", + Time::HiRes::getitimer(&Time::HiRes::ITIMER_VIRTUAL))); $virt = Time::HiRes::getitimer(&Time::HiRes::ITIMER_VIRTUAL); -ok defined $virt && $virt == 0; +print("# at end, i=$i\n"); +is($virt, 0, "time left should be zero"); $SIG{VTALRM} = 'DEFAULT'; diff --git a/gnu/usr.bin/perl/cpan/Time-HiRes/t/nanosleep.t b/gnu/usr.bin/perl/cpan/Time-HiRes/t/nanosleep.t index aef9db6163c..c17a7e4790e 100644 --- a/gnu/usr.bin/perl/cpan/Time-HiRes/t/nanosleep.t +++ b/gnu/usr.bin/perl/cpan/Time-HiRes/t/nanosleep.t @@ -8,7 +8,7 @@ BEGIN { } } -use Test::More 0.82 tests => 3; +use Test::More tests => 3; use t::Watchdog; eval { Time::HiRes::nanosleep(-5) }; @@ -21,7 +21,7 @@ my $two = CORE::time; Time::HiRes::nanosleep(10_000_000); my $three = CORE::time; ok $one == $two || $two == $three - or note "slept too long, $one $two $three"; + or print("# slept too long, $one $two $three\n"); SKIP: { skip "no gettimeofday", 1 unless &Time::HiRes::d_gettimeofday; @@ -29,7 +29,7 @@ SKIP: { Time::HiRes::nanosleep(500_000_000); my $f2 = Time::HiRes::time(); my $d = $f2 - $f; - ok $d > 0.4 && $d < 0.9 or note "slept $d secs $f to $f2"; + ok $d > 0.4 && $d < 0.9 or print("# slept $d secs $f to $f2\n"); } 1; diff --git a/gnu/usr.bin/perl/cpan/Time-HiRes/t/sleep.t b/gnu/usr.bin/perl/cpan/Time-HiRes/t/sleep.t index e7cc6271a89..c4d802be402 100644 --- a/gnu/usr.bin/perl/cpan/Time-HiRes/t/sleep.t +++ b/gnu/usr.bin/perl/cpan/Time-HiRes/t/sleep.t @@ -1,6 +1,6 @@ use strict; -use Test::More 0.82 tests => 4; +use Test::More tests => 4; use t::Watchdog; BEGIN { require_ok "Time::HiRes"; } @@ -26,12 +26,12 @@ like $@, qr/::sleep\(-1\): negative time not invented yet/, SKIP: { skip "no subsecond alarm", 2 unless $can_subsecond_alarm; my $f = Time::HiRes::time; - note "time...$f"; + print("# time...$f\n"); ok 1; my $r = [Time::HiRes::gettimeofday()]; Time::HiRes::sleep (0.5); - note "sleep...", Time::HiRes::tv_interval($r); + printf("# sleep...%s\n", Time::HiRes::tv_interval($r)); ok 1; } diff --git a/gnu/usr.bin/perl/cpan/Time-HiRes/t/stat.t b/gnu/usr.bin/perl/cpan/Time-HiRes/t/stat.t index eca9da12e36..e7552b5e256 100644 --- a/gnu/usr.bin/perl/cpan/Time-HiRes/t/stat.t +++ b/gnu/usr.bin/perl/cpan/Time-HiRes/t/stat.t @@ -13,11 +13,9 @@ BEGIN { } } -use Test::More 0.82 tests => 43; +use Test::More tests => 43; use t::Watchdog; -my $limit = 0.25; # 25% is acceptable slosh for testing timers - my @atime; my @mtime; for (1..5) { @@ -44,8 +42,8 @@ for (1..5) { is_deeply $lstat, $stat; } 1 while unlink $$; -note "mtime = @mtime"; -note "atime = @atime"; +print("# mtime = @mtime\n"); +print("# atime = @atime\n"); my $ai = 0; my $mi = 0; my $ss = 0; @@ -65,7 +63,7 @@ for (my $i = 1; $i < @mtime; $i++) { $ss++; } } -note "ai = $ai, mi = $mi, ss = $ss"; +print("# ai = $ai, mi = $mi, ss = $ss\n"); # Need at least 75% of monotonical increase and # 20% of subsecond results. Yes, this is guessing. SKIP: { diff --git a/gnu/usr.bin/perl/cpan/Time-HiRes/t/time.t b/gnu/usr.bin/perl/cpan/Time-HiRes/t/time.t index feec4799d90..6f219f9e0c4 100644 --- a/gnu/usr.bin/perl/cpan/Time-HiRes/t/time.t +++ b/gnu/usr.bin/perl/cpan/Time-HiRes/t/time.t @@ -1,6 +1,6 @@ use strict; -use Test::More 0.82 tests => 2; +use Test::More tests => 2; use t::Watchdog; BEGIN { require_ok "Time::HiRes"; } @@ -16,8 +16,8 @@ SKIP: { # (CORE::time() may be rounding down, up, or closest), # but allow 10% of slop. ok abs($s) / $n <= 1.10 - or note "Time::HiRes::time() not close to CORE::time()"; - note "s = $s, n = $n, s/n = ", abs($s)/$n; + or print("# Time::HiRes::time() not close to CORE::time()\n"); + printf("# s = $s, n = $n, s/n = %s\n", abs($s)/$n); } 1; diff --git a/gnu/usr.bin/perl/cpan/Time-HiRes/t/tv_interval.t b/gnu/usr.bin/perl/cpan/Time-HiRes/t/tv_interval.t index bffcf39ec10..8ac876daf3a 100644 --- a/gnu/usr.bin/perl/cpan/Time-HiRes/t/tv_interval.t +++ b/gnu/usr.bin/perl/cpan/Time-HiRes/t/tv_interval.t @@ -1,10 +1,10 @@ use strict; -use Test::More 0.82 tests => 2; +use Test::More tests => 2; BEGIN { require_ok "Time::HiRes"; } my $f = Time::HiRes::tv_interval [5, 100_000], [10, 500_000]; -ok abs($f - 5.4) < 0.001 or note $f; +ok abs($f - 5.4) < 0.001 or print("# $f\n"); 1; diff --git a/gnu/usr.bin/perl/cpan/Time-HiRes/t/ualarm.t b/gnu/usr.bin/perl/cpan/Time-HiRes/t/ualarm.t index 12ef4b52cc5..b50a175f449 100644 --- a/gnu/usr.bin/perl/cpan/Time-HiRes/t/ualarm.t +++ b/gnu/usr.bin/perl/cpan/Time-HiRes/t/ualarm.t @@ -8,7 +8,7 @@ BEGIN { } } -use Test::More 0.82 tests => 12; +use Test::More tests => 12; use t::Watchdog; use Config; @@ -24,13 +24,13 @@ SKIP: { $tick = 0; Time::HiRes::ualarm(10_000); while ($tick == 0) { } my $three = CORE::time; ok $one == $two || $two == $three - or note "slept too long, $one $two $three"; - note "tick = $tick, one = $one, two = $two, three = $three"; + 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) { } ok 1; Time::HiRes::ualarm(0); - note "tick = $tick, one = $one, two = $two, three = $three"; + print("# tick = $tick, one = $one, two = $two, three = $three\n"); } eval { Time::HiRes::ualarm(-4) }; @@ -59,24 +59,24 @@ for my $n (100_000, 1_100_000, 2_200_000, 4_300_000) { my $alarmed = 0; local $SIG{ ALRM } = sub { $alarmed++ }; my $t0 = Time::HiRes::time(); - note "t0 = $t0"; - note "ualarm($n)"; + print("# t0 = $t0\n"); + print("# ualarm($n)\n"); Time::HiRes::ualarm($n); 1 while $alarmed == 0; my $t1 = Time::HiRes::time(); - note "t1 = $t1"; + print("# t1 = $t1\n"); my $dt = $t1 - $t0; - note "dt = $dt"; + print("# dt = $dt\n"); my $r = $dt / ($n/1e6); - note "r = $r"; + 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); - note sprintf "Retrying in %.1f seconds...\n", $nap; + printf("# Retrying in %.1f seconds...\n", $nap); Time::HiRes::sleep($nap); } - ok $ok or note "ualarm($n) close enough"; + ok $ok or print("# ualarm($n) close enough\n"); } { @@ -93,12 +93,12 @@ for my $n (100_000, 1_100_000, 2_200_000, 4_300_000) { } while $t1 - $t0 <= 0.3; my $got1 = Time::HiRes::ualarm(0); - note "t0 = $t0"; - note "got0 = $got0"; - note "t1 = $t1"; - note "t1 - t0 = ", ($t1 - $t0); - note "got1 = $got1"; - ok $got0 == 0 or note $got0; + print("# t0 = $t0\n"); + print("# got0 = $got0\n"); + print("# t1 = $t1\n"); + printf("# t1 - t0 = %s\n", ($t1 - $t0)); + 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; @@ -106,7 +106,7 @@ for my $n (100_000, 1_100_000, 2_200_000, 4_300_000) { } ok $got1 < 300_000; my $got2 = Time::HiRes::ualarm(0); - ok $got2 == 0 or note $got2; + ok $got2 == 0 or print("# $got2\n"); } 1; diff --git a/gnu/usr.bin/perl/cpan/Time-HiRes/t/usleep.t b/gnu/usr.bin/perl/cpan/Time-HiRes/t/usleep.t index 0d6bacfac34..bdf372bd163 100644 --- a/gnu/usr.bin/perl/cpan/Time-HiRes/t/usleep.t +++ b/gnu/usr.bin/perl/cpan/Time-HiRes/t/usleep.t @@ -8,7 +8,7 @@ BEGIN { } } -use Test::More 0.82 tests => 6; +use Test::More tests => 6; use t::Watchdog; eval { Time::HiRes::usleep(-2) }; @@ -23,7 +23,7 @@ my $two = CORE::time; Time::HiRes::usleep(10_000); my $three = CORE::time; ok $one == $two || $two == $three -or note "slept too long, $one $two $three"; +or print("# slept too long, $one $two $three\n"); SKIP: { skip "no gettimeofday", 1 unless &Time::HiRes::d_gettimeofday; @@ -31,7 +31,7 @@ SKIP: { Time::HiRes::usleep(500_000); my $f2 = Time::HiRes::time(); my $d = $f2 - $f; - ok $d > 0.4 && $d < 0.9 or note "slept $d secs $f to $f2"; + ok $d > 0.4 && $d < 0.9 or print("# slept $d secs $f to $f2\n"); } SKIP: { @@ -39,7 +39,7 @@ SKIP: { my $r = [ Time::HiRes::gettimeofday() ]; Time::HiRes::sleep( 0.5 ); my $f = Time::HiRes::tv_interval $r; - ok $f > 0.4 && $f < 0.9 or note "slept $f instead of 0.5 secs."; + ok $f > 0.4 && $f < 0.9 or print("# slept $f instead of 0.5 secs.\n"); } SKIP: { @@ -59,7 +59,7 @@ SKIP: { SKIP: { skip $msg, 1 unless $td < $sleep * (1 + $limit); - ok $a < $limit or note $msg; + ok $a < $limit or print("# $msg\n"); } $t0 = Time::HiRes::gettimeofday(); @@ -71,7 +71,7 @@ SKIP: { SKIP: { skip $msg, 1 unless $td < $sleep * (1 + $limit); - ok $a < $limit or note $msg; + ok $a < $limit or print("# $msg\n"); } } diff --git a/gnu/usr.bin/perl/cpan/Time-HiRes/t/utime.t b/gnu/usr.bin/perl/cpan/Time-HiRes/t/utime.t new file mode 100644 index 00000000000..ede2e78f85b --- /dev/null +++ b/gnu/usr.bin/perl/cpan/Time-HiRes/t/utime.t @@ -0,0 +1,101 @@ +use strict; + +BEGIN { + require Time::HiRes; + require Test::More; + unless(&Time::HiRes::d_hires_utime) { + Test::More::plan(skip_all => "no hires_utime"); + } + unless (&Time::HiRes::d_futimens) { + Test::More::plan(skip_all => "no futimens()"); + } + unless (&Time::HiRes::d_utimensat) { + Test::More::plan(skip_all => "no utimensat()"); + } + if ($^O eq 'gnukfreebsd') { + Test::More::plan(skip_all => "futimens() and utimensat() not working in $^O"); + } +} + +use Test::More tests => 18; +use t::Watchdog; +use File::Temp qw( tempfile ); + +use Config; + +# Cygwin timestamps have less precision. +my $atime = $^O eq 'cygwin' ? 1.1111111 : 1.111111111; +my $mtime = $^O eq 'cygwin' ? 2.2222222 : 2.222222222; + +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]; + 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]; + is $got_atime, $atime, "atime set correctly"; + is $got_mtime, $mtime, "mtime set correctly"; +}; + +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]; + 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]; + 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; + is Time::HiRes::utime(undef, undef, $filename1, $fh2), 2, "Two files changed"; + + { + my ($got_atime, $got_mtime) = ( Time::HiRes::stat($fh1) )[8, 9]; + cmp_ok abs( $got_atime - $now), '<', 0.1, "File 1 atime set correctly"; + cmp_ok abs( $got_mtime - $now), '<', 0.1, "File 1 mtime set correctly"; + } + { + my ($got_atime, $got_mtime) = ( Time::HiRes::stat($filename2) )[8, 9]; + cmp_ok abs( $got_atime - $now), '<', 0.1, "File 2 atime set correctly"; + cmp_ok abs( $got_mtime - $now), '<', 0.1, "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"; +}; + +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"; +}; + +done_testing; + +1;