Re: Lispworks and Oracle
Martin Thornquist <[email protected]> Tue, 22 Oct 2002 10:01:37 +0200
| Newsgroups | gmane.lisp.uncommon-sql |
|---|---|
| Message-ID | <[email protected]> |
> "[email protected]" <[email protected]> wrote on 21 Oct 2002 > 21:16:55 -0500: > > | I'm not aware of anyone doing anything with the Oracle backend at the > | moment in terms of uffi. I'd be happy to try out what you have since > | there is an Oracle or two around here somewhere. I have only ported some of the easy bits of the Oracle stuff, one of the things that prompted me to post to this list was that I hit something I do not really understand yet -- this line from oracle.lisp: (sap-ref-32 (alien-sap (deref *oci-env*)) 0) (from the oci-get-handle defun). I will get back to you when I have something to be tested. [ Dmitri Ivanov ] > The weak point is that USQL maintainers hardly support LispWorks (on > Windows at least). The common stuff seems mostly ported, from what I have seen it seems to me that the patches were incorporated, but someone has checked in CMUCL specifics afterwards (it is just some MOP stuff, where CMUCL seems to need pcl:: in front of some symbols). That was easily fixed, I've attached my patches. Oh, by the way, I use LispWorks 4.2.7 on Linux. > "Installing and running UncommonSQL under Lispworks/Win32" I have seen that page, I used it to get started (there did not seem to be any Win32-specifics in it). It does not seem to be completely accurate anymore, I should probably make such a page myself when I get this up and running. Martin -- "An ideal world is left as an exercise to the reader." -Paul Graham, On Lisp
context.diff
(text/x-patch, 1.2 KB)
Index: context.lisp
===================================================================
RCS file: /cvs/usql/sql/context.lisp,v
retrieving revision 1.78
diff -u -r1.78 context.lisp
--- context.lisp 2002/10/11 17:56:29 1.78
+++ context.lisp 2002/10/22 07:50:43
@@ -118,11 +118,23 @@
(slot-value instance name)))
(key-slots (class-of instance)))))
+#-lispworks
(defmethod instance-snapshot ((instance standard-db-object) &aux ss)
(let ((*db-deserializing* t)
(unbound (gensym)))
(dolist (slot (pcl:class-slots (pcl:class-of instance)))
(let ((name (slot-value slot 'pcl::name)))
+ (push (cons name (if (slot-boundp instance name)
+ (slot-value instance name)
+ unbound)) ss)))
+ (cons :snapshot (cons unbound ss))))
+
+#+lispworks
+(defmethod instance-snapshot ((instance standard-db-object) &aux ss)
+ (let ((*db-deserializing* t)
+ (unbound (gensym)))
+ (dolist (slot (class-slots (class-of instance)))
+ (let ((name (slot-definition-name slot)))
(push (cons name (if (slot-boundp instance name)
(slot-value instance name)
unbound)) ss)))
test-metaclass.diff
(text/x-patch, 1.8 KB)
Index: test-metaclass.lisp
===================================================================
RCS file: /cvs/usql/sql/tests/test-metaclass.lisp,v
retrieving revision 1.1
diff -u -r1.1 test-metaclass.lisp
--- test-metaclass.lisp 2002/08/16 17:51:43 1.1
+++ test-metaclass.lisp 2002/10/22 07:49:44
@@ -32,7 +32,7 @@
:set nil))))
-
+#-lispworks
(defregression (:metaclass 1)
"Ensure slots inherited from standard-classes are :virtual"
(assert (eql :virtual
@@ -40,7 +40,16 @@
(assert (eql :virtual
(view-class-slot-db-kind (slotdef-for-slot-with-class 'baz (pcl::find-class 'view-class2))))))
+#+lispworks
+(defregression (:metaclass 1)
+ "Ensure slots inherited from standard-classes are :virtual"
+ (assert (eql :virtual
+ (view-class-slot-db-kind (slotdef-for-slot-with-class 'test-slot (find-class 'view-class1)))))
+ (assert (eql :virtual
+ (view-class-slot-db-kind (slotdef-for-slot-with-class 'baz (find-class 'view-class2))))))
+
+#-lispworks
(defregression (:metaclass 2)
"Ensure all slots in view-class are view-class-effective-slot-definition"
(assert (every #'(lambda (slotd)
@@ -49,5 +58,15 @@
(assert (every #'(lambda (slotd)
(typep slotd 'view-class-effective-slot-definition))
(class-slots (pcl::find-class 'view-class2)))))
-
+
+#+lispworks
+(defregression (:metaclass 2)
+ "Ensure all slots in view-class are view-class-effective-slot-definition"
+ (assert (every #'(lambda (slotd)
+ (typep slotd 'view-class-effective-slot-definition))
+ (class-slots (find-class 'view-class1))))
+ (assert (every #'(lambda (slotd)
+ (typep slotd 'view-class-effective-slot-definition))
+ (class-slots (find-class 'view-class2)))))
+