diff --git a/contrib/calendar/calendar.factor b/contrib/calendar/calendar.factor index d872cd5981..83953810c7 100644 --- a/contrib/calendar/calendar.factor +++ b/contrib/calendar/calendar.factor @@ -6,8 +6,19 @@ IN: calendar TUPLE: timestamp year month day hour minute second gmt-offset ; TUPLE: dt year month day hour minute second ; +IN: calendar-internals +C: timestamp ( year month day hour minute second gmt-offset -- ) + [ set-timestamp-gmt-offset ] keep + [ set-timestamp-second ] keep + [ set-timestamp-minute ] keep + [ set-timestamp-hour ] keep + [ set-timestamp-day ] keep + [ set-timestamp-month ] keep + [ set-timestamp-year ] keep ; + +IN: calendar SYMBOL: gmt-offset -global [ 7 gmt-offset set ] bind +7 gmt-offset set-global : month-names { @@ -33,44 +44,18 @@ global [ 7 gmt-offset set ] bind #! length of average month in days 30.41666666666667 ; -: default-array ( seq default -- seq ) - #! Pad seq with values from default until they are the same length - #! useful for default parameters like: (year=1,month=1,day=1) - #! { 6 } { 1 1 1 } default-array -> { 6 1 1 } - 2dup [ length ] 2apply >= [ - drop clone - ] [ - 2dup [ length ] 2apply swap - over length [ swap - ] keep rot - append - ] if ; +IN: kernel +M: tuple <=> ( tuple tuple -- n ) + [ tuple>array 2 over length rot >array ] 2apply <=> ; -: first6 - #! to compile words - [ first ] keep - [ second ] keep - [ third ] keep - [ fourth ] keep - [ 4 swap nth ] keep - 5 swap nth ; - -: first7 - #! instead of [ ] each - [ first6 ] keep 6 swap nth ; - -: prepare-timestamp - #! Default parameters for timestamp, expand on stack - { 1970 1 1 0 0 0 0 } default-array dup length 7 > - [ "make-timestamp expects an array up to length 7" throw ] when first7 ; +IN: calendar +DEFER: >gmt DEFER: +dt -DEFER: timestamp= DEFER: seconds - -: make-timestamp ( seq -- timestamp ) - #! Default to 1/1/1 0:0:0 - prepare-timestamp - [ 0 seconds +dt ] keep - [ timestamp= [ "invalid timestamp" throw ] unless ] keep ; +: make-timestamp ( year month day hour minute second gmt-offset -- ) + [ 0 seconds +dt ] keep + [ <=> zero? [ "invalid timestamp" throw ] unless ] keep ; SYMBOL: a SYMBOL: b @@ -126,11 +111,6 @@ SYMBOL: m : minutes ( n -- dt ) zero-dt [ set-dt-minute ] keep ; : seconds ( n -- dt ) zero-dt [ set-dt-second ] keep ; -: /mod-wrap ( f n -- q r ) - #! q is positive or negative, r is positive from 0 <= r < n - [ /f floor >bignum ] 2keep - [ mod ] keep swap dup 0 < [ + ] [ nip ] if ; - : julian-day-number>timestamp ( n -- timestamp ) julian-day-number>date 0 0 0 0 ; @@ -141,6 +121,11 @@ GENERIC: +hour ( timestamp x -- timestamp ) GENERIC: +minute ( timestamp x -- timestamp ) GENERIC: +second ( timestamp x -- timestamp ) +: /mod-wrap ( f n -- q r ) + #! q is positive or negative, r is positive from 0 <= r < n + [ /f floor >bignum ] 2keep + [ mod ] keep swap dup 0 < [ + ] [ nip ] if ; + : float>whole-part ( float -- int float ) [ floor >bignum ] keep dupd swap - ; @@ -159,45 +144,36 @@ GENERIC: +second ( timestamp x -- timestamp ) M: integer +year ( timestamp n -- timestamp ) over timestamp-year + swap [ set-timestamp-year ] keep adjust-leap-year ; -M: float +year ( timestamp n -- timestamp ) - float>whole-part rot swap 365.2425 * +day swap +year ; -M: ratio +year ( timestamp n -- timestamp ) >float +year ; +M: real +year ( timestamp n -- timestamp ) + >float float>whole-part rot swap 365.2425 * +day swap +year ; M: integer +month ( timestamp n -- timestamp ) over timestamp-month + 12 /mod-wrap dup 0 = [ drop 12 >r 1- r> ] when pick set-timestamp-month +year ; -M: float +month ( timestamp n -- timestamp ) - float>whole-part rot swap average-month * +day swap +month ; -M: ratio +month ( timestamp n -- timestamp ) >float +month ; +M: real +month ( timestamp n -- timestamp ) + >float float>whole-part rot swap average-month * +day swap +month ; M: integer +day ( timestamp n -- timestamp ) swap [ date julian-day-number + julian-day-number>timestamp ] keep swap >r time r> [ set-time ] keep ; -M: float +day ( timestamp n -- timestamp ) - float>whole-part rot swap 24 * +hour swap +day ; -M: ratio +day ( timestamp n -- timestamp ) >float +day ; +M: real +day ( timestamp n -- timestamp ) + >float float>whole-part rot swap 24 * +hour swap +day ; M: integer +hour ( timestamp n -- timestamp ) over timestamp-hour + 24 /mod-wrap pick set-timestamp-hour +day ; -M: float +hour ( timestamp n -- timestamp ) - float>whole-part rot swap 60 * +minute swap +hour ; -M: ratio +hour ( timestamp n -- timestamp ) >float +hour ; +M: real +hour ( timestamp n -- timestamp ) + >float float>whole-part rot swap 60 * +minute swap +hour ; M: integer +minute ( timestamp n -- timestamp ) over timestamp-minute + 60 /mod-wrap pick set-timestamp-minute +hour ; -M: float +minute ( timestamp n -- timestamp ) - float>whole-part rot swap 60 * +second swap +minute ; -M: ratio +minute ( timestamp n -- timestamp ) >float +minute ; +M: real +minute ( timestamp n -- timestamp ) + >float float>whole-part rot swap 60 * +second swap +minute ; -: (+second) ( timestamp n -- timestamp ) +M: number +second ( timestamp n -- timestamp ) over timestamp-second + 60 /mod-wrap >r >bignum r> pick set-timestamp-second +minute ; -M: integer +second ( timestamp n -- timestamp ) (+second) ; -M: ratio +second ( timestamp n -- timestamp ) (+second) ; -M: float +second ( timestamp n -- timestamp ) (+second) ; -GENERIC: +dt ( obj obj -- timestamp ) -: (+dt) ( timestamp dt -- timestamp ) +: +dt ( timestamp dt -- timestamp ) dupd [ dt-second +second ] keep [ dt-minute +minute ] keep @@ -207,13 +183,10 @@ GENERIC: +dt ( obj obj -- timestamp ) dt-year +year swap timestamp-gmt-offset over set-timestamp-gmt-offset ; -M: dt +dt ( timestamp dt -- timestamp ) (+dt) ; -M: timestamp +dt ( dt timestamp -- timestamp ) swap (+dt) ; - : dt>vec ( dt -- vec ) tuple>array 2 8 rot ; -: vec>dt ( vec -- dt ) first6
; +: vec>dt ( vec -- dt ) { dt f } swap append >tuple ; : +dts ( dt dt -- dt ) [ dt>vec ] 2apply v+ vec>dt ; -: timestamp>vec ( timestamp -- vec ) tuple>array 2 8 rot ; +: timestamp>vec ( dt -- vec ) tuple>array 2 8 rot ; : dt>years ( dt -- x ) dt>vec [ 1 12 365.2425 8765.82 525949.2 31556952.0 ] [ / ] 2map sum ; @@ -237,14 +210,16 @@ M: timestamp +dt ( dt timestamp -- timestamp ) swap (+dt) ; #! GMT time, right now 1970 1 1 0 0 0 0 millis 1000 /f seconds +dt ; +: timestamp- ( timestamp timestamp -- dt ) [ >gmt timestamp>vec ] 2apply v- ; + : now ( -- timestamp ) gmt >local-time ; : before ( dt -- -dt ) dt>vec [ neg ] map vec>dt ; -: ago ( dt -- timestamp ) before now +dt ; -: from-now ( dt -- timestamp ) now +dt ; +: from-now ( dt -- timestamp ) now swap +dt ; +: ago ( dt -- timestamp ) before from-now ; : days-in-year ( year -- n ) leap-year? 366 365 ? ; : day-counts { 0 31 28 31 30 31 30 31 31 30 31 30 31 } ; -: days-in-month ( year month -- ) +: days-in-month ( year month -- n ) swap leap-year? [ [ day-counts nth ] keep 2 = [ 1+ ] when ] [ @@ -254,49 +229,24 @@ M: timestamp +dt ( dt timestamp -- timestamp ) swap (+dt) ; ! Zeller Congruence ! http://web.textfiles.com/computers/formulas.txt ! good for any date since October 15, 1582 -: (day-of-week) ( year month day -- day-of-week ) +: (day-of-week) ( year month day -- n ) >r dup 2 <= [ 12 + >r 1- r> ] when >r dup [ 4 /i + ] keep [ 100 /i - ] keep 400 /i + r> [ 1+ 3 * 5 /i + ] keep 2 * + r> 1+ + 7 mod ; : day-of-week ( timestamp -- n ) - [ timestamp-year ] keep - [ timestamp-month ] keep - timestamp-day + [ timestamp-year ] keep [ timestamp-month ] keep timestamp-day (day-of-week) ; -: (timestamp=) ( timestamp timestamp -- n timestamp timestamp ) - [ timestamp>vec ] 2apply - [ [ = ] 2map f swap index ] 2keep ; - -: timestamp= ( timestamp timestamp -- ? ) - (timestamp=) 2drop -1 = ; - -: timestamp> ( timestamp timestamp -- ? ) - (timestamp=) >r >r dup -1 = [ - r> r> 3drop f - ] [ - r> dupd nth r> rot swap nth > - ] if ; - -: timestamp>= ( timestamp timestamp -- ? ) - [ timestamp> ] 2keep timestamp= or ; -: timestamp< ( timestamp timestamp -- ? ) - [ timestamp> not ] 2keep timestamp= not and ; -: timestamp<= ( timestamp timestamp -- ? ) - [ timestamp< ] 2keep timestamp= or ; - : day-of-year ( timestamp -- n ) [ [ timestamp-year leap-year? ] keep - dup timestamp-year 3 1 3array make-timestamp timestamp>= and 1 0 ? + [ date 3array ] keep timestamp-year 3 1 3array <=> 0 >= and 1 0 ? ] keep 0 swap [ timestamp-month day-counts sum + ] keep timestamp-day + ; -: month>days days-in-month nth ; - : print-day ( n -- ) unparse dup length 2 < [ " " write @@ -305,11 +255,12 @@ M: timestamp +dt ( dt timestamp -- timestamp ) swap (+dt) ; : print-month ( year month -- ) [ month-names nth write " " write unparse print ] 2keep [ 1 (day-of-week) ] 2keep - days-in-month - day-abbreviations2 " " join print + days-in-month day-abbreviations2 " " join print over [ " " write ] times - [ [ 1+ print-day ] keep 1+ + 7 mod 0 = [ terpri ] [ " " write ] if ] each-with - terpri ; + [ + [ 1+ print-day ] keep + 1+ + 7 mod 0 = [ terpri ] [ " " write ] if + ] each-with terpri ; : print-year ( year -- ) 12 [ 1+ print-month terpri ] each-with ; diff --git a/contrib/calendar/test/calendar.factor b/contrib/calendar/test/calendar.factor index 5454683e1d..1815ff7545 100644 --- a/contrib/calendar/test/calendar.factor +++ b/contrib/calendar/test/calendar.factor @@ -1,16 +1,13 @@ -USING: arrays calendar errors kernel test ; +USING: arrays calendar errors kernel math sequences test ; -[ { 1970 1 1 0 0 0 0 } ] [ { } { 1970 1 1 0 0 0 0 } default-array ] unit-test -[ { 2006 1 1 0 0 0 0 } ] [ { 2006 } { 1970 1 1 0 0 0 0 } default-array ] unit-test - -[ "invalid timestamp" ] [ [ 2004 12 32 3array make-timestamp ] catch ] unit-test -[ "invalid timestamp" ] [ [ 2004 2 30 3array make-timestamp ] catch ] unit-test -[ "invalid timestamp" ] [ [ 2003 2 29 3array make-timestamp ] catch ] unit-test -[ "invalid timestamp" ] [ [ 2004 -2 9 3array make-timestamp ] catch ] unit-test -[ "invalid timestamp" ] [ [ 2004 12 0 3array make-timestamp ] catch ] unit-test -[ "invalid timestamp" ] [ [ { 2004 12 1 24 } make-timestamp ] catch ] unit-test -[ "invalid timestamp" ] [ [ { 2004 12 1 23 60 } make-timestamp ] catch ] unit-test -[ "invalid timestamp" ] [ [ { 2004 12 1 23 59 60 } make-timestamp ] catch ] unit-test +[ "invalid timestamp" ] [ [ 2004 12 32 0 0 0 0 make-timestamp ] catch ] unit-test +[ "invalid timestamp" ] [ [ 2004 2 30 0 0 0 0 make-timestamp ] catch ] unit-test +[ "invalid timestamp" ] [ [ 2003 2 29 0 0 0 0 make-timestamp ] catch ] unit-test +[ "invalid timestamp" ] [ [ 2004 -2 9 0 0 0 0 make-timestamp ] catch ] unit-test +[ "invalid timestamp" ] [ [ 2004 12 0 0 0 0 0 make-timestamp ] catch ] unit-test +[ "invalid timestamp" ] [ [ 2004 12 1 24 0 0 0 make-timestamp ] catch ] unit-test +[ "invalid timestamp" ] [ [ 2004 12 1 23 60 0 0 make-timestamp ] catch ] unit-test +[ "invalid timestamp" ] [ [ 2004 12 1 23 59 60 0 0 make-timestamp ] catch ] unit-test [ f ] [ 1900 leap-year? ] unit-test [ t ] [ 1904 leap-year? ] unit-test @@ -18,118 +15,112 @@ USING: arrays calendar errors kernel test ; [ f ] [ 2001 leap-year? ] unit-test [ f ] [ 2006 leap-year? ] unit-test -[ t ] [ 2006 10 10 0 0 0 0 1 seconds +dt - 2006 10 10 0 0 1 0 timestamp= ] unit-test -[ t ] [ 2006 10 10 0 0 0 0 100 seconds +dt - 2006 10 10 0 1 40 0 timestamp= ] unit-test -[ t ] [ 2006 10 10 0 0 0 0 -100 seconds +dt - 2006 10 9 23 58 20 0 timestamp= ] unit-test -[ t ] [ 2006 10 10 0 0 0 0 86400 seconds +dt - 2006 10 11 0 0 0 0 timestamp= ] unit-test +[ t ] [ 2006 10 10 0 0 0 0 make-timestamp 1 seconds +dt + 2006 10 10 0 0 1 0 make-timestamp <=> zero? ] unit-test +[ t ] [ 2006 10 10 0 0 0 0 make-timestamp 100 seconds +dt + 2006 10 10 0 1 40 0 make-timestamp <=> zero? ] unit-test +[ t ] [ 2006 10 10 0 0 0 0 make-timestamp -100 seconds +dt + 2006 10 9 23 58 20 0 make-timestamp <=> zero? ] unit-test +[ t ] [ 2006 10 10 0 0 0 0 make-timestamp 86400 seconds +dt + 2006 10 11 0 0 0 0 make-timestamp <=> zero? ] unit-test -[ t ] [ 2006 10 10 0 0 0 0 10 minutes +dt - 2006 10 10 0 10 0 0 timestamp= ] unit-test -[ t ] [ 2006 10 10 0 0 0 0 10.5 minutes +dt - 2006 10 10 0 10 30 0 timestamp= ] unit-test -[ t ] [ 2006 10 10 0 0 0 0 3/4 minutes +dt - 2006 10 10 0 0 45 0 timestamp= ] unit-test -[ t ] [ 2006 10 10 0 0 0 0 -3/4 minutes +dt - 2006 10 9 23 59 15 0 timestamp= ] unit-test +[ t ] [ 2006 10 10 0 0 0 0 make-timestamp 10 minutes +dt + 2006 10 10 0 10 0 0 make-timestamp <=> zero? ] unit-test +[ t ] [ 2006 10 10 0 0 0 0 make-timestamp 10.5 minutes +dt + 2006 10 10 0 10 30 0 make-timestamp <=> zero? ] unit-test +[ t ] [ 2006 10 10 0 0 0 0 make-timestamp 3/4 minutes +dt + 2006 10 10 0 0 45 0 make-timestamp <=> zero? ] unit-test +[ t ] [ 2006 10 10 0 0 0 0 make-timestamp -3/4 minutes +dt + 2006 10 9 23 59 15 0 make-timestamp <=> zero? ] unit-test -[ t ] [ 2006 10 10 0 0 0 0 7200 minutes +dt - 2006 10 15 0 0 0 0 timestamp= ] unit-test -[ t ] [ 2006 10 10 0 0 0 0 -10 minutes +dt - 2006 10 9 23 50 0 0 timestamp= ] unit-test -[ t ] [ 2006 10 10 0 0 0 0 -100 minutes +dt - 2006 10 9 22 20 0 0 timestamp= ] unit-test +[ t ] [ 2006 10 10 0 0 0 0 make-timestamp 7200 minutes +dt + 2006 10 15 0 0 0 0 make-timestamp <=> zero? ] unit-test +[ t ] [ 2006 10 10 0 0 0 0 make-timestamp -10 minutes +dt + 2006 10 9 23 50 0 0 make-timestamp <=> zero? ] unit-test +[ t ] [ 2006 10 10 0 0 0 0 make-timestamp -100 minutes +dt + 2006 10 9 22 20 0 0 make-timestamp <=> zero? ] unit-test -[ t ] [ 2006 1 1 0 0 0 0 1 hours +dt - 2006 1 1 1 0 0 0 timestamp= ] unit-test -[ t ] [ 2006 1 1 0 0 0 0 24 hours +dt - 2006 1 2 0 0 0 0 timestamp= ] unit-test -[ t ] [ 2006 1 1 0 0 0 0 -24 hours +dt - 2005 12 31 0 0 0 0 timestamp= ] unit-test -[ t ] [ 2006 1 1 0 0 0 0 12 hours +dt - 2006 1 1 12 0 0 0 timestamp= ] unit-test -[ t ] [ 2006 1 1 0 0 0 0 72 hours +dt - 2006 1 4 0 0 0 0 timestamp= ] unit-test +[ t ] [ 2006 1 1 0 0 0 0 make-timestamp 1 hours +dt + 2006 1 1 1 0 0 0 make-timestamp <=> zero? ] unit-test +[ t ] [ 2006 1 1 0 0 0 0 make-timestamp 24 hours +dt + 2006 1 2 0 0 0 0 make-timestamp <=> zero? ] unit-test +[ t ] [ 2006 1 1 0 0 0 0 make-timestamp -24 hours +dt + 2005 12 31 0 0 0 0 make-timestamp <=> zero? ] unit-test +[ t ] [ 2006 1 1 0 0 0 0 make-timestamp 12 hours +dt + 2006 1 1 12 0 0 0 make-timestamp <=> zero? ] unit-test +[ t ] [ 2006 1 1 0 0 0 0 make-timestamp 72 hours +dt + 2006 1 4 0 0 0 0 make-timestamp <=> zero? ] unit-test -[ t ] [ 2006 1 1 0 0 0 0 1 days +dt - 2006 1 2 0 0 0 0 timestamp= ] unit-test -[ t ] [ 2006 1 1 0 0 0 0 -1 days +dt - 2005 12 31 0 0 0 0 timestamp= ] unit-test -[ t ] [ 2006 1 1 0 0 0 0 365 days +dt - 2007 1 1 0 0 0 0 timestamp= ] unit-test -[ t ] [ 2006 1 1 0 0 0 0 -365 days +dt - 2005 1 1 0 0 0 0 timestamp= ] unit-test -[ t ] [ 2004 1 1 0 0 0 0 365 days +dt - 2004 12 31 0 0 0 0 timestamp= ] unit-test -[ t ] [ 2004 1 1 0 0 0 0 366 days +dt - 2005 1 1 0 0 0 0 timestamp= ] unit-test +[ t ] [ 2006 1 1 0 0 0 0 make-timestamp 1 days +dt + 2006 1 2 0 0 0 0 make-timestamp <=> zero? ] unit-test +[ t ] [ 2006 1 1 0 0 0 0 make-timestamp -1 days +dt + 2005 12 31 0 0 0 0 make-timestamp <=> zero? ] unit-test +[ t ] [ 2006 1 1 0 0 0 0 make-timestamp 365 days +dt + 2007 1 1 0 0 0 0 make-timestamp <=> zero? ] unit-test +[ t ] [ 2006 1 1 0 0 0 0 make-timestamp -365 days +dt + 2005 1 1 0 0 0 0 make-timestamp <=> zero? ] unit-test +[ t ] [ 2004 1 1 0 0 0 0 make-timestamp 365 days +dt + 2004 12 31 0 0 0 0 make-timestamp <=> zero? ] unit-test +[ t ] [ 2004 1 1 0 0 0 0 make-timestamp 366 days +dt + 2005 1 1 0 0 0 0 make-timestamp <=> zero? ] unit-test -[ t ] [ 2006 1 1 0 0 0 0 11 months +dt - 2006 12 1 0 0 0 0 timestamp= ] unit-test -[ t ] [ 2006 1 1 0 0 0 0 12 months +dt - 2007 1 1 0 0 0 0 timestamp= ] unit-test -[ t ] [ 2006 1 1 0 0 0 0 24 months +dt - 2008 1 1 0 0 0 0 timestamp= ] unit-test -[ t ] [ 2006 1 1 0 0 0 0 13 months +dt - 2007 2 1 0 0 0 0 timestamp= ] unit-test -[ t ] [ 2006 1 1 0 0 0 0 1 months +dt - 2006 2 1 0 0 0 0 timestamp= ] unit-test -[ t ] [ 2006 1 1 0 0 0 0 0 months +dt - 2006 1 1 0 0 0 0 timestamp= ] unit-test -[ t ] [ 2006 1 1 0 0 0 0 -1 months +dt - 2005 12 1 0 0 0 0 timestamp= ] unit-test -[ t ] [ 2006 1 1 0 0 0 0 -2 months +dt - 2005 11 1 0 0 0 0 timestamp= ] unit-test -[ t ] [ 2006 1 1 0 0 0 0 -13 months +dt - 2004 12 1 0 0 0 0 timestamp= ] unit-test -[ t ] [ 2006 1 1 0 0 0 0 -24 months +dt - 2004 1 1 0 0 0 0 timestamp= ] unit-test -[ t ] [ 2004 2 29 0 0 0 0 12 months +dt - 2005 3 1 0 0 0 0 timestamp= ] unit-test -[ t ] [ 2004 2 29 0 0 0 0 -12 months +dt - 2003 3 1 0 0 0 0 timestamp= ] unit-test +[ t ] [ 2006 1 1 0 0 0 0 make-timestamp 11 months +dt + 2006 12 1 0 0 0 0 make-timestamp <=> zero? ] unit-test +[ t ] [ 2006 1 1 0 0 0 0 make-timestamp 12 months +dt + 2007 1 1 0 0 0 0 make-timestamp <=> zero? ] unit-test +[ t ] [ 2006 1 1 0 0 0 0 make-timestamp 24 months +dt + 2008 1 1 0 0 0 0 make-timestamp <=> zero? ] unit-test +[ t ] [ 2006 1 1 0 0 0 0 make-timestamp 13 months +dt + 2007 2 1 0 0 0 0 make-timestamp <=> zero? ] unit-test +[ t ] [ 2006 1 1 0 0 0 0 make-timestamp 1 months +dt + 2006 2 1 0 0 0 0 make-timestamp <=> zero? ] unit-test +[ t ] [ 2006 1 1 0 0 0 0 make-timestamp 0 months +dt + 2006 1 1 0 0 0 0 make-timestamp <=> zero? ] unit-test +[ t ] [ 2006 1 1 0 0 0 0 make-timestamp -1 months +dt + 2005 12 1 0 0 0 0 make-timestamp <=> zero? ] unit-test +[ t ] [ 2006 1 1 0 0 0 0 make-timestamp -2 months +dt + 2005 11 1 0 0 0 0 make-timestamp <=> zero? ] unit-test +[ t ] [ 2006 1 1 0 0 0 0 make-timestamp -13 months +dt + 2004 12 1 0 0 0 0 make-timestamp <=> zero? ] unit-test +[ t ] [ 2006 1 1 0 0 0 0 make-timestamp -24 months +dt + 2004 1 1 0 0 0 0 make-timestamp <=> zero? ] unit-test +[ t ] [ 2004 2 29 0 0 0 0 make-timestamp 12 months +dt + 2005 3 1 0 0 0 0 make-timestamp <=> zero? ] unit-test +[ t ] [ 2004 2 29 0 0 0 0 make-timestamp -12 months +dt + 2003 3 1 0 0 0 0 make-timestamp <=> zero? ] unit-test -[ t ] [ 2006 1 1 0 0 0 0 0 years +dt - 2006 1 1 0 0 0 0 timestamp= ] unit-test -[ t ] [ 2006 1 1 0 0 0 0 1 years +dt - 2007 1 1 0 0 0 0 timestamp= ] unit-test -[ t ] [ 2006 1 1 0 0 0 0 -1 years +dt - 2005 1 1 0 0 0 0 timestamp= ] unit-test -[ t ] [ 2006 1 1 0 0 0 0 -100 years +dt - 1906 1 1 0 0 0 0 timestamp= ] unit-test -! [ t ] [ 2004 2 29 0 0 0 0 -1 years +dt - ! 2003 2 28 0 0 0 0 timestamp= ] unit-test +[ t ] [ 2006 1 1 0 0 0 0 make-timestamp 0 years +dt + 2006 1 1 0 0 0 0 make-timestamp <=> zero? ] unit-test +[ t ] [ 2006 1 1 0 0 0 0 make-timestamp 1 years +dt + 2007 1 1 0 0 0 0 make-timestamp <=> zero? ] unit-test +[ t ] [ 2006 1 1 0 0 0 0 make-timestamp -1 years +dt + 2005 1 1 0 0 0 0 make-timestamp <=> zero? ] unit-test +[ t ] [ 2006 1 1 0 0 0 0 make-timestamp -100 years +dt + 1906 1 1 0 0 0 0 make-timestamp <=> zero? ] unit-test +! [ t ] [ 2004 2 29 0 0 0 0 make-timestamp -1 years +dt + ! 2003 2 28 0 0 0 0 make-timestamp <=> zero? ] unit-test -[ 5 ] [ 2006 7 14 0 0 0 0 day-of-week ] unit-test +[ 5 ] [ 2006 7 14 0 0 0 0 make-timestamp day-of-week ] unit-test -[ f ] [ 2006 7 14 0 0 0 0 dup timestamp> ] unit-test -[ f ] [ 2006 7 14 0 0 0 0 dup timestamp< ] unit-test -[ t ] [ 2006 7 14 0 0 0 0 dup timestamp>= ] unit-test -[ t ] [ 2006 7 14 0 0 0 0 dup timestamp<= ] unit-test -[ t ] [ 2006 7 14 0 0 0 0 dup timestamp= ] unit-test +[ t ] [ 2006 7 14 [ julian-day-number julian-day-number>date 0 0 0 0 make-timestamp ] 3keep 0 0 0 0 make-timestamp <=> zero? ] unit-test -[ t ] [ 2006 7 14 [ julian-day-number julian-day-number>date 3array make-timestamp ] 3keep 3array make-timestamp timestamp= ] unit-test +[ 1 ] [ 2006 1 1 0 0 0 0 make-timestamp day-of-year ] unit-test +[ 60 ] [ 2004 2 29 0 0 0 0 make-timestamp day-of-year ] unit-test +[ 61 ] [ 2004 3 1 0 0 0 0 make-timestamp day-of-year ] unit-test +[ 366 ] [ 2004 12 31 0 0 0 0 make-timestamp day-of-year ] unit-test +[ 365 ] [ 2003 12 31 0 0 0 0 make-timestamp day-of-year ] unit-test +[ 60 ] [ 2003 3 1 0 0 0 0 make-timestamp day-of-year ] unit-test -[ 1 ] [ 2006 1 1 3array make-timestamp day-of-year ] unit-test -[ 60 ] [ 2004 2 29 3array make-timestamp day-of-year ] unit-test -[ 61 ] [ 2004 3 1 3array make-timestamp day-of-year ] unit-test -[ 366 ] [ 2004 12 31 3array make-timestamp day-of-year ] unit-test -[ 365 ] [ 2003 12 31 3array make-timestamp day-of-year ] unit-test -[ 60 ] [ 2003 3 1 3array make-timestamp day-of-year ] unit-test +[ t ] [ 2004 12 31 0 0 0 0 make-timestamp dup <=> zero? ] unit-test +[ t ] [ 2004 1 1 0 0 0 0 make-timestamp 10 seconds 5 years +dts +dt + 2009 1 1 0 0 10 0 make-timestamp <=> zero? ] unit-test +[ t ] [ 2004 1 1 0 0 0 0 make-timestamp -10 seconds -5 years +dts +dt + 1998 12 31 23 59 50 0 make-timestamp <=> zero? ] unit-test -[ t ] [ 2004 12 31 3array make-timestamp dup timestamp= ] unit-test -[ t ] [ 2004 1 1 0 0 0 0 10 seconds 5 years +dts +dt - 2009 1 1 0 0 10 0 timestamp= ] unit-test -[ t ] [ 2004 1 1 0 0 0 0 -10 seconds -5 years +dts +dt - 1998 12 31 23 59 50 0 timestamp= ] unit-test - -[ t ] [ 2004 1 1 23 0 0 12 0 convert-timezone - 2004 1 1 11 0 0 0 timestamp= ] unit-test -[ t ] [ 2004 1 1 5 0 0 -11 0 convert-timezone - 2004 1 1 16 0 0 0 timestamp= ] unit-test -[ t ] [ 2004 1 1 23 0 0 9.5 0 convert-timezone - 2004 1 1 13 30 0 0 timestamp= ] unit-test +[ t ] [ 2004 1 1 23 0 0 12 make-timestamp 0 convert-timezone + 2004 1 1 11 0 0 0 make-timestamp <=> zero? ] unit-test +[ t ] [ 2004 1 1 5 0 0 -11 make-timestamp 0 convert-timezone + 2004 1 1 16 0 0 0 make-timestamp <=> zero? ] unit-test +[ t ] [ 2004 1 1 23 0 0 9.5 make-timestamp 0 convert-timezone + 2004 1 1 13 30 0 0 make-timestamp <=> zero? ] unit-test