From 4c097a396a7ba3bfae5b7857553d57b98becca3b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Lindqvist?= Date: Thu, 5 Jan 2017 13:28:13 +0100 Subject: [PATCH] calendar: value checking to make it hard to create invalid timestamps --- basis/calendar/calendar-docs.factor | 8 ---- basis/calendar/calendar-tests.factor | 26 ++++++++----- basis/calendar/calendar.factor | 58 ++++++++++++++-------------- 3 files changed, 46 insertions(+), 46 deletions(-) diff --git a/basis/calendar/calendar-docs.factor b/basis/calendar/calendar-docs.factor index 143fe3ac30..77705b2162 100644 --- a/basis/calendar/calendar-docs.factor +++ b/basis/calendar/calendar-docs.factor @@ -304,14 +304,6 @@ HELP: before } } ; -HELP: -{ $values { "timestamp" timestamp } } -{ $description "Returns a zero timestamp that consists of zeros for every slot. Used to see if timestamps are valid." } ; - -HELP: valid-timestamp? -{ $values { "timestamp" timestamp } { "?" boolean } } -{ $description "Tests if a timestamp is valid or not." } ; - HELP: unix-1970 { $values { "timestamp" timestamp } } { $description "Returns the beginning of UNIX time, or midnight, January 1, 1970." } ; diff --git a/basis/calendar/calendar-tests.factor b/basis/calendar/calendar-tests.factor index 67f12422c2..53780866bd 100644 --- a/basis/calendar/calendar-tests.factor +++ b/basis/calendar/calendar-tests.factor @@ -1,15 +1,17 @@ USING: accessors kernel math.order random threads tools.test ; IN: calendar -{ f } [ 2004 12 32 0 0 0 instant valid-timestamp? ] unit-test -{ f } [ 2004 2 30 0 0 0 instant valid-timestamp? ] unit-test -{ f } [ 2003 2 29 0 0 0 instant valid-timestamp? ] unit-test -{ f } [ 2004 -2 9 0 0 0 instant valid-timestamp? ] unit-test -{ f } [ 2004 12 0 0 0 0 instant valid-timestamp? ] unit-test -{ f } [ 2004 12 1 24 0 0 instant valid-timestamp? ] unit-test -{ f } [ 2004 12 1 23 60 0 instant valid-timestamp? ] unit-test -{ f } [ 2004 12 1 23 59 60 instant valid-timestamp? ] unit-test -{ t } [ now valid-timestamp? ] unit-test +[ 2004 12 32 0 0 0 instant ] [ not-in-interval? ] must-fail-with +[ 2004 2 30 0 0 0 instant ] [ not-in-interval? ] must-fail-with +[ 2003 2 29 0 0 0 instant ] [ not-in-interval? ] must-fail-with +[ 2004 -2 9 0 0 0 instant ] [ not-in-interval? ] must-fail-with +[ 2004 12 0 0 0 0 instant ] [ not-in-interval? ] must-fail-with +[ 2004 12 1 24 0 0 instant ] [ not-in-interval? ] must-fail-with +[ 2004 12 1 23 60 0 instant ] [ not-in-interval? ] must-fail-with +[ 2004 12 1 23 59 60 instant ] [ not-in-interval? ] must-fail-with +{ } [ + 2014 12 1 23 59 59+99/100 instant drop +] unit-test { f } [ 1900 leap-year? ] unit-test { t } [ 1904 leap-year? ] unit-test @@ -186,3 +188,9 @@ IN: calendar { 0 } [ gmt gmt-offset>> duration>seconds ] unit-test + +! am +[ now 30 am ] [ not-in-interval? ] must-fail-with + +! pm +[ now 30 pm ] [ not-in-interval? ] must-fail-with diff --git a/basis/calendar/calendar.factor b/basis/calendar/calendar.factor index 515a87598f..540b7f1940 100644 --- a/basis/calendar/calendar.factor +++ b/basis/calendar/calendar.factor @@ -2,10 +2,15 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays classes.tuple combinators combinators.short-circuit kernel locals math math.functions -math.order sequences summary system vocabs vocabs.loader +math.intervals math.order sequences summary system vocabs vocabs.loader assocs ; IN: calendar +ERROR: not-in-interval value interval ; + +: check-interval ( value interval -- value ) + 2dup interval-contains? [ drop ] [ not-in-interval ] if ; + HOOK: gmt-offset os ( -- hours minutes seconds ) HOOK: gmt os ( -- timestamp ) @@ -31,7 +36,27 @@ TUPLE: timestamp { second real } { gmt-offset duration } ; -C: timestamp +CONSTANT: day-counts { 0 31 28 31 30 31 30 31 31 30 31 30 31 } + +GENERIC: leap-year? ( obj -- ? ) + +M: integer leap-year? ( year -- ? ) + dup 100 divisor? 400 4 ? divisor? ; + +M: timestamp leap-year? ( timestamp -- ? ) + year>> leap-year? ; + +: (days-in-month) ( year month -- n ) + dup 2 = [ drop leap-year? 29 28 ? ] [ nip day-counts nth ] if ; + +:: ( year month day hour minute second gmt-offset -- timestamp ) + year + month 1 12 [a,b] check-interval + day 1 year month (days-in-month) [a,b] check-interval + hour 0 23 [a,b] check-interval + minute 0 59 [a,b] check-interval + second 0 60 [a,b) check-interval + gmt-offset timestamp boa ; M: timestamp clone (clone) [ clone ] change-gmt-offset ; @@ -50,8 +75,6 @@ M: timestamp clone (clone) [ clone ] change-gmt-offset ; : ( year -- timestamp ) 1 1 ; inline -CONSTANT: day-counts { 0 31 28 31 30 31 30 31 31 30 31 30 31 } - CONSTANT: average-month 30+5/12 CONSTANT: months-per-year 12 CONSTANT: days-per-year 3652425/10000 @@ -123,14 +146,6 @@ M: timestamp easter ( timestamp -- timestamp ) : microseconds ( x -- duration ) 1000000 / seconds ; : nanoseconds ( x -- duration ) 1000000000 / seconds ; -GENERIC: leap-year? ( obj -- ? ) - -M: integer leap-year? ( year -- ? ) - dup 100 divisor? 400 4 ? divisor? ; - -M: timestamp leap-year? ( timestamp -- ? ) - year>> leap-year? ; - ] if ; -: ( -- timestamp ) - 0 0 0 ; inline - -: valid-timestamp? ( timestamp -- ? ) - clone instant >>gmt-offset - dup time- time+ = ; - : unix-1970 ( -- timestamp ) 1970 ; inline @@ -371,9 +379,6 @@ GENERIC: days-in-year ( obj -- n ) M: integer days-in-year ( year -- n ) leap-year? 366 365 ? ; M: timestamp days-in-year ( timestamp -- n ) year>> days-in-year ; -: (days-in-month) ( year month -- n ) - dup 2 = [ drop leap-year? 29 28 ? ] [ nip day-counts nth ] if ; - : days-in-month ( timestamp -- n ) >date< drop (days-in-month) ; @@ -507,16 +512,11 @@ M: timestamp december clone 12 >>month ; : o'clock ( timestamp n -- new-timestamp ) [ midnight ] dip >>hour ; -ERROR: twelve-hour-expected n ; - -: check-twelve-hour ( n -- n ) - dup 0 12 between? [ twelve-hour-expected ] unless ; - : am ( timestamp n -- new-timestamp ) - check-twelve-hour o'clock ; + 0 12 [a,b] check-interval o'clock ; : pm ( timestamp n -- new-timestamp ) - check-twelve-hour 12 + o'clock ; + 0 12 [a,b] check-interval 12 + o'clock ; GENERIC: beginning-of-year ( object -- new-timestamp ) M: timestamp beginning-of-year beginning-of-month 1 >>month ;