48 / 50 lines covered (96.0%)
1unit module BDD::Behave::Time;23our class Freeze {4 has Instant $.instant is rw;5}67our sub current-freeze() is export {8 my $f;9 try { $f = $*BEHAVE-FROZEN-INSTANT if $*BEHAVE-FROZEN-INSTANT.defined }10 $f;11}1213our sub frozen-instant() is export {14 my $f = current-freeze();15 $f.defined ?? $f.instant !! Instant;16}1718our sub time-is-frozen(--> Bool) is export {19 current-freeze().defined;20}2122our sub current-time() is export {23 my $f = current-freeze();24 $f.defined ?? $f.instant !! now;25}2627our sub to-instant($when --> Instant:D) is export {28 return $when if $when ~~ Instant;29 return $when.Instant if $when ~~ DateTime;30 return $when.DateTime.Instant if $when ~~ Date;31 if $when ~~ Str {32 return DateTime.new($when).Instant;33 }34 if $when ~~ Real {35 return Instant.from-posix($when.Num);36 }37 die "freeze-time: cannot convert {$when.WHAT.^name} to Instant";38}3940my $wrapped = False;4142sub install-wraps() {43 return if $wrapped;44 $wrapped = True;4546 if my $dt-now = DateTime.^lookup('now') {47 $dt-now.wrap(-> $type, *%named {48 my $f = current-freeze();49 if $f.defined {50 my %args = %named;51 %args<timezone> //= $*TZ;52 DateTime.new($f.instant, |%args);53 } else {54 callsame;55 }56 });57 }5859 if my $date-today = Date.^lookup('today') {60 $date-today.wrap(-> $type, *%named {61 my $f = current-freeze();62 if $f.defined {63 my %args = %named;64 %args<timezone> //= $*TZ;65 DateTime.new($f.instant, |%args).Date;66 } else {67 # `callsame` here resolves to VMNull for the wrapped Date.today once68 # this module is loaded from precompilation ("lang-call cannot invoke69 # object of type 'VMNull'"). Delegate to the (also wrapped, and working)70 # DateTime.now, which yields the same current local date.71 DateTime.now(|%named).Date;72 }73 });74 }7576 try {77 &term:<now>.wrap(-> |args {78 my $f = current-freeze();79 $f.defined ?? $f.instant !! callsame;80 });81 }82}8384INIT { install-wraps(); }8586our proto sub freeze-time(|) is export {*}8788our multi sub freeze-time(&block --> Nil) {89 my $freeze = Freeze.new(:instant(now));90 my $*BEHAVE-FROZEN-INSTANT = $freeze;91 block();92 Nil;93}9495our multi sub freeze-time($when, &block --> Nil) {96 my $freeze = Freeze.new(:instant(to-instant($when)));97 my $*BEHAVE-FROZEN-INSTANT = $freeze;98 block();99 Nil;100}101102our sub travel-to($when, &block --> Nil) is export {103 my $freeze = Freeze.new(:instant(to-instant($when)));104 my $*BEHAVE-FROZEN-INSTANT = $freeze;105 block();106 Nil;107}108109our sub travel-by(Real() $delta --> Nil) is export {110 my $f = current-freeze();111 die "travel-by must be called inside a freeze-time or travel-to block"112 unless $f.defined;113 $f.instant = $f.instant + $delta;114 Nil;115}116