r10868: Automated commit for Debian build of clsql upstream-version-3.5.3

[clsql.git] / sql / time.lisp

diff --git a/sql/time.lisp b/sql/time.lisp
index 75f3faafbc9cebef9af607acfa4fa3e35be30333..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)))