X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=db-odbc%2Fodbc-api.lisp;h=b17af024651a85554ea5d8ce8754fb7d83d7e4c0;hb=e622ee6f4bf2b9fe81af59d566e651c983a4833b;hp=c5cca32d82f9496cbb755cadc97d21d77fb96dda;hpb=8a8ee2d7d791b7a3efaed06420802a925d16fca3;p=clsql.git diff --git a/db-odbc/odbc-api.lisp b/db-odbc/odbc-api.lisp index c5cca32..b17af02 100644 --- a/db-odbc/odbc-api.lisp +++ b/db-odbc/odbc-api.lisp @@ -6,7 +6,7 @@ ;;;; Purpose: Low-level ODBC API using UFFI ;;;; Authors: Kevin M. Rosenberg and Paul Meurer ;;;; -;;;; $Id: odbc-package.lisp 7061 2003-09-07 06:34:45Z kevin $ +;;;; $Id$ ;;;; ;;;; This file, part of CLSQL, is Copyright (c) 2004 by Kevin M. Rosenberg ;;;; and Copyright (C) Paul Meurer 1999 - 2001. All rights reserved. @@ -44,8 +44,10 @@ as possible second argument) to the desired representation of date/time/timestam (let ((size (gensym))) `(let ((,size (length ,string))) (when (and ,max-length (> ,size ,max-length)) - (error "string \"~a\" of length ~d is longer than max-length: ~d" - ,string ,size ,max-length)) + (error 'clsql:sql-database-data-error + :message + (format nil "string \"~a\" of length ~d is longer than max-length: ~d" + ,string ,size ,max-length))) (with-cast-pointer (char-ptr ,ptr :byte) (dotimes (i ,size) (setf (deref-array char-ptr '(:array :byte) i) @@ -113,21 +115,21 @@ as possible second argument) to the desired representation of date/time/timestam (progn ,result-code ,@body)) (#.$SQL_INVALID_HANDLE (error - 'clsql-sys:clsql-odbc-error - :odbc-message "Invalid handle")) + 'clsql-sys:sql-database-error + :message "ODBC: Invalid handle")) (#.$SQL_STILL_EXECUTING (error - 'clsql-sys:clsql-odbc-error - :odbc-message "Still executing")) + 'clsql-sys:sql-temporary-error + :message "ODBC: Still executing")) (#.$SQL_ERROR (multiple-value-bind (error-message sql-state) (handle-error (or ,henv +null-handle-ptr+) (or ,hdbc +null-handle-ptr+) (or ,hstmt +null-handle-ptr+)) (error - 'clsql-sys:clsql-odbc-error - :odbc-message error-message - :sql-state sql-state))) + 'clsql-sys:sql-database-error + :message error-message + :secondary-error-id sql-state))) (#.$SQL_NO_DATA_FOUND (progn ,result-code ,@body)) ;; work-around for Allegro 7.0beta AMD64 which @@ -138,9 +140,9 @@ as possible second argument) to the desired representation of date/time/timestam (or ,hdbc +null-handle-ptr+) (or ,hstmt +null-handle-ptr+)) (error - 'clsql-sys:clsql-odbc-error - :odbc-message error-message - :sql-state sql-state)) + 'clsql-sys:sql-database-error + :message error-message + :secondary-error-id sql-state)) #+ignore (progn ,result-code ,@body)))))) @@ -252,7 +254,7 @@ as possible second argument) to the desired representation of date/time/timestam (SQLAllocStmt hdbc hstmt-ptr) (deref-pointer hstmt-ptr 'sql-handle))))) (if (uffi:null-pointer-p statement-handle) - (error "Received null statement handle.") + (error 'clsql:sql-database-error :message "Received null statement handle.") statement-handle))) (defun %sql-get-info (hdbc info-type) @@ -756,7 +758,8 @@ as possible second argument) to the desired representation of date/time/timestam (prog1 (cond (flatp (when (> column-count 1) - (error "If more than one column is to be fetched, flatp has to be nil.")) + (error 'clsql:sql-database-error + :message "If more than one column is to be fetched, flatp has to be nil.")) (loop until (= (%sql-fetch hstmt) $SQL_NO_DATA_FOUND) collect (read-data (aref data-ptrs 0) @@ -860,7 +863,7 @@ as possible second argument) to the desired representation of date/time/timestam data-ptr str offset data-length))) - (error "wrong type. preliminary.")) + (error 'clsql:sql-database-error :message "wrong type. preliminary.")) while (and (= res $SQL_SUCCESS_WITH_INFO) (equal (sql-state +null-handle-ptr+ +null-handle-ptr+ hstmt) "01004")) @@ -878,7 +881,7 @@ as possible second argument) to the desired representation of date/time/timestam data-ptr str offset (min out-len (1- +max-precision+)))) - (error "wrong type. preliminary.")) + (error 'clsql:sql-database-error :message "wrong type. preliminary.")) while (and (= res $SQL_SUCCESS_WITH_INFO) #+ingore(eq (sql-state +null-handle-ptr+ +null-handle-ptr+ hstmt)