Symbol construction fix.

db-odbc/odbc-package.lisp

@@ -16,54 +16,53 @@
 
 (in-package #:cl-user)
 
+#-#.(cl:if (cl:find-package "ODBC") '(and) '(or))
 (defpackage #:odbc
   (:use #:cl #:uffi)
-  (:export
-     #:database-library-loaded
-
-     #:*null*
-     #:+null-ptr+
-     #:+max-precision+
-     #:*info-output*
-     #:*time-format*
-     #:get-cast-long
-     #:%free-statement
-     #:%disconnect
-     #:%commit
-     #:%rollback
-     #:%sql-fetch
-     #:%sql-cancel
-     #:db-connect
-     #:%new-db-connection-handle
-     #:%new-environment-handle
-     #:%sql-connect
-     #:%sql-driver-connect
-     #:disable-autocommit
-     #:enable-autocommit
-     #:%sql-free-environment
-     #:%sql-data-sources
-     #:%sql-get-info
-     #:%sql-param-data
-     #:%sql-execute
-     #:%put-str
-     #:%sql-bind-parameter
-     #:%sql-prepare
-     #:sqlfetch
-     #:%bind-column
-     #:%allocate-bindings
-     #:%describe-column
-     #:%describe-columns
-     #:read-data
-     #:read-data-in-chunks
-     #:query-database
-     #:%new-statement-handle
-     #:%sql-exec-direct
-     #:result-columns-count
-     #:result-rows-count
-     #:sql-to-c-type
-     #:%list-tables
-     #:%table-statistics
-     #:%list-data-sources
-     )
   (:documentation "This is the low-level interface ODBC."))
+(in-package #:odbc)
 
+(export '(database-library-loaded
+          *null*
+          +null-ptr+
+          +max-precision+
+          *info-output*
+          *time-format*
+          get-cast-long
+          %free-statement
+          %disconnect
+          %commit
+          %rollback
+          %sql-fetch
+          %sql-cancel
+          db-connect
+          %new-db-connection-handle
+          %new-environment-handle
+          %sql-connect
+          %sql-driver-connect
+          disable-autocommit
+          enable-autocommit
+          %sql-free-environment
+          %sql-data-sources
+          %sql-get-info
+          %sql-param-data
+          %sql-execute
+          %put-str
+          %sql-bind-parameter
+          %sql-prepare
+          sqlfetch
+          %bind-column
+          %allocate-bindings
+          %describe-column
+          %describe-columns
+          read-data
+          read-data-in-chunks
+          query-database
+          %new-statement-handle
+          %sql-exec-direct
+          result-columns-count
+          result-rows-count
+          sql-to-c-type
+          %list-tables
+          %table-statistics
+          %list-data-sources))

sql/decimals.lisp

@@ -10,16 +10,17 @@
 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
+#-#.(cl:if (cl:find-package "DECIMALS") '(and) '(or))
 (defpackage #:decimals
-  (:use #:cl)
-  (:export #:round-half-away-from-zero
-           #:format-decimal-number
-           #:parse-decimal-number
-           #:decimal-parse-error
-           #:define-decimal-formatter))
-
+  (:use #:cl))
 (in-package #:decimals)
 
+(export '(round-half-away-from-zero
+          format-decimal-number
+          parse-decimal-number
+          decimal-parse-error
+          define-decimal-formatter))
+
 
 (defun round-half-away-from-zero (number &optional (divisor 1))
 

sql/metaclasses.lisp

@@ -483,7 +483,8 @@ implementations."
 
          (macrolet
              ((safe-copy-value (name &optional default)
-                (let ((fn (intern (format nil "~A~A" 'view-class-slot- name ))))
+                (let ((fn (intern (concatenate 'string (symbol-name 'view-class-slot-)
+                                               (symbol-name name)))))
                   `(setf (slot-value esd ',name)
                     (or (when (slot-boundp dsd ',name)
                           (delistify-dsd (,fn dsd)))

sql/ooddl.lisp

@@ -41,17 +41,17 @@
       (unless (slot-boundp instance slot-name)
         (let ((*db-deserializing* t))
           (cond
-            ((join-slot-p slot-def)
+            ((join-slot-p slot-object)
              (setf (slot-value instance slot-name)
                    (if (view-database instance)
                        (fault-join-slot class instance slot-object)
                        ;; TODO: you could in theory get a join object even if
                        ;; its joined-to object was not in the database
                        nil
                        )))
-            ((not-direct-normalized-slot-p class slot-def)
+            ((not-direct-normalized-slot-p class slot-name)
              (if (view-database instance)
-                 (update-fault-join-normalized-slot class instance slot-def)
+                 (update-fault-join-normalized-slot class instance slot-object)
                  (setf (slot-value instance slot-name) nil))))))))
   (call-next-method))
 
@@ -240,7 +240,10 @@ strings."
      (defclass ,class ,supers ,slots
        ,@(if (find :metaclass `,cl-options :key #'car)
              `,cl-options
-             (cons '(:metaclass clsql-sys::standard-db-class) `,cl-options)))
+           (cons '(:metaclass clsql-sys::standard-db-class) `,cl-options))
+       #+lispworks
+       ,@(unless (find :optimize-slot-access `,cl-options :key #'car)
+           `((:optimize-slot-access nil))))
      (finalize-inheritance (find-class ',class))
      (find-class ',class)))
 

sql/utils.lisp

@@ -100,12 +100,12 @@
 
 #+lispworks
 (defvar +lw-has-without-preemption+
-  #+lispworks6 nil
-  #-lispworks6 t)
+  #+(or lispworks6 lispworks7) nil
+  #-(or lispworks6 lispworks7) t)
 #+lispworks
 (defvar +lw-global-lock+
   (unless +lw-has-without-preemption+
-    (mp:make-lock :name "CLSQL" :important-p nil :safep t :recursivep nil
+    (mp:make-lock :name "CLSQL" :important-p nil :safep t :recursivep t
                   :sharing t)))
 
 (defmacro without-interrupts (&body body)