Automated commit for debian release 6.7.2-1

[clsql.git] / sql / utils.lisp

diff --git a/sql/utils.lisp b/sql/utils.lisp
index a215a446ed31cc903584ffc37cf1b18f275ad073..0196d04a95db8b39867aa1d4906d76b4b0859a6a 100644 (file)
--- a/sql/utils.lisp
+++ b/sql/utils.lisp
@@ -100,8 +100,8 @@
 
 #+lispworks
 (defvar +lw-has-without-preemption+
-  #+lispworks6 nil
-  #-lispworks6 t)
+  #-(or lispworks5 lispworks4) nil
+  #+(or lispworks5 lispworks4) t)
 #+lispworks
 (defvar +lw-global-lock+
   (unless +lw-has-without-preemption+
@@ -375,7 +375,7 @@ list of characters and replacement strings."
   (cdr (assoc (string var) ext:*environment-list* :test #'equalp
               :key #'string))
   #+lispworks (lw:environment-variable (string var))
-  #+mcl (ccl::getenv var)
+  #+ccl (ccl::getenv var)
   #+sbcl (sb-ext:posix-getenv var))
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
@@ -424,6 +424,26 @@ is replaced with replacement. [FROM http://cl-cookbook.sourceforge.net/strings.h
     (unless stream
       (get-output-stream-string out))))
 
+(defun read-decimal-value (string)
+  (let* ((comma 0)
+         (dot 0)
+         (last))
+    (loop for c across string
+          do (case c
+               (#\. (incf dot) (setf last 'dot))
+               (#\, (incf comma) (setf last 'comma))))
+    (let* ((bag (if (and (eql last 'dot) (eql dot 1))
+                    ".0123456789+-"
+                    ",0123456789+-"))
+           (clean (with-output-to-string (out)
+                    (loop for c across string
+                          do (when (find c bag :test #'char=)
+                               (write-char c out))))))
+      (if (and (eql last 'dot) (eql dot 1))
+          (decimals:parse-decimal-number clean)
+          (decimals:parse-decimal-number
+           clean :decimal-separator #\,)))))
+
 
 (defun filter-plist (plist &rest keys-to-remove)
   "Returns a copy of the given plist with indicated key-value pairs