From 3acccef9826b2d59474d5d09bad453dba5df189c Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Fri, 6 Jun 2003 21:59:30 +0000 Subject: [PATCH] r5062: return from san diego --- clsql-tests.asd | 5 ++-- uffi/clsql-uffi.lisp | 56 ++++---------------------------------------- 2 files changed, 7 insertions(+), 54 deletions(-) diff --git a/clsql-tests.asd b/clsql-tests.asd index f9633ed..7c4a682 100644 --- a/clsql-tests.asd +++ b/clsql-tests.asd @@ -7,9 +7,10 @@ ;;;; Author: Kevin M. Rosenberg ;;;; Date Started: Apr 2003 ;;;; -;;;; $Id: clsql-tests.asd,v 1.2 2003/05/07 02:45:08 kevin Exp $ +;;;; $Id: clsql-tests.asd,v 1.3 2003/06/06 21:59:09 kevin Exp $ ;;;; ************************************************************************* +(in-package #:cl-user) (defpackage #:clsql-tests-system (:use #:asdf #:cl)) (in-package #:clsql-tests-system) @@ -32,7 +33,7 @@ (:file "tests" :depends-on ("package" "acl-compat-tester"))) ))) -(defmethod perform ((o test-op) (c (eql (find-system :clsql-tests)))) +(defmethod perform ((o test-op) (c (eql (find-system 'clsql-tests)))) (or (funcall (intern (symbol-name '#:do-tests) (find-package '#:regression-test))) (error "test-op failed"))) diff --git a/uffi/clsql-uffi.lisp b/uffi/clsql-uffi.lisp index fabf38a..41d38b0 100644 --- a/uffi/clsql-uffi.lisp +++ b/uffi/clsql-uffi.lisp @@ -7,7 +7,7 @@ ;;;; Programmers: Kevin M. Rosenberg ;;;; Date Started: Mar 2002 ;;;; -;;;; $Id: clsql-uffi.lisp,v 1.28 2003/05/29 05:19:50 kevin Exp $ +;;;; $Id: clsql-uffi.lisp,v 1.29 2003/06/06 21:59:09 kevin Exp $ ;;;; ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -82,9 +82,6 @@ (defmacro split-64-bit-integer (int64) `(values (ash ,int64 -32) (logand ,int64 +2^32-1+))) -(defvar +ascii-N-value+ (char-code #\N)) -(defvar +ascii-U-value+ (char-code #\U)) - (uffi:def-type char-ptr-def (* :unsigned-char)) (defun char-ptr-points-to-null (char-ptr) @@ -92,9 +89,8 @@ ;; Uses short cut and returns T if first character is #\N. It should ;; never be non-numeric (declare (type char-ptr-def char-ptr)) - (let ((char (uffi:ensure-char-character - (uffi:deref-pointer char-ptr :char)))) - (char-equal char #\N))) + (char-equal #\N (uffi:ensure-char-character + (uffi:deref-pointer char-ptr :char)))) (defun convert-raw-field (char-ptr types index) (let ((type (if (listp types) @@ -119,49 +115,5 @@ low32 (make-64-bit-integer high32 low32))))) (t - #+(or allegro lispworks) (native-to-string char-ptr) ;; optimized - #-(or allegro lispworks) (uffi:convert-from-foreign-string char-ptr))))))) + (uffi:convert-from-foreign-string char-ptr :locale :none))))))) - -(uffi:def-function "strlen" - ((str (* :unsigned-char))) - :returning :unsigned-int) - -#+(or lispworks (and allegro ics)) -(defun native-to-string (s) - (declare (optimize (speed 3) (space 0) (safety 0) (compilation-speed 0)) - (type char-ptr-def s)) - (let* ((len (strlen s)) - (str (make-string len))) - (declare (fixnum len) - (simple-string str)) - (do ((i 0)) - ((= i len)) - (declare (fixnum i)) - (setf (schar str i) - (code-char (uffi:deref-array s '(:array :unsigned-char) i))) - (incf i)) - str)) - -#+(and allegro (not ics)) -(defun native-to-string (s) - (declare (optimize (speed 3) (space 0) (safety 0) (compilation-speed 0)) - (type char-ptr-def s)) - (let* ((len (strlen s)) - (len4 (floor len 4)) - (str (make-string len))) - (declare (fixnum len) - (type (simple-array (signed-byte 32) (*)) str)) - (do ((i 0)) - ((= i len4)) - (declare (fixnum i)) - (setf (aref (the (simple-array (signed-byte 32) (*)) str) i) - (uffi:deref-array s '(:array :int) i)) - (incf i)) - (do ((i (* 4 len4))) - ((= i len)) - (declare (fixnum i)) - (setf (aref (the (simple-array (signed-byte 8) (*)) str) i) - (uffi:deref-array s '(:array :unsigned-char) i)) - (incf i)) - str)) -- 2.34.1