From fe9654a9f2c7db4f13f4db58bcd357fc22c634b4 Mon Sep 17 00:00:00 2001
From: "Kevin M. Rosenberg" <kevin@rosenberg.net>
Date: Mon, 12 Apr 2004 20:43:17 +0000
Subject: [PATCH] r8980: multiple fixes from Marcus Pearce

---
 ChangeLog      |  6 ++++--
 base/time.lisp | 51 ++++++++++++++++++++++++++++----------------------
 sql/sql.lisp   |  6 +++---
 3 files changed, 36 insertions(+), 27 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 751cd4f..3c5756d 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,7 +1,9 @@
 12 Apr 2004 Kevin Rosenberg (kevin@rosenberg.net)
 	* Version 2.6.8
-	* test/test-fddl.lisp: Cleanup fix from Marcus Pearce
-
+	* test/test-fddl.lisp: Cleanup fix [Marcus Pearce]
+	* utils/time.lisp: Multiple fixes [Marcus Pearce]
+	* sql/sql.lisp: Fix for truncate-database [Marcus Pearce]
+	
 12 Apr 2004 Kevin Rosenberg (kevin@rosenberg.net)
 	* Version 2.6.7
 	* sql/*.lisp: Remove schema versioning cruft
diff --git a/base/time.lisp b/base/time.lisp
index 6891188..cd32be4 100644
--- a/base/time.lisp
+++ b/base/time.lisp
@@ -160,26 +160,27 @@ month, year, integer day-of-week"
 
 ;; duration specific
 (defun duration-reduce (duration precision &optional round)
-     (:second
-      (+ (duration-second duration)
-         (* (duration-reduce duration :minute) 60)))
-     (:minute
-      (+ (if round
-	     (floor (duration-second duration) 30)
-	     0)
-	 (duration-minute duration)
-         (* (duration-reduce duration :hour) 60)))
-     (:hour
-      (+ (if round
-	     (floor (duration-minute duration) 30)
-	     0)
-	 (duration-hour duration)
-         (* (duration-reduce duration :day) 24)))
-     (:day
-      (+ (if round
-	     (floor (duration-hour duration) 12)
-	     0)
-	 (duration-day duration))))
+  (ecase precision
+    (:second
+     (+ (duration-second duration)
+	(* (duration-reduce duration :minute) 60)))
+    (:minute
+     (+ (if round
+	    (floor (duration-second duration) 30)
+	    0)
+	(duration-minute duration)
+	(* (duration-reduce duration :hour) 60)))
+    (:hour
+     (+ (if round
+	    (floor (duration-minute duration) 30)
+	    0)
+	(duration-hour duration)
+	(* (duration-reduce duration :day) 24)))
+    (:day
+     (+ (if round
+	    (floor (duration-hour duration) 12)
+	    0)
+	(duration-day duration)))))
 
 
 ;; ------------------------------------------------------------
@@ -977,6 +978,12 @@ rules"
     (when (and year (< 1500 year 2500))
       (make-time :year year))))
 
+(defun parse-integer-insensitively (string)
+  (let ((start (position-if #'digit-char-p string))
+        (end   (position-if #'digit-char-p string :from-end t)))
+    (when (and start end)
+      (parse-integer (subseq string start (1+ end)) :junk-allowed t))))
+
 (defvar *roman-digits*
   '((#\M . 1000)
     (#\D . 500)
@@ -988,8 +995,8 @@ rules"
 
 (defun extract-roman (string &aux parse)
   (dotimes (x (length string))
-    (when-bind (val (get-alist (aref string x) *roman-digits*))
-      (when (and parse (< (car parse) val))
+    (let ((val (cdr (assoc (aref string x) *roman-digits*))))
+      (when (and val parse (< (car parse) val))
         (push (- (pop parse)) parse))
       (push val parse)))
   (apply #'+ parse))
diff --git a/sql/sql.lisp b/sql/sql.lisp
index 28d5a92..8cf7758 100644
--- a/sql/sql.lisp
+++ b/sql/sql.lisp
@@ -38,11 +38,11 @@
     (clsql-base-sys::signal-no-database-error database))
   (unless (is-database-open database)
     (database-reconnect database))
-  (dolist (table (list-tables database))
+  (dolist (table (list-tables :database database))
     (drop-table table :database database))
-  (dolist (index (list-indexes database))
+  (dolist (index (list-indexes :database database))
     (drop-index index :database database))
-  (dolist (seq (list-sequences database))
+  (dolist (seq (list-sequences :database database))
     (drop-sequence seq :database database)))
 
 (defun print-query (query-exp &key titles (formats t) (sizes t) (stream t)
-- 
2.34.1