r10893: 28 Feb 2006 Kevin Rosenberg <kevin@rosenberg.net>

[clsql.git] / sql / time.lisp

diff --git a/sql/time.lisp b/sql/time.lisp
index 464d9cd00506388ee6a6a72de3eb09a728ae4ab6..e04525889f54d301f4a428488d304e1cb37a7395 100644 (file)
--- a/sql/time.lisp
+++ b/sql/time.lisp
@@ -1046,11 +1046,16 @@ with the given options"
   (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)))
@@ -1274,7 +1279,7 @@ Will throw a hissy fit if the date string is a duration. Will ignore any precisi
                      (char= #\. (char string 19))))
              (multiple-value-bind (parsed-usec usec-end)
                  (parse-integer string :start 20 :junk-allowed t)
-               (setf usec          parsed-usec
+               (setf usec          (or parsed-usec 0)
                      gmt-sec-offset (if (<= (+ 3 usec-end)  strlen)
                                         (let ((skip-to (or (position #\+ string :start 19)
                                                            (position #\- string :start 19))))