X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=base%2Fconditions.lisp;h=138aa58fac6ddbdde4182d8a30f7b8b89ac79f08;hp=5f0fb3a09077a9a36922de7ff21cebd2a10dc654;hb=ce0e343835a040406678dff74a62d1b0cb56f317;hpb=998937376fa6f9ce29bd3c7954fb0ebca91c37d7 diff --git a/base/conditions.lisp b/base/conditions.lisp index 5f0fb3a..138aa58 100644 --- a/base/conditions.lisp +++ b/base/conditions.lisp @@ -2,15 +2,15 @@ ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; -;;;; Name: conditions.cl +;;;; Name: conditions.lisp ;;;; Purpose: Error conditions for high-level SQL interface ;;;; Programmers: Kevin M. Rosenberg based on ;;;; Original code by Pierre R. Mai ;;;; Date Started: Feb 2002 ;;;; -;;;; $Id: conditions.lisp,v 1.1 2002/09/30 10:19:01 kevin Exp $ +;;;; $Id$ ;;;; -;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg +;;;; This file, part of CLSQL, is Copyright (c) 2002-2004 by Kevin M. Rosenberg ;;;; and Copyright (c) 1999-2001 by Pierre R. Mai ;;;; ;;;; CLSQL users are granted the rights to distribute and use this software @@ -18,8 +18,7 @@ ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;;; ************************************************************************* -(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0))) -(in-package :clsql-base-sys) +(in-package #:clsql-base-sys) ;;; Conditions (define-condition clsql-condition () @@ -55,7 +54,7 @@ and signal an clsql-invalid-spec-error if they don't match." `(handler-case (destructuring-bind ,template ,connection-spec - (declare (ignore ,@template)) + (declare (ignore ,@(remove '&optional template))) t) (error () (error 'clsql-invalid-spec-error :connection-spec ,connection-spec @@ -157,3 +156,29 @@ and signal an clsql-invalid-spec-error if they don't match." 'clsql-nodb-error :database database)) +(defun signal-no-database-error () + (cerror "Ignore this error and return nil." + 'clsql-nodb-error)) + +;; for USQL support + +(define-condition clsql-type-error (clsql-error clsql-condition) + ((slotname :initarg :slotname + :reader clsql-type-error-slotname) + (typespec :initarg :typespec + :reader clsql-type-error-typespec) + (value :initarg :value + :reader clsql-type-error-value)) + (:report (lambda (c stream) + (format stream + "Invalid value ~A in slot ~A, not of type ~A." + (clsql-type-error-value c) + (clsql-type-error-slotname c) + (clsql-type-error-typespec c))))) + +(define-condition clsql-sql-syntax-error (clsql-error) + ((reason :initarg :reason + :reader clsql-sql-syntax-error-reason)) + (:report (lambda (c stream) + (format stream "Invalid SQL syntax: ~A" + (clsql-sql-syntax-error-reason c)))))