r9803: Remove items done from TODO files.

[clsql.git] / sql / oodml.lisp

diff --git a/sql/oodml.lisp b/sql/oodml.lisp
index 82f166e1da642108a48556f958bf90abf61c143e..174b35a95f375d43465f20082c57c6ae1d87ba92 100644 (file)
--- a/sql/oodml.lisp
+++ b/sql/oodml.lisp
@@ -307,17 +307,31 @@
          (sql-expression :table (view-table class))))
 
 
-(defparameter *default-varchar-length* 255)
-
 (defmethod database-get-type-specifier (type args database db-type)
   (declare (ignore type args database db-type))
-  (format nil "VARCHAR(~D)" *default-varchar-length*))
+  (format nil "VARCHAR(~D)" *default-string-length*))
 
 (defmethod database-get-type-specifier ((type (eql 'integer)) args database db-type)
   (declare (ignore database db-type))
   (if args
       (format nil "INT(~A)" (car args))
-      "INT"))
+    "INT"))
+
+(deftype tinyint () 
+  "An 8-bit integer, this width may vary by SQL implementation."
+  'integer)
+
+(defmethod database-get-type-specifier ((type (eql 'tinyint)) args database db-type)
+  (declare (ignore args database db-type))
+  "INT")
+
+(deftype smallint () 
+  "An integer smaller than a 32-bit integer, this width may vary by SQL implementation."
+  'integer)
+
+(defmethod database-get-type-specifier ((type (eql 'smallint)) args database db-type)
+  (declare (ignore args database db-type))
+  "INT")
 
 (deftype bigint () 
   "An integer larger than a 32-bit integer, this width may vary by SQL implementation."
@@ -336,13 +350,13 @@
   (declare (ignore database db-type))
   (if args
       (format nil "VARCHAR(~A)" (car args))
-      (format nil "VARCHAR(~D)" *default-varchar-length*)))
+      (format nil "VARCHAR(~D)" *default-string-length*)))
 
 (defmethod database-get-type-specifier ((type (eql 'string)) args database db-type)
   (declare (ignore database db-type))
   (if args
       (format nil "CHAR(~A)" (car args))
-      (format nil "VARCHAR(~D)" *default-varchar-length*)))
+      (format nil "VARCHAR(~D)" *default-string-length*)))
 
 (deftype universal-time () 
   "A positive integer as returned by GET-UNIVERSAL-TIME."
@@ -501,6 +515,14 @@
        (parse-integer val)))
     (number val)))
 
+(defmethod read-sql-value (val (type (eql 'smallint)) database db-type)
+  (declare (ignore database db-type))
+  (etypecase val
+    (string
+     (unless (string-equal "NIL" val)
+       (parse-integer val)))
+    (number val)))
+
 (defmethod read-sql-value (val (type (eql 'bigint)) database db-type)
   (declare (ignore database db-type))
   (etypecase val
@@ -1075,7 +1097,8 @@ as elements of a list."
   (unless (record-caches database)
     (setf (record-caches database)
          (make-hash-table :test 'equal
-                          #+allegro :values #+allegro :weak)))
+                          #+allegro :values #+allegro :weak
+                           #+lispworks :weak-kind #+lispworks :value)))
   (setf (gethash (compute-records-cache-key targets qualifiers)
                 (record-caches database)) results)
   results)