another time bug (in function roll)

Aleksandar Bakic <a_bakic-/[email protected]> Sun, 15 Jan 2006 07:32:01 -0800 (PST)
Newsgroups gmane.lisp.clsql.devel
Message-ID <[email protected]>
Hi,

The 'destructive' flag was not treated correctly in the first part of the roll
function.

@@ -1046,11 +1040,16 @@
   (unless (= 0 year month)
     (multiple-value-bind (year-orig month-orig day-orig)
         (time-ymd date)
-      (setf date (make-time :year (+ year year-orig)
-                            :month (+ month month-orig)
-                            :day day-orig
-                            :second (time-second date)
-                            :usec usec))))
+      (multiple-value-bind (new-year new-month)
+         (floor (+ month month-orig (* 12 (+ year year-orig))) 12)
+       (let ((new-date (make-time :year new-year
+                                  :month new-month
+                                  :day day-orig
+                                  :second (time-second date)
+                                  :usec usec)))
+         (if destructive
+             (setf (time-mjd date) (time-mjd new-date))
+             (setq date new-date))))))
   (let ((mjd (time-mjd date))
         (sec (time-second date))
         (usec (time-usec date)))

Alex

__________________________________________________
Do You Yahoo!?
Tired of spam?  Yahoo! Mail has the best spam protection around 
http://mail.yahoo.com