5 Jun 2007 21:21
clisp-cvs Digest, Vol 14, Issue 2
<clisp-cvs-request <at> lists.sourceforge.net>
2007-06-05 19:21:12 GMT
2007-06-05 19:21:12 GMT
Send clisp-cvs mailing list submissions to clisp-cvs <at> lists.sourceforge.net To subscribe or unsubscribe via the World Wide Web, visit https://lists.sourceforge.net/lists/listinfo/clisp-cvs or, via email, send a message with subject or body 'help' to clisp-cvs-request <at> lists.sourceforge.net You can reach the person managing the list at clisp-cvs-owner <at> lists.sourceforge.net When replying, please edit your Subject line so it is more specific than "Re: Contents of clisp-cvs digest..." CLISP CVS commits for today Today's Topics: 1. clisp/modules/fastcgi fastcgi.lisp,1.14,1.15 (Sam Steingold) 2. clisp/modules/oracle oracle.lisp,1.27,1.28 (Sam Steingold) 3. clisp/tests ext-clisp.tst,NONE,1.1 ChangeLog,1.510,1.511 (Jörg Höhle) ---------------------------------------------------------------------- Message: 1 Date: Tue, 05 Jun 2007 15:41:15 +0000 From: Sam Steingold <sds <at> users.sourceforge.net> Subject: clisp/modules/fastcgi fastcgi.lisp,1.14,1.15 To: clisp-cvs <at> lists.sourceforge.net Message-ID: <E1Hvb9p-0006pu-RL <at> mail.sourceforge.net> Update of /cvsroot/clisp/clisp/modules/fastcgi In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv25372/modules/fastcgi Modified Files: fastcgi.lisp Log Message: use CL idioms: DIGIT-CHAR-P, OR, UNLESS et al Index: fastcgi.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/modules/fastcgi/fastcgi.lisp,v retrieving revision 1.14 retrieving revision 1.15 diff -u -d -r1.14 -r1.15 --- fastcgi.lisp 6 Feb 2007 03:29:28 -0000 1.14 +++ fastcgi.lisp 5 Jun 2007 15:41:13 -0000 1.15 <at> <at> -115,15 +115,10 <at> <at> ; ---------------- Internal functions -;; HEX-VALUE -- Get integer value of single upper-case hex digit +;; HEX-VALUE -- Get integer value of single hex digit (defun hex-value (h) - (cond ((and (char>= h #\A) (char<= h #\F)) - (+ 10 (- (char-code h) (char-code #\A)))) - ((and (char>= h #\a) (char<= h #\f)) - (+ 10 (- (char-code h) (char-code #\a)))) - ((and (char>= h #\0) (char<= h #\9)) - (- (char-code h) (char-code #\0))) - (t (error "~S: Invalid hex digit ~S" 'hex-value h)))) + (or (digit-char-p h 16) + (error "~S: Invalid hex digit ~S" 'hex-value h))) ;; HEX-BYTE-VALUE -- Get byte value of pair of hex digits (defun hex-byte-value (h1 h2) ------------------------------ Message: 2 Date: Tue, 05 Jun 2007 15:41:15 +0000 From: Sam Steingold <sds <at> users.sourceforge.net> Subject: clisp/modules/oracle oracle.lisp,1.27,1.28 To: clisp-cvs <at> lists.sourceforge.net Message-ID: <E1Hvb9p-0000me-8l <at> mail.sourceforge.net> Update of /cvsroot/clisp/clisp/modules/oracle In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv25372/modules/oracle Modified Files: oracle.lisp Log Message: use CL idioms: DIGIT-CHAR-P, OR, UNLESS et al Index: oracle.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/modules/oracle/oracle.lisp,v retrieving revision 1.27 retrieving revision 1.28 diff -u -d -r1.27 -r1.28 --- oracle.lisp 6 Feb 2007 03:29:28 -0000 1.27 +++ oracle.lisp 5 Jun 2007 15:41:13 -0000 1.28 <at> <at> -43,7 +43,7 <at> <at> column-names columns comma-list-of-keys commit commit-nocheck connect connection-key convert-type c-truth curconn disconnect do-rows-col do-rows-index-of do-rows-var eof fetch flatten from-sqlval -gethash-required hash-combine hash-to-sqlparam-array if-null +gethash-required hash-combine hash-to-sqlparam-array insert-row is-select-query join lisp-truth nl out out-nl pairs-to-hash peek rollback rollback-nocheck row-count row-to-result rowval run-sql to-sqlval to-string update-row valid-symbol <at> <at> -70,9 +70,8 <at> <at> ; Shorthand for current library handle (defun curconn () - (if (null *oracle-connection*) - nil - (db-connection *oracle-connection*))) + (and *oracle-connection* + (db-connection *oracle-connection*))) ; "C" DATA TYPES (oiface.h) <at> <at> -144,13 +143,13 <at> <at> (when *oracle-in-transaction* (db-error "CONNECT not allowed inside WITH-TRANSACTION")) ; Default current schema - (if (null schema) (setf schema user)) - (if (null long-len) (setf long-len -1)) - (if (null prefetch-buffer-bytes) (setf prefetch-buffer-bytes 0)) + (unless schema (setf schema user)) + (unless long-len (setf long-len -1)) + (unless prefetch-buffer-bytes (setf prefetch-buffer-bytes 0)) ; Set up global connection cache - (if (null *oracle-connection-cache*) - (setf *oracle-connection-cache* (make-hash-table :test #'equal))) + (unless *oracle-connection-cache* + (setf *oracle-connection-cache* (make-hash-table :test #'equal))) ; Construct key for connection cache (let* ((hkey (connection-key user schema server connid)) <at> <at> -803,9 +802,9 <at> <at> ; TO-SQLVAL ; Return a SQL val for LISP object, handling null case (defun to-sqlval (x) - (if (null x) - (make-sqlval :data "" :is_null 1) - (make-sqlval :data (to-string x) :is_null 0))) + (if x + (make-sqlval :data (to-string x) :is_null 0) + (make-sqlval :data "" :is_null 1))) ; FROM-SQLVAL ; Return Lisp Object (string or NIL) for SQL val, handling null case <at> <at> -824,7 +823,7 <at> <at> ; Convert a hash table map of name->value strings to an array of SQL ; bind params suitable for passing to ORACLE_EXEC_SQL (defun hash-to-sqlparam-array (h) - (if (null h) (setf h (make-hash-table :test #'equal))) + (unless h (setf h (make-hash-table :test #'equal))) (let* ((count (hash-table-count h)) (result (make-array count)) (i 0)) <at> <at> -841,10 +840,10 <at> <at> ; CHECK-CONNECTION ; Check we are connected before doing an operation that requires a connection (defun check-connection (&optional action) - (if (null (curconn)) - (db-error (cat "Attempt to " - (if-null action "perform database operation") - " when not connected to any database")))) + (unless (curconn) + (db-error (cat "Attempt to " + (or action "perform database operation") + " when not connected to any database")))) ; CONNECTION-KEY ; Construct key suitable for use in hash table keyed on <at> <at> -859,8 +858,7 <at> <at> ; PAIRS-TO-HASH ; Convert a list of pairs ((key1 val1) (key2 val2) ...) to hash, enforcing key uniqueness (defun pairs-to-hash (plist) - (if (null plist) - nil + (and plist (let ((result (make-hash-table :test #'equal))) (loop for p in plist do (let ((key (string-upcase (to-string (first p)))) <at> <at> -978,15 +976,11 <at> <at> (:return-type c-string)) -; =-=-=-=-=-=-=- LOW LEVEL UTILITY FUNCTIONS =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- - -; IF-NULL -; Default a null value. Is there a better Lisp built-in for this? -(defun if-null (value default) (if (null value) default value)) +; =-=-=-=-=-=-=- LOW LEVEL UTILITY FUNCTIONS =-=-=-=-=-=-=-=-=-=-=-=-=-=-=- ; AREF-NULL ; Do an AREF, but allow array to be null, in which case return NIL -(defun aref-null (a i) (if (null a) nil (aref a i))) +(defun aref-null (a i) (and a (aref a i))) ; HASH-COMBINE ; Combine two hash table. Keys of the second hash will overwrite. <at> <at> -1015,31 +1009,31 <at> <at> ; CAT ; Concatenate strings (defun cat (&rest args) - (apply #'concatenate 'string (mapcar #'to-string (flatten args)))) + (apply #'ext:string-concat (mapcar #'to-string (flatten args)))) ; ARRAY-TO-HASH ; Convert array of row values to hash using column info (defun array-to-hash (row) - (if (null row) - nil - (let* ((cols (columns)) - (n (length row)) - (result (make-hash-table :test #'equal :size n))) - (loop for i from 0 to (- n 1) do - (setf (gethash (to-string (sqlcol-name (aref cols i))) result) (aref row i))) - result))) + (and row + (let* ((cols (columns)) + (n (length row)) + (result (make-hash-table :test #'equal :size n))) + (loop for i from 0 to (- n 1) do + (setf (gethash (to-string (sqlcol-name (aref cols i))) result) + (aref row i))) + result))) ; CHECK-UNIQUE-ELEMENTS ; Does list consist of unqiue, non-null elements (defun check-unique-elements (l) (let ((h (make-hash-table :test #'equal))) (dolist (elt l) - (when (null elt) - (db-error "Null element in column/variable list")) - (when (gethash (to-string elt) h) - (db-error (cat "DO-ROWS: Parameter/column '" elt "' occurs more than once in bound columns/variables:~%" - (join "~%" l)))) - (setf (gethash (to-string elt) h) t)) + (when (null elt) + (db-error "Null element in column/variable list")) + (when (gethash (to-string elt) h) + (db-error (cat "DO-ROWS: Parameter/column '" elt "' occurs more than once in bound columns/variables:~%" + (join "~%" l)))) + (setf (gethash (to-string elt) h) t)) t)) ; JOIN <at> <at> -1048,9 +1042,9 <at> <at> (defun join (delimiter seq) (let ((result "")) (loop for i from 0 to (- (length seq) 1) do - (when (> i 0) - (setf result (cat result delimiter))) - (setf result (cat result (nth i seq)))) + (when (> i 0) + (setf result (cat result delimiter))) + (setf result (cat result (nth i seq)))) result)) ; WHILE (macro) <at> <at> -1082,13 +1076,8 <at> <at> ;; HEX-VALUE -- Get integer value of single upper-case hex digit (defun hex-value (h) - (cond ((and (char>= h #\A) (char<= h #\F)) - (+ 10 (- (char-code h) (char-code #\A)))) - ((and (char>= h #\a) (char<= h #\f)) - (+ 10 (- (char-code h) (char-code #\a)))) - ((and (char>= h #\0) (char<= h #\9)) - (- (char-code h) (char-code #\0))) - (t (error "~S: Invalid hex digit ~S" 'hex-value h)))) + (or (digit-char-p h 16) + (error "~S: Invalid hex digit ~S" 'hex-value h))) ;; HEX-BYTE-VALUE -- Get byte value of pair of hex digits (defun hex-byte-value (h1 h2) ------------------------------ Message: 3 Date: Tue, 05 Jun 2007 18:13:01 +0000 From: Jörg Höhle <hoehle <at> users.sourceforge.net> Subject: clisp/tests ext-clisp.tst,NONE,1.1 ChangeLog,1.510,1.511 To: clisp-cvs <at> lists.sourceforge.net Message-ID: <E1HvdWg-0005Wo-R5 <at> mail.sourceforge.net> Update of /cvsroot/clisp/clisp/tests In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv13259 Modified Files: ChangeLog Added Files: ext-clisp.tst Log Message: New file ext-clisp.tst --- NEW FILE: ext-clisp.tst --- (This appears to be a binary file; contents omitted.) Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/tests/ChangeLog,v retrieving revision 1.510 retrieving revision 1.511 diff -u -d -r1.510 -r1.511 --- ChangeLog 7 May 2007 04:18:54 -0000 1.510 +++ ChangeLog 5 Jun 2007 18:12:59 -0000 1.511 <at> <at> -1,3 +1,8 <at> <at> +2007-06-05 Jörg Höhle <hoehle <at> users.sourceforge.net> + + * ext-clisp.tst: new file + check clisp specific extensions not tested in alltest or other files. + 2007-05-06 Sam Steingold <sds <at> gnu.org> * excepsit.tst: (defun if) signals a PROGRAM-ERROR <at> <at> -6,6 +11,11 <at> <at> * symbols.tst: test for [ 1713130 ]: some CL symbols are not locked +2007-04-27 Jörg Höhle <hoehle <at> users.sourceforge.net> + + * unportable.tst: new file + check behaviour ANSI CL says implementation-defined or -dependent + 2007-01-10 Sam Steingold <sds <at> podval.org> * encoding.tst: test for [ 1632718 ]: CONVERT-STRING-FROM-BYTES ------------------------------ ------------------------------------------------------------------------- This SF.net email is sponsored by DB2 Express Download DB2 Express C - the FREE version of DB2 express and take control of your XML. No limits. Just data. Click to get it now. http://sourceforge.net/powerbar/db2/ ------------------------------ _______________________________________________ clisp-cvs mailing list clisp-cvs <at> lists.sourceforge.net https://lists.sourceforge.net/lists/listinfo/clisp-cvs End of clisp-cvs Digest, Vol 14, Issue 2 ****************************************
------------------------------------------------------------------------- This SF.net email is sponsored by DB2 Express Download DB2 Express C - the FREE version of DB2 express and take control of your XML. No limits. Just data. Click to get it now. http://sourceforge.net/powerbar/db2/
_______________________________________________ clisp-devel mailing list clisp-devel <at> lists.sourceforge.net https://lists.sourceforge.net/lists/listinfo/clisp-devel
RSS Feed