From aced01441ccf8a826de544ed34bed4d8616a14ee Mon Sep 17 00:00:00 2001 From: Marcus Pearce Date: Wed, 5 May 2004 23:32:42 +0000 Subject: [PATCH 1/1] r9253: Add *db-auto-sync* special var for controlling creation/updating of db records when objects are created/manipulated. Import symbols from time.lisp into clsql. --- ChangeLog | 19 ++++++ TODO | 2 +- sql/objects.lisp | 27 ++++---- sql/package.lisp | 83 ++++++++++++++++++++++- tests/test-fdml.lisp | 2 +- tests/test-init.lisp | 28 ++++---- tests/test-ooddl.lisp | 10 +-- tests/test-time.lisp | 152 +++++++++++++++++++++--------------------- 8 files changed, 212 insertions(+), 111 deletions(-) diff --git a/ChangeLog b/ChangeLog index a9cf642..5139287 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,22 @@ +6 May 2004 Marcus Pearce (m.t.pearce@city.ac.uk) + * sql/objects.lisp: replace *update-records-on-make-instance* with + *db-auto-sync* which also controls both automatic creation of + new records on creation of new instance and updating of record + fields on setting of instance slots (as suggested by Edi Weitz). + * tests/test-init.lisp: replace *update-records-on-make-instance* + with *db-auto-sync*. + * sql/package.lisp: replace *update-records-on-make-instance* + with *db-auto-sync*. + * TODO: replace *update-records-on-make-instance* with *db-auto-sync*. + * sql/objects.lisp: remove redundant rebindings of *db-initializing* + and *default-database* in FIND-ALL. + * sql/package.lisp: import time functions from CLSQL-BASE. + * tests/test-time.lisp: replace CLSQl-BASE package qualifier with CLSQL. + * tests/test-fdml.lisp: replace CLSQl-BASE package qualifier with CLSQL. + * tests/test-init.lisp: replace CLSQl-BASE package qualifier with CLSQL. + * tests/test-ooddl.lisp: replace CLSQl-BASE package qualifier with + CLSQL. + 4 May 2004 Kevin Rosenberg (kevin@rosenberg.net) * sql/classes.lisp: Add SQL-OBJECT-QUERY type. Have [select 'class] now return a sql-object-query type rather than directly performing a query. diff --git a/TODO b/TODO index 0bfb10d..a7a913c 100644 --- a/TODO +++ b/TODO @@ -6,7 +6,7 @@ TESTS TO ADD * Large object testing * Test bigint type * :db-constraint tests -* *update-records-on-make-instance* +* test *db-auto-sync* * test :retrieval :deferred joins COMMONSQL SPEC diff --git a/sql/objects.lisp b/sql/objects.lisp index adaf979..18444be 100644 --- a/sql/objects.lisp +++ b/sql/objects.lisp @@ -21,9 +21,10 @@ (:metaclass standard-db-class) (:documentation "Superclass for all CLSQL View Classes.")) -(defvar *update-records-on-make-instance* nil - "When T, UPDATE-RECORDS-FROM-INSTANCE will be automatically called -when a new instance of a view-class is created.") +(defvar *db-auto-sync* nil + "A non-nil value means that creating View Class instances or + setting their slots automatically creates/updates the + corresponding records in the underlying database.") (defvar *db-deserializing* nil) (defvar *db-initializing* nil) @@ -43,20 +44,25 @@ when a new instance of a view-class is created.") (setf (slot-value instance slot-name) nil)))))) (call-next-method)) -#+ignore ;; not currently used (defmethod (setf slot-value-using-class) (new-value (class standard-db-class) - instance slot) - (declare (ignore new-value instance slot)) - (call-next-method)) + instance slot-def) + (declare (ignore new-value)) + (let ((slot-name (%svuc-slot-name slot-def)) + (slot-kind (view-class-slot-db-kind slot-def))) + (call-next-method) + (when (and *db-auto-sync* + (not *db-initializing*) + (not *db-deserializing*) + (not (eql slot-kind :virtual))) + (update-record-from-slot instance slot-name)))) (defmethod initialize-instance ((object standard-db-object) &rest all-keys &key &allow-other-keys) (declare (ignore all-keys)) (let ((*db-initializing* t)) (call-next-method) - (when (and *update-records-on-make-instance* + (when (and *db-auto-sync* (not *db-deserializing*)) - #+nil (created-object object) (update-records-from-instance object)))) ;; @@ -873,7 +879,6 @@ superclass of the newly-defined View Class." (let* ((class-name (class-name vclass)) (db-vals (butlast vals (- (list-length vals) (list-length selects)))) - (*db-initializing* t) (obj (make-instance class-name :view-database database))) ;; use refresh keyword here (setf obj (get-slot-values-from-view obj (mapcar #'car selects) @@ -890,8 +895,6 @@ superclass of the newly-defined View Class." (car objects) objects)))) (let* ((*db-deserializing* t) - (*default-database* (or database - (error 'clsql-base::clsql-no-database-error :database nil))) (sclasses (mapcar #'find-class view-classes)) (sels (mapcar #'generate-selection-list sclasses)) (fullsels (apply #'append sels)) diff --git a/sql/package.lisp b/sql/package.lisp index ba3f972..ff6ec17 100644 --- a/sql/package.lisp +++ b/sql/package.lisp @@ -246,6 +246,86 @@ #:db-type-default-case #:convert-to-db-default-case #:database-underlying-type + + ;; time.lisp + #:bad-component + #:current-day + #:current-month + #:current-year + #:day-duration + #:db-timestring + #:decode-duration + #:decode-time + #:duration + #:duration+ + #:duration< + #:duration<= + #:duration= + #:duration> + #:duration>= + #:duration-day + #:duration-hour + #:duration-minute + #:duration-month + #:duration-second + #:duration-year + #:duration-reduce + #:duration-timestring + #:extract-roman + #:format-duration + #:format-time + #:get-time + #:utime->time + #:interval-clear + #:interval-contained + #:interval-data + #:interval-edit + #:interval-end + #:interval-match + #:interval-push + #:interval-relation + #:interval-start + #:interval-type + #:make-duration + #:make-interval + #:make-time + #:merged-time + #:midnight + #:month-name + #:parse-date-time + #:parse-timestring + #:parse-yearstring + #:print-date + #:roll + #:roll-to + #:time + #:time+ + #:time- + #:time-by-adding-duration + #:time-compare + #:time-difference + #:time-dow + #:time-element + #:time-max + #:time-min + #:time-mjd + #:time-msec + #:time-p + #:time-sec + #:time-well-formed + #:time-ymd + #:time< + #:time<= + #:time= + #:time> + #:time>= + #:timezone + #:universal-time + #:wall-time + #:wall-timestring + #:week-containing + #:gregorian-to-mjd + #:mjd-to-gregorian )) (:export ;; "Private" exports for use by interface packages @@ -348,8 +428,6 @@ #:locally-enable-sql-reader-syntax ; syntax xx #:restore-sql-reader-syntax-state ; syntax xx - #:*update-records-on-make-instance* - ;;------------------------------------------------ ;; Miscellaneous Extensions ;;------------------------------------------------ @@ -376,6 +454,7 @@ #:universal-time ; objects xx #:bigint ;;OODML + #:*db-auto-sync* ; objects xx #:add-to-relation ; objects x #:remove-from-relation ; objects x #:read-sql-value ; objects x diff --git a/tests/test-fdml.lisp b/tests/test-fdml.lisp index 3807104..df9f28f 100644 --- a/tests/test-fdml.lisp +++ b/tests/test-fdml.lisp @@ -27,7 +27,7 @@ (progn (clsql:insert-records :into [employee] :values `(11 1 "Yuri" "Gagarin" "gagarin@soviet.org" - 1 1 1.85 t ,(clsql-base:get-time))) + 1 1 1.85 t ,(clsql:get-time))) (values (clsql:select [first-name] [last-name] [email] :from [employee] :where [= [emplid] 11]) diff --git a/tests/test-init.lisp b/tests/test-init.lisp index 41437f5..99c3a47 100644 --- a/tests/test-init.lisp +++ b/tests/test-init.lisp @@ -38,7 +38,7 @@ :initarg :height) (married :db-kind :base :accessor married :type boolean :initarg :married) - (birthday :type clsql-base:wall-time :initarg :birthday) + (birthday :type clsql:wall-time :initarg :birthday) (hobby :db-kind :virtual :initarg :hobby :initform nil))) (def-view-class employee (person) @@ -218,7 +218,7 @@ (clsql:create-view-from-class 'address) (clsql:create-view-from-class 'employee-address)) - (let ((*update-records-on-make-instance* t)) + (let ((*db-auto-sync* t)) (setf company1 (make-instance 'company :presidentid 1 :companyid 1 @@ -229,7 +229,7 @@ :groupid 1 :married t :height (1+ (random 1.00)) - :birthday (clsql-base:get-time) + :birthday (clsql:get-time) :first-name "Vladamir" :last-name "Lenin" :email "lenin@soviet.org" @@ -239,7 +239,7 @@ :groupid 1 :height (1+ (random 1.00)) :married t - :birthday (clsql-base:get-time) + :birthday (clsql:get-time) :first-name "Josef" :last-name "Stalin" :email "stalin@soviet.org" @@ -250,7 +250,7 @@ :groupid 1 :height (1+ (random 1.00)) :married t - :birthday (clsql-base:get-time) + :birthday (clsql:get-time) :first-name "Leon" :last-name "Trotsky" :email "trotsky@soviet.org" @@ -261,7 +261,7 @@ :groupid 1 :height (1+ (random 1.00)) :married nil - :birthday (clsql-base:get-time) + :birthday (clsql:get-time) :first-name "Nikita" :last-name "Kruschev" :email "kruschev@soviet.org" @@ -272,7 +272,7 @@ :groupid 1 :married nil :height (1+ (random 1.00)) - :birthday (clsql-base:get-time) + :birthday (clsql:get-time) :first-name "Leonid" :last-name "Brezhnev" :email "brezhnev@soviet.org" @@ -283,7 +283,7 @@ :groupid 1 :married nil :height (1+ (random 1.00)) - :birthday (clsql-base:get-time) + :birthday (clsql:get-time) :first-name "Yuri" :last-name "Andropov" :email "andropov@soviet.org" @@ -294,7 +294,7 @@ :groupid 1 :height (1+ (random 1.00)) :married nil - :birthday (clsql-base:get-time) + :birthday (clsql:get-time) :first-name "Konstantin" :last-name "Chernenko" :email "chernenko@soviet.org" @@ -305,7 +305,7 @@ :groupid 1 :height (1+ (random 1.00)) :married nil - :birthday (clsql-base:get-time) + :birthday (clsql:get-time) :first-name "Mikhail" :last-name "Gorbachev" :email "gorbachev@soviet.org" @@ -316,7 +316,7 @@ :groupid 1 :married nil :height (1+ (random 1.00)) - :birthday (clsql-base:get-time) + :birthday (clsql:get-time) :first-name "Boris" :last-name "Yeltsin" :email "yeltsin@soviet.org" @@ -327,7 +327,7 @@ :groupid 1 :married nil :height (1+ (random 1.00)) - :birthday (clsql-base:get-time) + :birthday (clsql:get-time) :first-name "Vladamir" :last-name "Putin" :email "putin@soviet.org" @@ -457,9 +457,9 @@ ****************************************************************************** " report-type - (clsql-base:format-time + (clsql:format-time nil - (clsql-base:utime->time (get-universal-time))) + (clsql:utime->time (get-universal-time))) (lisp-implementation-type) (lisp-implementation-version) (machine-type) diff --git a/tests/test-ooddl.lisp b/tests/test-ooddl.lisp index ba671e6..497bef6 100644 --- a/tests/test-ooddl.lisp +++ b/tests/test-ooddl.lisp @@ -62,7 +62,7 @@ "Lenin") (deftest :ooddl/time/1 - (let* ((now (clsql-base:get-time))) + (let* ((now (clsql:get-time))) (when (member *test-database-underlying-type* '(:postgresql :postgresql-socket)) (clsql:execute-command "set datestyle to 'iso'")) (clsql:update-records [employee] :av-pairs `((birthday ,now)) @@ -71,11 +71,11 @@ :flatp t)))) (values (slot-value dbobj 'last-name) - (clsql-base:time= (slot-value dbobj 'birthday) now)))) + (clsql:time= (slot-value dbobj 'birthday) now)))) "Lenin" t) (deftest :ooddl/time/2 - (let* ((now (clsql-base:get-time)) + (let* ((now (clsql:get-time)) (fail-index -1)) (when (member *test-database-underlying-type* '(:postgresql :postgresql-socket)) (clsql:execute-command "set datestyle to 'iso'")) @@ -84,9 +84,9 @@ :where [= [emplid] 1]) (let ((dbobj (car (clsql:select 'employee :where [= [birthday] now] :flatp t)))) - (unless (clsql-base:time= (slot-value dbobj 'birthday) now) + (unless (clsql:time= (slot-value dbobj 'birthday) now) (setf fail-index x)) - (setf now (clsql-base:roll now :day (* 10 x))))) + (setf now (clsql:roll now :day (* 10 x))))) fail-index) -1) diff --git a/tests/test-time.lisp b/tests/test-time.lisp index f04daac..32ab171 100644 --- a/tests/test-time.lisp +++ b/tests/test-time.lisp @@ -12,19 +12,19 @@ ;; relations of intervals (deftest :time/1 - (let* ((time-1 (clsql-base:parse-timestring "2002-01-01 10:00:00")) - (time-2 (clsql-base:parse-timestring "2002-01-01 11:00:00")) - (time-3 (clsql-base:parse-timestring "2002-01-01 12:00:00")) - (time-4 (clsql-base:parse-timestring "2002-01-01 13:00:00")) - (interval-1 (clsql-base:make-interval :start time-1 :end time-2)) - (interval-2 (clsql-base:make-interval :start time-2 :end time-3)) - (interval-3 (clsql-base:make-interval :start time-3 :end time-4)) - (interval-4 (clsql-base:make-interval :start time-1 :end time-3)) - (interval-5 (clsql-base:make-interval :start time-2 :end time-4)) - (interval-6 (clsql-base:make-interval :start time-1 :end time-4))) + (let* ((time-1 (clsql:parse-timestring "2002-01-01 10:00:00")) + (time-2 (clsql:parse-timestring "2002-01-01 11:00:00")) + (time-3 (clsql:parse-timestring "2002-01-01 12:00:00")) + (time-4 (clsql:parse-timestring "2002-01-01 13:00:00")) + (interval-1 (clsql:make-interval :start time-1 :end time-2)) + (interval-2 (clsql:make-interval :start time-2 :end time-3)) + (interval-3 (clsql:make-interval :start time-3 :end time-4)) + (interval-4 (clsql:make-interval :start time-1 :end time-3)) + (interval-5 (clsql:make-interval :start time-2 :end time-4)) + (interval-6 (clsql:make-interval :start time-1 :end time-4))) (flet ((my-assert (number relation i1 i2) (declare (ignore number)) - (let ((found-relation (clsql-base:interval-relation i1 i2))) + (let ((found-relation (clsql:interval-relation i1 i2))) (equal relation found-relation)))) (and (my-assert 1 :contains interval-1 interval-1) @@ -68,73 +68,73 @@ ;; adjacent intervals in list (deftest :time/2 (let* ((interval-list nil) - (time-1 (clsql-base:parse-timestring "2002-01-01 10:00:00")) - (time-3 (clsql-base:parse-timestring "2002-01-01 12:00:00")) - (time-4 (clsql-base:parse-timestring "2002-01-01 13:00:00"))) + (time-1 (clsql:parse-timestring "2002-01-01 10:00:00")) + (time-3 (clsql:parse-timestring "2002-01-01 12:00:00")) + (time-4 (clsql:parse-timestring "2002-01-01 13:00:00"))) (setf interval-list - (clsql-base:interval-push interval-list (clsql-base:make-interval :start time-1 :end time-3 + (clsql:interval-push interval-list (clsql:make-interval :start time-1 :end time-3 :type :open))) (setf interval-list - (clsql-base:interval-push interval-list (clsql-base:make-interval :start time-3 :end time-4 + (clsql:interval-push interval-list (clsql:make-interval :start time-3 :end time-4 :type :open))) - (clsql-base:interval-relation (car interval-list) (cadr interval-list))) + (clsql:interval-relation (car interval-list) (cadr interval-list))) :precedes) ;; nested intervals in list (deftest :time/3 (let* ((interval-list nil) - (time-1 (clsql-base:parse-timestring "2002-01-01 10:00:00")) - (time-2 (clsql-base:parse-timestring "2002-01-01 11:00:00")) - (time-3 (clsql-base:parse-timestring "2002-01-01 12:00:00")) - (time-4 (clsql-base:parse-timestring "2002-01-01 13:00:00"))) + (time-1 (clsql:parse-timestring "2002-01-01 10:00:00")) + (time-2 (clsql:parse-timestring "2002-01-01 11:00:00")) + (time-3 (clsql:parse-timestring "2002-01-01 12:00:00")) + (time-4 (clsql:parse-timestring "2002-01-01 13:00:00"))) (setf interval-list - (clsql-base:interval-push interval-list (clsql-base:make-interval :start time-1 + (clsql:interval-push interval-list (clsql:make-interval :start time-1 :end time-4 :type :open))) (setf interval-list - (clsql-base:interval-push interval-list (clsql-base:make-interval :start time-2 + (clsql:interval-push interval-list (clsql:make-interval :start time-2 :end time-3 :type :closed))) (let* ((interval (car interval-list)) (interval-contained - (when interval (car (clsql-base:interval-contained interval))))) + (when interval (car (clsql:interval-contained interval))))) (when (and interval interval-contained) - (and (clsql-base:time= (clsql-base:interval-start interval) time-1) - (clsql-base:time= (clsql-base:interval-end interval) time-4) - (eq (clsql-base:interval-type interval) :open) - (clsql-base:time= (clsql-base:interval-start interval-contained) time-2) - (clsql-base:time= (clsql-base:interval-end interval-contained) time-3) - (eq (clsql-base:interval-type interval-contained) :closed))))) + (and (clsql:time= (clsql:interval-start interval) time-1) + (clsql:time= (clsql:interval-end interval) time-4) + (eq (clsql:interval-type interval) :open) + (clsql:time= (clsql:interval-start interval-contained) time-2) + (clsql:time= (clsql:interval-end interval-contained) time-3) + (eq (clsql:interval-type interval-contained) :closed))))) t) ;; interval-edit - nonoverlapping (deftest :time/4 (let* ((interval-list nil) - (time-1 (clsql-base:parse-timestring "2002-01-01 10:00:00")) - (time-2 (clsql-base:parse-timestring "2002-01-01 11:00:00")) - (time-3 (clsql-base:parse-timestring "2002-01-01 12:00:00")) - (time-4 (clsql-base:parse-timestring "2002-01-01 13:00:00"))) - (setf interval-list (clsql-base:interval-push interval-list (clsql-base:make-interval :start time-1 :end time-2 :type :open))) - (setf interval-list (clsql-base:interval-push interval-list (clsql-base:make-interval :start time-3 :end time-4 :type :closed))) - (setf interval-list (clsql-base:interval-edit interval-list time-1 time-1 time-3)) + (time-1 (clsql:parse-timestring "2002-01-01 10:00:00")) + (time-2 (clsql:parse-timestring "2002-01-01 11:00:00")) + (time-3 (clsql:parse-timestring "2002-01-01 12:00:00")) + (time-4 (clsql:parse-timestring "2002-01-01 13:00:00"))) + (setf interval-list (clsql:interval-push interval-list (clsql:make-interval :start time-1 :end time-2 :type :open))) + (setf interval-list (clsql:interval-push interval-list (clsql:make-interval :start time-3 :end time-4 :type :closed))) + (setf interval-list (clsql:interval-edit interval-list time-1 time-1 time-3)) ;; should be time-3 not time-2 - (clsql-base:time= (clsql-base:interval-end (car interval-list)) time-3)) + (clsql:time= (clsql:interval-end (car interval-list)) time-3)) t) ;; interval-edit - overlapping (deftest :time/5 (let* ((interval-list nil) - (time-1 (clsql-base:parse-timestring "2002-01-01 10:00:00")) - (time-2 (clsql-base:parse-timestring "2002-01-01 11:00:00")) - (time-3 (clsql-base:parse-timestring "2002-01-01 12:00:00")) - (time-4 (clsql-base:parse-timestring "2002-01-01 13:00:00"))) - (setf interval-list (clsql-base:interval-push interval-list (clsql-base:make-interval :start time-1 :end time-2 :type :open))) - (setf interval-list (clsql-base:interval-push interval-list (clsql-base:make-interval :start time-2 :end time-4 :type :closed))) + (time-1 (clsql:parse-timestring "2002-01-01 10:00:00")) + (time-2 (clsql:parse-timestring "2002-01-01 11:00:00")) + (time-3 (clsql:parse-timestring "2002-01-01 12:00:00")) + (time-4 (clsql:parse-timestring "2002-01-01 13:00:00"))) + (setf interval-list (clsql:interval-push interval-list (clsql:make-interval :start time-1 :end time-2 :type :open))) + (setf interval-list (clsql:interval-push interval-list (clsql:make-interval :start time-2 :end time-4 :type :closed))) (let ((pass t)) (handler-case (progn (setf interval-list - (clsql-base:interval-edit interval-list time-1 time-1 time-3)) + (clsql:interval-edit interval-list time-1 time-1 time-3)) (setf pass nil)) (error nil)) pass)) @@ -143,28 +143,28 @@ ;; interval-edit - nested intervals in list (deftest :time/6 (let* ((interval-list nil) - (time-1 (clsql-base:parse-timestring "2002-01-01 10:00:00")) - (time-2 (clsql-base:parse-timestring "2002-01-01 11:00:00")) - (time-3 (clsql-base:parse-timestring "2002-01-01 12:00:00")) - (time-4 (clsql-base:parse-timestring "2002-01-01 13:00:00")) - (time-5 (clsql-base:parse-timestring "2002-01-01 14:00:00")) - (time-6 (clsql-base:parse-timestring "2002-01-01 15:00:00"))) - (setf interval-list (clsql-base:interval-push interval-list (clsql-base:make-interval :start time-1 :end time-6 :type :open))) - (setf interval-list (clsql-base:interval-push interval-list (clsql-base:make-interval :start time-2 :end time-3 :type :closed))) - (setf interval-list (clsql-base:interval-push interval-list (clsql-base:make-interval :start time-4 :end time-5 :type :closed))) - (setf interval-list (clsql-base:interval-edit interval-list time-1 time-1 time-4)) + (time-1 (clsql:parse-timestring "2002-01-01 10:00:00")) + (time-2 (clsql:parse-timestring "2002-01-01 11:00:00")) + (time-3 (clsql:parse-timestring "2002-01-01 12:00:00")) + (time-4 (clsql:parse-timestring "2002-01-01 13:00:00")) + (time-5 (clsql:parse-timestring "2002-01-01 14:00:00")) + (time-6 (clsql:parse-timestring "2002-01-01 15:00:00"))) + (setf interval-list (clsql:interval-push interval-list (clsql:make-interval :start time-1 :end time-6 :type :open))) + (setf interval-list (clsql:interval-push interval-list (clsql:make-interval :start time-2 :end time-3 :type :closed))) + (setf interval-list (clsql:interval-push interval-list (clsql:make-interval :start time-4 :end time-5 :type :closed))) + (setf interval-list (clsql:interval-edit interval-list time-1 time-1 time-4)) ;; should be time-4 not time-6 - (clsql-base:time= (clsql-base:interval-end (car interval-list)) time-4)) + (clsql:time= (clsql:interval-end (car interval-list)) time-4)) t) ;; Test the boundaries of Local Time with granularity of 1 year (deftest :time/7 (let ((sec-in-year (* 60 60 24 365)) - (year (clsql-base:time-element (clsql-base:make-time) :year))) + (year (clsql:time-element (clsql:make-time) :year))) (dotimes (n 50 n) - (let ((date (clsql-base:make-time :second (* n sec-in-year)))) + (let ((date (clsql:make-time :second (* n sec-in-year)))) (unless (= (+ year n) - (clsql-base:time-element date :year)) + (clsql:time-element date :year)) (return n))))) 50) @@ -175,42 +175,42 @@ (let ((second-in-year (* 60 60 24 365))) (dotimes (n 2000 n) (let* ((second (* -1 n second-in-year)) - (date (clsql-base:make-time :year 2525 :second second))) + (date (clsql:make-time :year 2525 :second second))) (unless - (= (grab-year (clsql-base:db-timestring date)) - (clsql-base:time-element date :year)) + (= (grab-year (clsql:db-timestring date)) + (clsql:time-element date :year)) (return n)))))) 2000) ;; Conversion between MJD and Gregorian (deftest :time/10 (dotimes (base 10000 base) - (unless (= (apply #'clsql-base:gregorian-to-mjd (clsql-base:mjd-to-gregorian base)) + (unless (= (apply #'clsql:gregorian-to-mjd (clsql:mjd-to-gregorian base)) base) (return base))) 10000) -;; Clsql-Base:Roll by minutes: +90 +;; Clsql:Roll by minutes: +90 (deftest :time/11 - (let ((now (clsql-base:get-time))) - (clsql-base:time= (clsql-base:time+ now (clsql-base:make-duration :minute 90)) - (clsql-base:roll now :minute 90))) + (let ((now (clsql:get-time))) + (clsql:time= (clsql:time+ now (clsql:make-duration :minute 90)) + (clsql:roll now :minute 90))) t) -;;Clsql-Base:Roll by minutes: +900 +;;Clsql:Roll by minutes: +900 (deftest :time/12 - (let ((now (clsql-base:get-time))) - (clsql-base:time= (clsql-base:time+ now (clsql-base:make-duration :minute 900)) - (clsql-base:roll now :minute 900))) + (let ((now (clsql:get-time))) + (clsql:time= (clsql:time+ now (clsql:make-duration :minute 900)) + (clsql:roll now :minute 900))) t) -;; Clsql-Base:Roll by minutes: +900 +;; Clsql:Roll by minutes: +900 (deftest :time/13 - (let* ((now (clsql-base:get-time)) - (add-time (clsql-base:time+ now (clsql-base:make-duration :minute 9000))) - (roll-time (clsql-base:roll now :minute 9000))) - (clsql-base:time= add-time roll-time)) + (let* ((now (clsql:get-time)) + (add-time (clsql:time+ now (clsql:make-duration :minute 9000))) + (roll-time (clsql:roll now :minute 9000))) + (clsql:time= add-time roll-time)) t) )) -- 2.34.1