X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=sql%2Ftime.lisp;h=e04525889f54d301f4a428488d304e1cb37a7395;hp=464d9cd00506388ee6a6a72de3eb09a728ae4ab6;hb=6b34e2293a52b03e8611c85e4e53a0ab5c8a3c1a;hpb=76c718bea5a32b8252daeb5a487860d112011157 diff --git a/sql/time.lisp b/sql/time.lisp index 464d9cd..e045258 100644 --- 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))))