view release on metacpan or  search on metacpan

t/mungers-datetime-fast.t  view on Meta::CPAN

#!perl
# The datetime fast path (compiled regex + integer date math) must be
# value-identical to the strptime path for every part, and the one-slot memo
# must never serve a stale result.
use 5.006;
use strict;
use warnings;
use Test::More;

BEGIN {
	eval { require Time::Piece; 1 }
		or plan skip_all => 'Time::Piece not available';
}

use Algorithm::ToNumberMunger;
my $M = 'Algorithm::ToNumberMunger';

my $FMT = '%Y-%m-%dT%H:%M:%S';    # fast-eligible: all six numeric codes

my @PARTS = qw(epoch year mon mday hour min sec wday yday
	frac_day frac_week sin_day cos_day sin_week cos_week);

# Stamps chosen to poke the arithmetic: epoch origin, leap day, year edges,
# pre-1970 (negative epoch days), and an ordinary modern stamp.
my @STAMPS = qw(
	1970-01-01T00:00:00
	1969-12-31T23:59:59
	2000-02-29T23:59:59
	1999-12-31T00:00:00
	2024-03-01T00:00:01
	2026-07-05T13:37:42
);

# ---- fast == strptime for every part on every stamp ------------------------
for my $part (@PARTS) {
	my $fast = $M->build( { munger => 'datetime', format => $FMT, part => $part } );
	for my $stamp (@STAMPS) {
		# expected value straight off Time::Piece, computed here in the test so
		# the module's slow path is not the oracle for itself.
		my $t   = Time::Piece->strptime( $stamp, $FMT );
		my %exp = (
			epoch     => $t->epoch,
			year      => $t->year,
			mon       => $t->mon,
			mday      => $t->mday,
			hour      => $t->hour,
			min       => $t->min,
			sec       => $t->sec,
			wday      => $t->day_of_week,
			yday      => $t->yday,
			frac_day  => ( $t->hour * 3600 + $t->min * 60 + $t->sec ) / 86400,
			frac_week => ( $t->day_of_week * 86400 + $t->hour * 3600 + $t->min * 60 + $t->sec ) / 604800,
		);
		my $pi = 2 * atan2( 0, -1 );
		$exp{sin_day}  = sin( $pi * $exp{frac_day} );
		$exp{cos_day}  = cos( $pi * $exp{frac_day} );
		$exp{sin_week} = sin( $pi * $exp{frac_week} );
		$exp{cos_week} = cos( $pi * $exp{frac_week} );

		my $got = $fast->($stamp);
		ok( abs( $got - $exp{$part} ) < 1e-9, "$part($stamp) fast == strptime" )
			or diag("got $got, expected $exp{$part}");
	} ## end for my $stamp (@STAMPS)
} ## end for my $part (@PARTS)

# ---- memo: repeat hits and non-stale updates --------------------------------
{
	my $c = $M->build( { munger => 'datetime', format => $FMT, part => 'hour' } );
	is( $c->('2026-07-05T13:00:00'), 13, 'first call' );
	is( $c->('2026-07-05T13:00:00'), 13, 'memo repeat hit' );
	is( $c->('2026-07-05T14:00:00'), 14, 'different stamp is not served stale' );
	is( $c->('2026-07-05T13:00:00'), 13, 'switching back re-parses correctly' );

	# a parse failure must not poison the memo
	eval { $c->('garbage') };
	like( $@, qr/cannot parse 'garbage'/, 'bad input croaks on the fast path' );
	is( $c->('2026-07-05T14:00:00'), 14, 'memo survives a failed parse' );

	# multi-output memo: same pair, then a different stamp
	my ( $code, $arity ) = do {
		# via compile, the public route to a multi munger
		my $plan = $M->compile(
			tags    => [qw(s c)],