From 073f21db1363d6af5980f185b7ea2a85baf1d8ec Mon Sep 17 00:00:00 2001 From: Sabra Crolleton <sabra.crolleton@gmail.com> Date: Wed, 22 Sep 2021 10:39:17 -0400 Subject: [PATCH 1/5] Just an in-process commit of the abcl cluster fuck --- cl-postgres.asd | 4 +- cl-postgres/communicate.lisp | 2 + cl-postgres/interpret.lisp | 38 ++++++-- cl-postgres/messages.lisp | 1 + cl-postgres/protocol.lisp | 94 +++++++++++++------ cl-postgres/public.lisp | 18 +++- cl-postgres/tests/test-binary-parameters.lisp | 6 +- cl-postgres/tests/tests.lisp | 2 +- postmodern.asd | 3 +- postmodern/config.lisp | 1 + .../tests/test-prepared-statements.lisp | 26 ++--- postmodern/tests/tests.lisp | 2 +- s-sql/tests/test-arrays.lisp | 4 +- s-sql/tests/tests.lisp | 6 +- simple-date.asd | 2 +- 15 files changed, 139 insertions(+), 70 deletions(-) diff --git a/cl-postgres.asd b/cl-postgres.asd index c19fdb96..b92b8f4b 100644 --- a/cl-postgres.asd +++ b/cl-postgres.asd @@ -7,8 +7,8 @@ ;; Change this to enable/disable unicode manually (mind that it won't ;; work unless your implementation supports it). (defparameter *unicode* - #+(or sb-unicode unicode ics openmcl-unicode-strings) t - #-(or sb-unicode unicode ics openmcl-unicode-strings) nil) + #+(or sb-unicode unicode ics openmcl-unicode-strings abcl) t + #-(or sb-unicode unicode ics openmcl-unicode-strings abcl) nil) (defparameter *string-file* (if *unicode* "strings-utf-8" "strings-ascii")) (defsystem "cl-postgres" diff --git a/cl-postgres/communicate.lisp b/cl-postgres/communicate.lisp index d1283a4e..597eee9d 100644 --- a/cl-postgres/communicate.lisp +++ b/cl-postgres/communicate.lisp @@ -8,6 +8,7 @@ (eval-when (:compile-toplevel :load-toplevel :execute) (defun integer-reader-name (bytes signed) (intern (with-standard-io-syntax + (log:info "communicate:integer-reader-name bytes ~a signed ~a" bytes signed) (format nil "~a~a~a~a" '#:read- (if signed "" '#:u) '#:int bytes)))) (defun integer-writer-name (bytes signed) @@ -17,6 +18,7 @@ (defmacro integer-reader (bytes) "Create a function to read integers from a binary stream." + (log:info "integer-reader bytes ~a" bytes) (let ((bits (* bytes 8))) (labels ((return-form (signed) (if signed diff --git a/cl-postgres/interpret.lisp b/cl-postgres/interpret.lisp index b4898d93..604f094b 100644 --- a/cl-postgres/interpret.lisp +++ b/cl-postgres/interpret.lisp @@ -20,6 +20,7 @@ case you can create separate read tables.") "This interpreter is used for types that we have no specific interpreter for -- it just reads the value as a string. \(Values of unknown types are passed in text form.)" + (log:info "interpret:interpret-as-text") (enc-read-string stream :byte-length size)) (defclass type-interpreter () @@ -37,6 +38,7 @@ unknown types are passed in text form.)" (defun interpreter-binary-p (interp) "If the interpreter's use-binary field is a function, call it and return the value, otherwise, return T or nil as appropriate." + (log:info "interpret:interpreter-binary-p param ~a~%" interp) (let ((val (type-interpreter-use-binary interp))) (typecase val (function (funcall val)) @@ -45,6 +47,7 @@ return the value, otherwise, return T or nil as appropriate." (defun interpreter-reader (interp) "Determine if we went the text or binary reader for this type interpreter and return the appropriate reader." + (log:info "interpret:interpreter-reader param ~a~%" interp) (if (interpreter-binary-p interp) (type-interpreter-binary-reader interp) (type-interpreter-text-reader interp))) @@ -56,6 +59,7 @@ interpreter and return the appropriate reader." (defun get-type-interpreter (oid) "Returns a type-interpreter containing interpretation rules for this type." + (log:info "interpret:get-type-interpreter oid ~a~%" oid) (gethash oid *sql-readtable* default-interpreter))) (defun set-sql-reader (oid function &key (table *sql-readtable*) binary-p) @@ -99,6 +103,7 @@ interpreted as an array of the given type." (size-name (gensym)) (length-used 0)) (flet ((read-type (type &optional modifier) + (log:info "interpret:binary-reader type ~a" type) (ecase type (bytes `(read-bytes ,stream-name (- ,size-name ,length-used))) (string `(enc-read-string ,stream-name @@ -122,11 +127,15 @@ interpreted as an array of the given type." (type integer ,size-name) (ignorable ,size-name)) ,(if (consp fields) - `(let ,(loop :for field :in fields - :collect `(,(first field) - ,(apply #'read-type (cdr field)))) - ,@value) - (read-type fields (car value))))))) + (progn + (log:info "interpret:binary-reader 2 fields ~a" fields) + `(let ,(loop :for field :in fields + :collect `(,(first field) + ,(apply #'read-type (cdr field)))) + ,@value)) + (progn + (log:info "interpret:binary-reader 3 fields ~a" fields) + (read-type fields (car value)))))))) (defmacro define-interpreter (oid name fields &body value) "Shorthand for defining binary readers." @@ -158,12 +167,15 @@ interpreted as an array of the given type." (defun read-row-value (stream size) (declare (type stream stream) (type integer size) - (ignore size)) +; (ignore size) + ) + (log:info "interpret:read-row-value-1 size ~a~%" size) (let ((num-fields (read-uint4 stream))) (loop for i below num-fields collect (let ((oid (read-uint4 stream)) (size (read-int4 stream))) (declare (type (signed-byte 32) size)) + (log:info "interpret:read-row-value-2 oid ~a size ~a~%" oid size) (if (eq size -1) :null (funcall (interpreter-reader (get-type-interpreter oid)) @@ -195,6 +207,7 @@ executing body so that row values will be returned as t." (defun read-binary-bits (stream size) (declare (type stream stream) (type integer size)) + (log:info "interpret:read-binary-bits size ~a~%" size) (let ((byte-count (- size 4)) (bit-count (read-uint4 stream))) (let ((bit-bytes (read-bytes stream byte-count)) @@ -214,10 +227,13 @@ executing body so that row values will be returned as t." (defun read-binary-array-value (stream size) (declare (type stream stream) (type integer size) - (ignore size)) +; (ignore size) + ) + (log:info "interpret:read-binary-array-value-1 size ~a~%" size) (let ((num-dims (read-uint4 stream)) (has-null (read-uint4 stream)) (element-type (read-uint4 stream))) + (log:info "interpret:read-binary-array-value-2 has-null ~a element-type ~a~%" has-null element-type) (cond ((zerop num-dims) ;; Should we return nil or a (make-array nil) when num-dims is @@ -462,6 +478,7 @@ e.g. (declare (type string value)) (let ((pos 0)) (declare (type fixnum pos)) + (log:info "read-array-value transform ~a~%" transform) (labels ((readelt () (case (char value pos) (#\" (interpret @@ -486,10 +503,13 @@ e.g. (return (interpret (subseq value start pos)))) (incf pos)))))) (interpret (word) - (if (string= word "NULL") :null (funcall transform word)))) + (if (string= word "NULL") + :null + (funcall transform word)))) (let* ((arr (readelt)) (dim (if arr (loop :for x := arr :then (car x) :while (consp x) - :collect (length x)) '(0)))) + :collect (length x)) + '(0)))) (make-array dim :initial-contents arr)))))) ;; Working with tables. diff --git a/cl-postgres/messages.lisp b/cl-postgres/messages.lisp index dab8a6e5..151b00cf 100644 --- a/cl-postgres/messages.lisp +++ b/cl-postgres/messages.lisp @@ -221,6 +221,7 @@ for binding data for binary long object columns." (aref param-values i) value))) (declare (inline set-param)) (cond ((eq param :null) + (log:info "messages:bind-message param ~a~%" param) (set-param 0 0 nil)) ((typep param '(vector (unsigned-byte 8))) ;param already in binary form (set-param 1 (length param) param)) diff --git a/cl-postgres/protocol.lisp b/cl-postgres/protocol.lisp index 52cea056..4762d054 100644 --- a/cl-postgres/protocol.lisp +++ b/cl-postgres/protocol.lisp @@ -44,6 +44,7 @@ from the socket." (size-sym (and (eq (car clauses) :length-sym) (progn (pop clauses) (pop clauses))))) + (flet ((expand-characters (chars) (cond ((eq chars t) (setf t-found t) t) ((consp chars) (mapcar #'char-code chars)) @@ -56,6 +57,7 @@ from the socket." (declare (type (unsigned-byte 8) ,char-name) (type (unsigned-byte 32) ,size-name) (ignorable ,size-name)) + (log:info "protocol:message-case char-name ~a" ,char-name) (case ,char-name (#.(char-code #\A) (get-notification ,socket-name) @@ -85,8 +87,8 @@ from the socket." (error 'protocol-error :message (format nil - "Unexpected message received: ~A" - (code-char ,char-name)))))))))) + "Unexpected message received: ~A ~a" + (code-char ,char-name) ,char-name))))))))) (,iter-name)))))) @@ -358,6 +360,8 @@ array of field-description objects." (declare (ignore table-oid column size type-modifier format) (type string name) (type (unsigned-byte 32) type-id)) + (log:info "protocol:read-field-description type-id ~a binary? ~a~%" + type-id (interpreter-binary-p interpreter)) (setf (elt descriptions i) (if (interpreter-binary-p interpreter) (make-instance 'field-description @@ -392,32 +396,49 @@ copy-in/copy-out states \(which are not supported)." #.*optimize*) (loop (message-case socket - ;; CommandComplete - (#\C (let* ((command-tag (read-str socket)) - (space (position #\Space command-tag - :from-end t))) - (when space - (setf *effected-rows* - (parse-integer command-tag :junk-allowed t - :start (1+ space)))) - (return-from look-for-row nil))) - ;; CopyInResponse - (#\G (read-uint1 socket) - (skip-bytes socket (* 2 (read-uint2 socket))) ; The field formats - (copy-done-message socket) - (error 'database-error - :message "Copy-in not supported.")) - ;; CopyOutResponse - (#\H (read-uint1 socket) - (skip-bytes socket (* 2 (read-uint2 socket))) ; The field formats - (error 'database-error - :message "Copy-out not supported.")) - ;; DataRow - (#\D (skip-bytes socket 2) - (return-from look-for-row t)) - ;; EmptyQueryResponse - (#\I (warn "Empty query sent.") - (return-from look-for-row nil))))) + ;; CommandComplete + (#\C (let* ((command-tag (read-str socket)) + (space (position #\Space command-tag + :from-end t))) + (log:info "protocol:look-for-row-1 command-tag ~a~%" command-tag) + (when space + (log:info "protocol:look-for-row-1 have space command-tag ~a~%" + (parse-integer command-tag :junk-allowed t + :start (1+ space))) + (setf *effected-rows* + (parse-integer command-tag :junk-allowed t + :start (1+ space)))) + (return-from look-for-row nil))) + ;; CopyInResponse + (#\G (read-uint1 socket) + (skip-bytes socket (* 2 (read-uint2 socket))) ; The field formats + (copy-done-message socket) + (error 'database-error + :message "Copy-in not supported.")) + ;; CopyOutResponse + (#\H (read-uint1 socket) + (skip-bytes socket (* 2 (read-uint2 socket))) ; The field formats + (error 'database-error + :message "Copy-out not supported.")) + ;; DataRow + (#\D (skip-bytes socket 2) + (return-from look-for-row t)) + ;; EmptyQueryResponse + (#\I (warn "Empty query sent.") + (return-from look-for-row nil)) + #+abcl (#\Return + (let* ((command-tag (read-str socket)) + (space (position #\Space command-tag + :from-end t))) + (log:info "protocol:look-for-row-3 command-tag ~a~%" command-tag) + (when space + (log:info "protocol:look-for-row-1 have space command-tag ~a~%" + (parse-integer command-tag :junk-allowed t + :start (1+ space))) + (setf *effected-rows* + (parse-integer command-tag :junk-allowed t + :start (1+ space)))) + (return-from look-for-row nil)))))) (defun try-to-sync (socket sync-sent) "Try to re-synchronize a connection by sending a sync message if it @@ -476,6 +497,7 @@ results." (declare (type stream socket) (type string query) #.*optimize*) + (log:info "protocol:send-query1") (with-syncing (with-query (query) (let ((row-description nil)) @@ -504,10 +526,16 @@ results." (message-case socket ;; BindComplete (#\2)) + (log:info "protocol:send-query2") (returning-effected-rows (if row-description - (funcall row-reader socket row-description) - (look-for-row socket)) + (progn + (log:info "protocol:send-query3") + (funcall row-reader socket row-description)) + (progn + (log:info "protocol:send-query 4") + (look-for-row socket) + (log:info "protocol:send-query 5"))) (message-case socket ;; ReadyForQuery, skipping transaction status (#\Z (read-uint1 socket)))))))) @@ -549,6 +577,7 @@ and apply the given row-reader to the result." (type string name) (type list parameters) #.*optimize*) + (log:info "protocol:send-execute") (with-syncing (let ((row-description nil) (n-parameters 0)) @@ -582,7 +611,10 @@ and apply the given row-reader to the result." (returning-effected-rows (if row-description (funcall row-reader socket row-description) - (look-for-row socket)) + (progn + (log:info "send-execute-1") + (look-for-row socket) + (log:info "send-execute-2"))) (message-case socket ;; CommandComplete (#\C (read-str socket) diff --git a/cl-postgres/public.lisp b/cl-postgres/public.lisp index 66bc8297..b8c43f65 100644 --- a/cl-postgres/public.lisp +++ b/cl-postgres/public.lisp @@ -238,11 +238,13 @@ if it isn't." (cond ((equal (connection-host conn) :unix) (assert-unix) - (unix-socket-connect (unix-socket-path *unix-socket-dir* (connection-port conn)))) + (unix-socket-connect (unix-socket-path *unix-socket-dir* + (connection-port conn)))) ((and (stringp (connection-host conn)) (char= #\/ (aref (connection-host conn) 0))) (assert-unix) - (unix-socket-connect (unix-socket-path (connection-host conn) (connection-port conn)))) + (unix-socket-connect (unix-socket-path (connection-host conn) + (connection-port conn)))) ((and (pathnamep (connection-host conn)) (eql :absolute (pathname-directory (connection-host conn)))) (assert-unix) @@ -499,5 +501,15 @@ Postgresql is expecting the parameters to be in text format." error)))))) (def-row-reader ignore-row-reader (fields) (loop :while (next-row) :do (loop :for field :across fields - :do (next-field field))) + :do + (next-field field))) + (values)) + +(def-row-reader debug-row-reader (fields) + (loop :while (next-row) + :do (loop :for field :across fields + :do + (log:info "public:debug-row-reader field-name ~a field-type ~a interpreter " + (field-name field)(field-type field)) + (next-field field))) (values)) diff --git a/cl-postgres/tests/test-binary-parameters.lisp b/cl-postgres/tests/test-binary-parameters.lisp index 0de2393f..2946daa7 100644 --- a/cl-postgres/tests/test-binary-parameters.lisp +++ b/cl-postgres/tests/test-binary-parameters.lisp @@ -529,7 +529,7 @@ unless it would have been valid as a text parameter." (vector-to-hex-string random-bytes) "\")")))))))))) -(test binary-write-row-array-bytea +#-abcl (test binary-write-row-array-bytea1 (with-binary-test-connection (exec-query connection "create temporary table test (a bytea)") (let ((*random-byte-count* 16)) @@ -545,7 +545,7 @@ unless it would have been valid as a text parameter." (is (equalp (exec-query connection "select row(ARRAY[a]) from test;" 'list-row-reader) `(((#(,random-bytes))))))))))) -(test binary-write-row-array-bytea +(test binary-write-row-array-bytea2 (with-binary-test-connection (with-binary-row-values (exec-query connection "create temporary table test (a bytea)") @@ -680,7 +680,7 @@ unless it would have been valid as a text parameter." (is (equalp (exec-query connection "select row((ARRAY[1,3,4])[5:99])" 'list-row-reader) '(((NIL)))))))) -(test binary-row-array-nulls-binary-2 +#-abcl (test binary-row-array-nulls-binary-2 (with-binary-test-connection (cl-postgres::with-binary-row-values (is (equalp (exec-query connection "select row(ARRAY[NULL, NULL]);" 'list-row-reader) diff --git a/cl-postgres/tests/tests.lisp b/cl-postgres/tests/tests.lisp index d45b4264..18021d22 100644 --- a/cl-postgres/tests/tests.lisp +++ b/cl-postgres/tests/tests.lisp @@ -769,7 +769,7 @@ variables:~:{~% ~A: ~(~A~), ~:[defaults to \"~A\"~;~:*provided \"~A\"~]~}~%" (is (equalp (exec-query connection "select row((ARRAY[1,3,4])[5:99])" 'list-row-reader) '(((NIL)))))))) -(test row-array-nulls-binary-2 +#-abcl (test row-array-nulls-binary-2 (with-test-connection (cl-postgres::with-binary-row-values (is (equalp (exec-query connection "select row(ARRAY[NULL, NULL]);" 'list-row-reader) diff --git a/postmodern.asd b/postmodern.asd index ebac42f8..dc730ed4 100644 --- a/postmodern.asd +++ b/postmodern.asd @@ -67,7 +67,8 @@ (:file "test-return-types-timestamps" :depends-on ("test-package" "tests")) (:file "test-transactions" :depends-on ("test-package" "tests")) (:file "test-roles" :depends-on ("test-package" "tests")) - (:file "test-dao" :depends-on ("test-package" "tests")) + #-abcl (:file "test-dao" :depends-on ("test-package" "tests")) + #+abcl (:file "abcl-test-dao" :depends-on ("test-package" "tests")) (:file "test-execute-file" :depends-on ("test-package" "tests"))))) :perform (test-op (o c) diff --git a/postmodern/config.lisp b/postmodern/config.lisp index 093705a2..eb910d08 100644 --- a/postmodern/config.lisp +++ b/postmodern/config.lisp @@ -44,6 +44,7 @@ different than the query statement provided to ensure-prepared.") ;; Query Parameters (defparameter *result-styles* '((:none ignore-row-reader all-rows) + (:debug cl-postgres::debug-row-reader all-rows) (:lists list-row-reader all-rows) (:list list-row-reader single-row) (:rows list-row-reader all-rows) diff --git a/postmodern/tests/test-prepared-statements.lisp b/postmodern/tests/test-prepared-statements.lisp index 939931c3..53fa40e1 100644 --- a/postmodern/tests/test-prepared-statements.lisp +++ b/postmodern/tests/test-prepared-statements.lisp @@ -63,7 +63,7 @@ postmodern meta connection and in Postgresql" ;; CHANGE HERE TO SIGNALS ERROR - (is (equal (funcall select-int :null) +#-abcl (is (equal (funcall select-int :null) :NULL)) ;mismatched parameter types if the connection is set for binary ;; parameter passing ;; the funcall creates the prepared statements logged in the postmodern connection @@ -203,7 +203,7 @@ postmodern meta connection and in Postgresql" (with-non-binary-fixture (without-binary (defprepared select1 "select c from test_data where a = $1" :single) - (is (eq :null (funcall 'select1 2))) + #-abcl (is (eq :null (funcall 'select1 2))) (drop-prepared-statement "all") (is (equal 0 (length (list-prepared-statements t)))) (is (equal 0 (length (list-postmodern-prepared-statements t)))) @@ -211,7 +211,7 @@ postmodern meta connection and in Postgresql" (defprepared select1 "select c from test_data where a = $1" :single) (disconnect *database*) (signals error (query "select c from test_data where a = 2" :single)) - (is (eq :null (funcall 'select1 2))))))) + #-abcl (is (eq :null (funcall 'select1 2))))))) (test prepare-5 "Test to ensure that we do not recreate the statement each time it is funcalled" @@ -393,13 +393,13 @@ postmodern meta connection and in Postgresql" ;; Defprepared does not change the prepared statements logged in the postmodern connection or ;; in the postgresql connection. That will happen when the prepared statement is funcalled. (defprepared select-1 "select c from test_data where a = $1" :single) - (is (eq :null (funcall 'select-1 2))) +#-abcl (is (eq :null (funcall 'select-1 2))) ;; recreate select1, then drop the connection and call select1 (disconnect *database*) (signals error (query "select c from test_data where a = 2" :single)) (signals error (query "select c from test_data where a = 2" :single)) (signals error (funcall 'select-1 "2a")) - (is (eq :null (funcall 'select-1 2))))))) +#-abcl (is (eq :null (funcall 'select-1 2))))))) (test prepare-reserved-words (with-test-connection @@ -434,7 +434,7 @@ postmodern meta connection and in Postgresql" ;; CHANGE HERE TO SIGNALS ERROR if bnary - (is (equal (funcall select-int :null) +#-abcl (is (equal (funcall select-int :null) :NULL)) ;; the funcall creates the prepared statements logged in the postmodern connection ;; and the postgresql connection @@ -600,15 +600,15 @@ postmodern meta connection and in Postgresql" (with-non-binary-fixture (without-binary (defprepared select1 "select c from test_data where a = $1" :single) - (is (eq :null (funcall 'select1 2))) +#-abcl (is (eq :null (funcall 'select1 2))) (drop-prepared-statement "all") (is (equal 0 (length (list-prepared-statements t)))) (is (equal 0 (length (list-postmodern-prepared-statements t)))) ;; recreate select1, then drop the connection and call select1 (defprepared select1 "select c from test_data where a = $1" :single) (disconnect *database*) - (is (eq :null (query "select c from test_data where a = 2" :single))) - (is (eq :null (funcall 'select1 2))) +#-abcl (is (eq :null (query "select c from test_data where a = 2" :single))) +#-abcl (is (eq :null (funcall 'select1 2))) (drop-prepared-statement "all"))))) (test prepare-5-pooled @@ -800,13 +800,13 @@ postmodern meta connection and in Postgresql" ;; Defprepared does not change the prepared statements logged in the postmodern connection or ;; in the postgresql connection. That will happen when the prepared statement is funcalled. (defprepared select-1 "select c from test_data where a = $1" :single) - (is (eq :null (funcall 'select-1 2))) +#-abcl (is (eq :null (funcall 'select-1 2))) ;; recreate select1, then drop the connection and call select1 (disconnect *database*) - (is (eq :null (query "select c from test_data where a = 2" :single))) +#-abcl (is (eq :null (query "select c from test_data where a = 2" :single))) (signals error (funcall 'select-1 "2a")) - (is (eq :null (funcall 'select-1 2))) - (is (eq :null (select-1 2))) +#-abcl (is (eq :null (funcall 'select-1 2))) +#-abcl (is (eq :null (select-1 2))) (drop-prepared-statement "all"))))) (test prepare-reserved-words-pooled diff --git a/postmodern/tests/tests.lisp b/postmodern/tests/tests.lisp index 6f75c9d2..76b25129 100644 --- a/postmodern/tests/tests.lisp +++ b/postmodern/tests/tests.lisp @@ -165,7 +165,7 @@ (is (table-exists-p 'test-data)) (execute (:insert-into 'test-data :set 'a 1 'b 5.4 'c "foobar")) (execute (:insert-into 'test-data :set 'a 2 'b 88 'c :null)) - (is (equal (query (:order-by (:select '* :from 'test-data) 'a)) + #-abcl (is (equal (query (:order-by (:select '* :from 'test-data) 'a)) '((1 5.4 "foobar") (2 88.0 :null)))) (execute (:drop-table 'test-data))) diff --git a/s-sql/tests/test-arrays.lisp b/s-sql/tests/test-arrays.lisp index 8663c538..d5abb9c9 100644 --- a/s-sql/tests/test-arrays.lisp +++ b/s-sql/tests/test-arrays.lisp @@ -438,14 +438,14 @@ equality tests with arrays requires equalp, not equal." (is (equalp (query (:select (:array-replace (:array[] 1 2 5 4) 5 3)) :single) #(1 2 3 4))) ;;; checking array-to-string (concatenates array elements using supplied delimiter and optional null string) - (is (equal (query (:select (:array-to-string (:array[] 1 2 3 :NULL 5) "," "*")) :single) +#-abcl (is (equal (query (:select (:array-to-string (:array[] 1 2 3 :NULL 5) "," "*")) :single) "1,2,3,*,5")) ;;; checking array-upper (returns upper bound of the requested array dimension) (is (equal (query (:select (:array-upper (:array[] 1 8 3 7) 1)) :single) 4)) ;;; checking string-to-array (splits string into array elements using ;;; supplied delimiter and optional null string) - (is (equalp (query (:select (:string-to-array "xx~^~yy~^~zz" "~^~" "yy")) :single) +#-abcl (is (equalp (query (:select (:string-to-array "xx~^~yy~^~zz" "~^~" "yy")) :single) #("xx" :NULL "zz"))) ;;; checking unnest (expand an array to a set of rows) (is (equalp (query (:select (:unnest (:array[] 1 2)))) diff --git a/s-sql/tests/tests.lisp b/s-sql/tests/tests.lisp index f19ee5cf..e1e736da 100644 --- a/s-sql/tests/tests.lisp +++ b/s-sql/tests/tests.lisp @@ -1007,7 +1007,7 @@ To sum the column len of all films and group the results by kind:" (:set (:set 'd1) (:set 'd2 'd3))))) "(SELECT d1, d2, d3, SUM(v) FROM test_cube GROUP BY GROUPING SETS ((d1), (d2, d3)))")) - (is (equal (with-test-connection +#-abcl (is (equal (with-test-connection (query (:select 'city (:as (:extract 'year 'start-date) 'joining-year) (:as (:count 1) 'employee_count) :from 'employee @@ -1679,7 +1679,7 @@ To sum the column len of all films and group the results by kind:" :on (:= 1 1))) "(SELECT pet, ordinality, tag FROM pets LEFT JOIN LATERAL unnest(tags) WITH ORDINALITY ON (1 = 1))")) - (is (equal (query (:select 'pet 'sort-order 'tag +#-abcl (is (equal (query (:select 'pet 'sort-order 'tag :from 'pets :left-join-lateral (:unnest 'tags) :with-ordinality-as (:f 'tag 'sort-order) @@ -2461,7 +2461,7 @@ that the table will need to be scanned twice. Everything is a trade-off." (with-test-connection (is (equalp (query (:select (:regexp_match "foobarbequebaz" "bar.*que")) :single) #("barbeque"))) - (is (equal (query (:select (:regexp_match "foobarbequebaz" "bar.~que")) :single) +#-abcl (is (equal (query (:select (:regexp_match "foobarbequebaz" "bar.~que")) :single) :NULL)) (is (equal (query (:select (:~ "foobarbequebaz" "bar.*que") ) :single) t)) diff --git a/simple-date.asd b/simple-date.asd index 5f4fe4b8..52614402 100644 --- a/simple-date.asd +++ b/simple-date.asd @@ -22,7 +22,7 @@ (uiop:symbol-call :fiveam '#:run! :simple-date))) (defsystem "simple-date/postgres-glue" - :depends-on ("simple-date" "cl-postgres") + :depends-on ("simple-date" "cl-postgres" "cl-postgres/tests") :components ((:module "simple-date" :components From a20f7a76ffa6790f8960b729e2381f63fca31488 Mon Sep 17 00:00:00 2001 From: Sabra Crolleton <sabra.crolleton@gmail.com> Date: Sun, 26 Sep 2021 12:03:44 -0400 Subject: [PATCH 2/5] Fix abcl issues with :null and unicode --- README.md | 4 +- cl-postgres/communicate.lisp | 2 - cl-postgres/interpret.lisp | 30 ++++--------- cl-postgres/messages.lisp | 1 - cl-postgres/protocol.lisp | 42 +++---------------- cl-postgres/public.lisp | 9 ---- cl-postgres/tests/test-binary-parameters.lisp | 3 +- cl-postgres/tests/tests.lisp | 2 +- doc/index.html | 3 +- doc/index.org | 3 +- .../tests/test-prepared-statements.lisp | 26 ++++++------ postmodern/tests/tests.lisp | 2 +- s-sql/tests/test-arrays.lisp | 4 +- s-sql/tests/tests.lisp | 9 ++-- 14 files changed, 43 insertions(+), 97 deletions(-) diff --git a/README.md b/README.md index 16378a6e..84702493 100644 --- a/README.md +++ b/README.md @@ -625,7 +625,9 @@ the same sample data looks like: The Lisp code in Postmodern is theoretically portable across implementations, and seems to work on all major ones as well as some minor ones such as Genera. -It is regularly tested on ccl, sbcl, ecl and cmucl. ABCL currently has issues with utf-8 and :null. +It is regularly tested on ccl, sbcl, ecl and cmucl. + +ABCL version 1.8.0 broke the dao class inheritance. See [https://abcl.org/trac/ticket/479](https://abcl.org/trac/ticket/479). Everything other than dao-classes works. Please let us know if it does not work on the implementation that you normally use. Implementations that do not have meta-object protocol support will not have DAOs, but all other parts of the library should work (all widely used implementations do support this). diff --git a/cl-postgres/communicate.lisp b/cl-postgres/communicate.lisp index 597eee9d..d1283a4e 100644 --- a/cl-postgres/communicate.lisp +++ b/cl-postgres/communicate.lisp @@ -8,7 +8,6 @@ (eval-when (:compile-toplevel :load-toplevel :execute) (defun integer-reader-name (bytes signed) (intern (with-standard-io-syntax - (log:info "communicate:integer-reader-name bytes ~a signed ~a" bytes signed) (format nil "~a~a~a~a" '#:read- (if signed "" '#:u) '#:int bytes)))) (defun integer-writer-name (bytes signed) @@ -18,7 +17,6 @@ (defmacro integer-reader (bytes) "Create a function to read integers from a binary stream." - (log:info "integer-reader bytes ~a" bytes) (let ((bits (* bytes 8))) (labels ((return-form (signed) (if signed diff --git a/cl-postgres/interpret.lisp b/cl-postgres/interpret.lisp index 604f094b..b23c9ecb 100644 --- a/cl-postgres/interpret.lisp +++ b/cl-postgres/interpret.lisp @@ -20,7 +20,6 @@ case you can create separate read tables.") "This interpreter is used for types that we have no specific interpreter for -- it just reads the value as a string. \(Values of unknown types are passed in text form.)" - (log:info "interpret:interpret-as-text") (enc-read-string stream :byte-length size)) (defclass type-interpreter () @@ -38,7 +37,6 @@ unknown types are passed in text form.)" (defun interpreter-binary-p (interp) "If the interpreter's use-binary field is a function, call it and return the value, otherwise, return T or nil as appropriate." - (log:info "interpret:interpreter-binary-p param ~a~%" interp) (let ((val (type-interpreter-use-binary interp))) (typecase val (function (funcall val)) @@ -47,7 +45,6 @@ return the value, otherwise, return T or nil as appropriate." (defun interpreter-reader (interp) "Determine if we went the text or binary reader for this type interpreter and return the appropriate reader." - (log:info "interpret:interpreter-reader param ~a~%" interp) (if (interpreter-binary-p interp) (type-interpreter-binary-reader interp) (type-interpreter-text-reader interp))) @@ -59,7 +56,6 @@ interpreter and return the appropriate reader." (defun get-type-interpreter (oid) "Returns a type-interpreter containing interpretation rules for this type." - (log:info "interpret:get-type-interpreter oid ~a~%" oid) (gethash oid *sql-readtable* default-interpreter))) (defun set-sql-reader (oid function &key (table *sql-readtable*) binary-p) @@ -103,7 +99,6 @@ interpreted as an array of the given type." (size-name (gensym)) (length-used 0)) (flet ((read-type (type &optional modifier) - (log:info "interpret:binary-reader type ~a" type) (ecase type (bytes `(read-bytes ,stream-name (- ,size-name ,length-used))) (string `(enc-read-string ,stream-name @@ -128,14 +123,11 @@ interpreted as an array of the given type." (ignorable ,size-name)) ,(if (consp fields) (progn - (log:info "interpret:binary-reader 2 fields ~a" fields) `(let ,(loop :for field :in fields :collect `(,(first field) ,(apply #'read-type (cdr field)))) ,@value)) - (progn - (log:info "interpret:binary-reader 3 fields ~a" fields) - (read-type fields (car value)))))))) + (read-type fields (car value))))))) (defmacro define-interpreter (oid name fields &body value) "Shorthand for defining binary readers." @@ -166,17 +158,14 @@ interpreted as an array of the given type." (defun read-row-value (stream size) (declare (type stream stream) - (type integer size) -; (ignore size) - ) - (log:info "interpret:read-row-value-1 size ~a~%" size) + (type integer size)) (let ((num-fields (read-uint4 stream))) (loop for i below num-fields collect (let ((oid (read-uint4 stream)) (size (read-int4 stream))) (declare (type (signed-byte 32) size)) - (log:info "interpret:read-row-value-2 oid ~a size ~a~%" oid size) - (if (eq size -1) + (if #-abcl (eq size -1) + #+abcl (eql size -1) :null (funcall (interpreter-reader (get-type-interpreter oid)) stream size)))))) @@ -207,7 +196,6 @@ executing body so that row values will be returned as t." (defun read-binary-bits (stream size) (declare (type stream stream) (type integer size)) - (log:info "interpret:read-binary-bits size ~a~%" size) (let ((byte-count (- size 4)) (bit-count (read-uint4 stream))) (let ((bit-bytes (read-bytes stream byte-count)) @@ -226,14 +214,10 @@ executing body so that row values will be returned as t." (defun read-binary-array-value (stream size) (declare (type stream stream) - (type integer size) -; (ignore size) - ) - (log:info "interpret:read-binary-array-value-1 size ~a~%" size) + (type integer size)) (let ((num-dims (read-uint4 stream)) (has-null (read-uint4 stream)) (element-type (read-uint4 stream))) - (log:info "interpret:read-binary-array-value-2 has-null ~a element-type ~a~%" has-null element-type) (cond ((zerop num-dims) ;; Should we return nil or a (make-array nil) when num-dims is @@ -252,7 +236,8 @@ executing body so that row values will be returned as t." do (let ((size (read-int4 stream))) (declare (type (signed-byte 32) size)) (setf (row-major-aref results i) - (if (eq size -1) + (if #-abcl (eq size -1) + #+abcl (eql size -1) :null (funcall (interpreter-reader @@ -478,7 +463,6 @@ e.g. (declare (type string value)) (let ((pos 0)) (declare (type fixnum pos)) - (log:info "read-array-value transform ~a~%" transform) (labels ((readelt () (case (char value pos) (#\" (interpret diff --git a/cl-postgres/messages.lisp b/cl-postgres/messages.lisp index 151b00cf..dab8a6e5 100644 --- a/cl-postgres/messages.lisp +++ b/cl-postgres/messages.lisp @@ -221,7 +221,6 @@ for binding data for binary long object columns." (aref param-values i) value))) (declare (inline set-param)) (cond ((eq param :null) - (log:info "messages:bind-message param ~a~%" param) (set-param 0 0 nil)) ((typep param '(vector (unsigned-byte 8))) ;param already in binary form (set-param 1 (length param) param)) diff --git a/cl-postgres/protocol.lisp b/cl-postgres/protocol.lisp index 4762d054..9d07e0ba 100644 --- a/cl-postgres/protocol.lisp +++ b/cl-postgres/protocol.lisp @@ -57,7 +57,6 @@ from the socket." (declare (type (unsigned-byte 8) ,char-name) (type (unsigned-byte 32) ,size-name) (ignorable ,size-name)) - (log:info "protocol:message-case char-name ~a" ,char-name) (case ,char-name (#.(char-code #\A) (get-notification ,socket-name) @@ -360,8 +359,6 @@ array of field-description objects." (declare (ignore table-oid column size type-modifier format) (type string name) (type (unsigned-byte 32) type-id)) - (log:info "protocol:read-field-description type-id ~a binary? ~a~%" - type-id (interpreter-binary-p interpreter)) (setf (elt descriptions i) (if (interpreter-binary-p interpreter) (make-instance 'field-description @@ -400,11 +397,7 @@ copy-in/copy-out states \(which are not supported)." (#\C (let* ((command-tag (read-str socket)) (space (position #\Space command-tag :from-end t))) - (log:info "protocol:look-for-row-1 command-tag ~a~%" command-tag) (when space - (log:info "protocol:look-for-row-1 have space command-tag ~a~%" - (parse-integer command-tag :junk-allowed t - :start (1+ space))) (setf *effected-rows* (parse-integer command-tag :junk-allowed t :start (1+ space)))) @@ -425,20 +418,7 @@ copy-in/copy-out states \(which are not supported)." (return-from look-for-row t)) ;; EmptyQueryResponse (#\I (warn "Empty query sent.") - (return-from look-for-row nil)) - #+abcl (#\Return - (let* ((command-tag (read-str socket)) - (space (position #\Space command-tag - :from-end t))) - (log:info "protocol:look-for-row-3 command-tag ~a~%" command-tag) - (when space - (log:info "protocol:look-for-row-1 have space command-tag ~a~%" - (parse-integer command-tag :junk-allowed t - :start (1+ space))) - (setf *effected-rows* - (parse-integer command-tag :junk-allowed t - :start (1+ space)))) - (return-from look-for-row nil)))))) + (return-from look-for-row nil))))) (defun try-to-sync (socket sync-sent) "Try to re-synchronize a connection by sending a sync message if it @@ -497,7 +477,6 @@ results." (declare (type stream socket) (type string query) #.*optimize*) - (log:info "protocol:send-query1") (with-syncing (with-query (query) (let ((row-description nil)) @@ -526,16 +505,10 @@ results." (message-case socket ;; BindComplete (#\2)) - (log:info "protocol:send-query2") (returning-effected-rows (if row-description - (progn - (log:info "protocol:send-query3") - (funcall row-reader socket row-description)) - (progn - (log:info "protocol:send-query 4") - (look-for-row socket) - (log:info "protocol:send-query 5"))) + (funcall row-reader socket row-description) + (look-for-row socket)) (message-case socket ;; ReadyForQuery, skipping transaction status (#\Z (read-uint1 socket)))))))) @@ -577,7 +550,6 @@ and apply the given row-reader to the result." (type string name) (type list parameters) #.*optimize*) - (log:info "protocol:send-execute") (with-syncing (let ((row-description nil) (n-parameters 0)) @@ -611,10 +583,7 @@ and apply the given row-reader to the result." (returning-effected-rows (if row-description (funcall row-reader socket row-description) - (progn - (log:info "send-execute-1") - (look-for-row socket) - (log:info "send-execute-2"))) + (look-for-row socket)) (message-case socket ;; CommandComplete (#\C (read-str socket) @@ -635,7 +604,8 @@ and apply the given row-reader to the result." (declare (type field-description field)) (let ((size (read-int4 ,socket))) (declare (type (signed-byte 32) size)) - (if (eq size -1) + (if #-abcl (eq size -1) + #+abcl (eql size -1) :null (funcall (field-interpreter field) ,socket size))))) diff --git a/cl-postgres/public.lisp b/cl-postgres/public.lisp index b8c43f65..eb822590 100644 --- a/cl-postgres/public.lisp +++ b/cl-postgres/public.lisp @@ -504,12 +504,3 @@ Postgresql is expecting the parameters to be in text format." error)))))) :do (next-field field))) (values)) - -(def-row-reader debug-row-reader (fields) - (loop :while (next-row) - :do (loop :for field :across fields - :do - (log:info "public:debug-row-reader field-name ~a field-type ~a interpreter " - (field-name field)(field-type field)) - (next-field field))) - (values)) diff --git a/cl-postgres/tests/test-binary-parameters.lisp b/cl-postgres/tests/test-binary-parameters.lisp index 2946daa7..8dd1ff1c 100644 --- a/cl-postgres/tests/test-binary-parameters.lisp +++ b/cl-postgres/tests/test-binary-parameters.lisp @@ -529,6 +529,7 @@ unless it would have been valid as a text parameter." (vector-to-hex-string random-bytes) "\")")))))))))) +;;; ABCL would fail on this test because it would need *read-row-values-as-binary* to be set to t #-abcl (test binary-write-row-array-bytea1 (with-binary-test-connection (exec-query connection "create temporary table test (a bytea)") @@ -680,7 +681,7 @@ unless it would have been valid as a text parameter." (is (equalp (exec-query connection "select row((ARRAY[1,3,4])[5:99])" 'list-row-reader) '(((NIL)))))))) -#-abcl (test binary-row-array-nulls-binary-2 +(test binary-row-array-nulls-binary-2 (with-binary-test-connection (cl-postgres::with-binary-row-values (is (equalp (exec-query connection "select row(ARRAY[NULL, NULL]);" 'list-row-reader) diff --git a/cl-postgres/tests/tests.lisp b/cl-postgres/tests/tests.lisp index 18021d22..d45b4264 100644 --- a/cl-postgres/tests/tests.lisp +++ b/cl-postgres/tests/tests.lisp @@ -769,7 +769,7 @@ variables:~:{~% ~A: ~(~A~), ~:[defaults to \"~A\"~;~:*provided \"~A\"~]~}~%" (is (equalp (exec-query connection "select row((ARRAY[1,3,4])[5:99])" 'list-row-reader) '(((NIL)))))))) -#-abcl (test row-array-nulls-binary-2 +(test row-array-nulls-binary-2 (with-test-connection (cl-postgres::with-binary-row-values (is (equalp (exec-query connection "select row(ARRAY[NULL, NULL]);" 'list-row-reader) diff --git a/doc/index.html b/doc/index.html index 0c5c0549..174ed036 100644 --- a/doc/index.html +++ b/doc/index.html @@ -1760,7 +1760,8 @@ <h3 id="bdf9ddb0-5f95-4807-8862-8970b35bd142">Portability</h3> </p> <p> -ABCL currently has issues with utf-8 and :null.. + ABCL version 1.8.0 broke the dao class inheritance. See <a href="https://abcl.org/trac/ticket/479">https://abcl.org/trac/ticket/479</a>. + Everything other than dao-classes works. </p> <p> diff --git a/doc/index.org b/doc/index.org index 161be80a..1bbbc57d 100644 --- a/doc/index.org +++ b/doc/index.org @@ -858,7 +858,8 @@ The Lisp code in Postmodern is theoretically portable across implementations, and seems to work on all major ones as well as some minor ones such as Genera. It is regularly tested on ccl, sbcl, ecl and cmucl. -ABCL currently has issues with utf-8 and :null.. +ABCL version 1.8.0 broke the dao class inheritance. See [[https://abcl.org/trac/ticket/479]]. +Everything other than dao-classes works. Implementations that do not have meta-object protocol support will not have DAOs, but all other parts of the library should work (all widely used diff --git a/postmodern/tests/test-prepared-statements.lisp b/postmodern/tests/test-prepared-statements.lisp index 53fa40e1..939931c3 100644 --- a/postmodern/tests/test-prepared-statements.lisp +++ b/postmodern/tests/test-prepared-statements.lisp @@ -63,7 +63,7 @@ postmodern meta connection and in Postgresql" ;; CHANGE HERE TO SIGNALS ERROR -#-abcl (is (equal (funcall select-int :null) + (is (equal (funcall select-int :null) :NULL)) ;mismatched parameter types if the connection is set for binary ;; parameter passing ;; the funcall creates the prepared statements logged in the postmodern connection @@ -203,7 +203,7 @@ postmodern meta connection and in Postgresql" (with-non-binary-fixture (without-binary (defprepared select1 "select c from test_data where a = $1" :single) - #-abcl (is (eq :null (funcall 'select1 2))) + (is (eq :null (funcall 'select1 2))) (drop-prepared-statement "all") (is (equal 0 (length (list-prepared-statements t)))) (is (equal 0 (length (list-postmodern-prepared-statements t)))) @@ -211,7 +211,7 @@ postmodern meta connection and in Postgresql" (defprepared select1 "select c from test_data where a = $1" :single) (disconnect *database*) (signals error (query "select c from test_data where a = 2" :single)) - #-abcl (is (eq :null (funcall 'select1 2))))))) + (is (eq :null (funcall 'select1 2))))))) (test prepare-5 "Test to ensure that we do not recreate the statement each time it is funcalled" @@ -393,13 +393,13 @@ postmodern meta connection and in Postgresql" ;; Defprepared does not change the prepared statements logged in the postmodern connection or ;; in the postgresql connection. That will happen when the prepared statement is funcalled. (defprepared select-1 "select c from test_data where a = $1" :single) -#-abcl (is (eq :null (funcall 'select-1 2))) + (is (eq :null (funcall 'select-1 2))) ;; recreate select1, then drop the connection and call select1 (disconnect *database*) (signals error (query "select c from test_data where a = 2" :single)) (signals error (query "select c from test_data where a = 2" :single)) (signals error (funcall 'select-1 "2a")) -#-abcl (is (eq :null (funcall 'select-1 2))))))) + (is (eq :null (funcall 'select-1 2))))))) (test prepare-reserved-words (with-test-connection @@ -434,7 +434,7 @@ postmodern meta connection and in Postgresql" ;; CHANGE HERE TO SIGNALS ERROR if bnary -#-abcl (is (equal (funcall select-int :null) + (is (equal (funcall select-int :null) :NULL)) ;; the funcall creates the prepared statements logged in the postmodern connection ;; and the postgresql connection @@ -600,15 +600,15 @@ postmodern meta connection and in Postgresql" (with-non-binary-fixture (without-binary (defprepared select1 "select c from test_data where a = $1" :single) -#-abcl (is (eq :null (funcall 'select1 2))) + (is (eq :null (funcall 'select1 2))) (drop-prepared-statement "all") (is (equal 0 (length (list-prepared-statements t)))) (is (equal 0 (length (list-postmodern-prepared-statements t)))) ;; recreate select1, then drop the connection and call select1 (defprepared select1 "select c from test_data where a = $1" :single) (disconnect *database*) -#-abcl (is (eq :null (query "select c from test_data where a = 2" :single))) -#-abcl (is (eq :null (funcall 'select1 2))) + (is (eq :null (query "select c from test_data where a = 2" :single))) + (is (eq :null (funcall 'select1 2))) (drop-prepared-statement "all"))))) (test prepare-5-pooled @@ -800,13 +800,13 @@ postmodern meta connection and in Postgresql" ;; Defprepared does not change the prepared statements logged in the postmodern connection or ;; in the postgresql connection. That will happen when the prepared statement is funcalled. (defprepared select-1 "select c from test_data where a = $1" :single) -#-abcl (is (eq :null (funcall 'select-1 2))) + (is (eq :null (funcall 'select-1 2))) ;; recreate select1, then drop the connection and call select1 (disconnect *database*) -#-abcl (is (eq :null (query "select c from test_data where a = 2" :single))) + (is (eq :null (query "select c from test_data where a = 2" :single))) (signals error (funcall 'select-1 "2a")) -#-abcl (is (eq :null (funcall 'select-1 2))) -#-abcl (is (eq :null (select-1 2))) + (is (eq :null (funcall 'select-1 2))) + (is (eq :null (select-1 2))) (drop-prepared-statement "all"))))) (test prepare-reserved-words-pooled diff --git a/postmodern/tests/tests.lisp b/postmodern/tests/tests.lisp index 76b25129..6f75c9d2 100644 --- a/postmodern/tests/tests.lisp +++ b/postmodern/tests/tests.lisp @@ -165,7 +165,7 @@ (is (table-exists-p 'test-data)) (execute (:insert-into 'test-data :set 'a 1 'b 5.4 'c "foobar")) (execute (:insert-into 'test-data :set 'a 2 'b 88 'c :null)) - #-abcl (is (equal (query (:order-by (:select '* :from 'test-data) 'a)) + (is (equal (query (:order-by (:select '* :from 'test-data) 'a)) '((1 5.4 "foobar") (2 88.0 :null)))) (execute (:drop-table 'test-data))) diff --git a/s-sql/tests/test-arrays.lisp b/s-sql/tests/test-arrays.lisp index d5abb9c9..3fabde4b 100644 --- a/s-sql/tests/test-arrays.lisp +++ b/s-sql/tests/test-arrays.lisp @@ -438,14 +438,14 @@ equality tests with arrays requires equalp, not equal." (is (equalp (query (:select (:array-replace (:array[] 1 2 5 4) 5 3)) :single) #(1 2 3 4))) ;;; checking array-to-string (concatenates array elements using supplied delimiter and optional null string) -#-abcl (is (equal (query (:select (:array-to-string (:array[] 1 2 3 :NULL 5) "," "*")) :single) + (is (equal (query (:select (:array-to-string (:array[] 1 2 3 :NULL 5) "," "*")) :single) "1,2,3,*,5")) ;;; checking array-upper (returns upper bound of the requested array dimension) (is (equal (query (:select (:array-upper (:array[] 1 8 3 7) 1)) :single) 4)) ;;; checking string-to-array (splits string into array elements using ;;; supplied delimiter and optional null string) -#-abcl (is (equalp (query (:select (:string-to-array "xx~^~yy~^~zz" "~^~" "yy")) :single) + (is (equalp (query (:select (:string-to-array "xx~^~yy~^~zz" "~^~" "yy")) :single) #("xx" :NULL "zz"))) ;;; checking unnest (expand an array to a set of rows) (is (equalp (query (:select (:unnest (:array[] 1 2)))) diff --git a/s-sql/tests/tests.lisp b/s-sql/tests/tests.lisp index e1e736da..5a0c5f70 100644 --- a/s-sql/tests/tests.lisp +++ b/s-sql/tests/tests.lisp @@ -45,7 +45,7 @@ (is (not (null *database*))))) (defun build-null-test-table () - "Building a simple table just to test the implementation can return :null. ABCL I am looking at you." + "Building a simple table just to test the implementation can return :null." (with-test-connection (query (:drop-table :if-exists 'null-test :cascade)) (query (:create-table 'null-test ((id :type serial :primary-key t :unique) @@ -1007,7 +1007,7 @@ To sum the column len of all films and group the results by kind:" (:set (:set 'd1) (:set 'd2 'd3))))) "(SELECT d1, d2, d3, SUM(v) FROM test_cube GROUP BY GROUPING SETS ((d1), (d2, d3)))")) -#-abcl (is (equal (with-test-connection + (is (equal (with-test-connection (query (:select 'city (:as (:extract 'year 'start-date) 'joining-year) (:as (:count 1) 'employee_count) :from 'employee @@ -1679,7 +1679,7 @@ To sum the column len of all films and group the results by kind:" :on (:= 1 1))) "(SELECT pet, ordinality, tag FROM pets LEFT JOIN LATERAL unnest(tags) WITH ORDINALITY ON (1 = 1))")) -#-abcl (is (equal (query (:select 'pet 'sort-order 'tag + (is (equal (query (:select 'pet 'sort-order 'tag :from 'pets :left-join-lateral (:unnest 'tags) :with-ordinality-as (:f 'tag 'sort-order) @@ -2359,7 +2359,6 @@ that the table will need to be scanned twice. Everything is a trade-off." "DROP VIEW quagmire")))) ;; Test create-table -;; Right now having difficulty with abcl and utf8, so separate test for it (test reserved-column-names-s-sql (with-test-connection (when (pomo:table-exists-p 'from-test-data1) @@ -2461,7 +2460,7 @@ that the table will need to be scanned twice. Everything is a trade-off." (with-test-connection (is (equalp (query (:select (:regexp_match "foobarbequebaz" "bar.*que")) :single) #("barbeque"))) -#-abcl (is (equal (query (:select (:regexp_match "foobarbequebaz" "bar.~que")) :single) + (is (equal (query (:select (:regexp_match "foobarbequebaz" "bar.~que")) :single) :NULL)) (is (equal (query (:select (:~ "foobarbequebaz" "bar.*que") ) :single) t)) From ac19f7edf466736f8e07daaf12cc60361fd33e19 Mon Sep 17 00:00:00 2001 From: Sabra Crolleton <sabra.crolleton@gmail.com> Date: Sun, 26 Sep 2021 13:22:03 -0400 Subject: [PATCH 3/5] fix binary-array test --- cl-postgres/tests/test-binary-parameters.lisp | 19 +------------------ 1 file changed, 1 insertion(+), 18 deletions(-) diff --git a/cl-postgres/tests/test-binary-parameters.lisp b/cl-postgres/tests/test-binary-parameters.lisp index 8dd1ff1c..279f1eb6 100644 --- a/cl-postgres/tests/test-binary-parameters.lisp +++ b/cl-postgres/tests/test-binary-parameters.lisp @@ -529,24 +529,7 @@ unless it would have been valid as a text parameter." (vector-to-hex-string random-bytes) "\")")))))))))) -;;; ABCL would fail on this test because it would need *read-row-values-as-binary* to be set to t -#-abcl (test binary-write-row-array-bytea1 - (with-binary-test-connection - (exec-query connection "create temporary table test (a bytea)") - (let ((*random-byte-count* 16)) - (unwind-protect - (let ((random-bytes (make-array *random-byte-count* - :element-type '(unsigned-byte 8) - :initial-element 0))) - (loop for i below *random-byte-count* - do (setf (aref random-bytes i) - (random #x100))) - (prepare-query connection "bytea-insert" "insert into test values ($1)") - (exec-prepared connection "bytea-insert" (list random-bytes)) - (is (equalp (exec-query connection "select row(ARRAY[a]) from test;" 'list-row-reader) - `(((#(,random-bytes))))))))))) - -(test binary-write-row-array-bytea2 +(test binary-write-row-array-bytea (with-binary-test-connection (with-binary-row-values (exec-query connection "create temporary table test (a bytea)") From 880dd87639ddb82f7cae22a33218061377bdfacc Mon Sep 17 00:00:00 2001 From: Sabra Crolleton <sabra.crolleton@gmail.com> Date: Sun, 26 Sep 2021 15:42:45 -0400 Subject: [PATCH 4/5] Fix clisp complaining about single-floats For clisp only, changed single-float references to float Also updated version number in the asd files --- cl-postgres.asd | 2 +- cl-postgres/data-types.lisp | 3 +- cl-postgres/sql-string.lisp | 4 +- cl-postgres/tests/test-data-types.lisp | 16 +++-- postmodern.asd | 2 +- postmodern/json-encoder.lisp | 9 ++- postmodern/tests/test-binary-parameters.lisp | 56 +++++++++------ postmodern/tests/test-execute-file.lisp | 72 ++++++++++---------- s-sql.asd | 2 +- 9 files changed, 98 insertions(+), 68 deletions(-) diff --git a/cl-postgres.asd b/cl-postgres.asd index b92b8f4b..85f0326a 100644 --- a/cl-postgres.asd +++ b/cl-postgres.asd @@ -16,7 +16,7 @@ :author "Marijn Haverbeke <marijnh@gmail.com>" :maintainer "Sabra Crolleton <sabra.crolleton@gmail.com>" :license "zlib" - :version "1.33.1" + :version "1.33.2" :depends-on ("md5" "split-sequence" "ironclad" "cl-base64" "uax-15" (:feature (:or :sbcl :allegro :ccl :clisp :genera :armedbear :cmucl :lispworks) diff --git a/cl-postgres/data-types.lisp b/cl-postgres/data-types.lisp index ca736b49..e1d532f7 100644 --- a/cl-postgres/data-types.lisp +++ b/cl-postgres/data-types.lisp @@ -189,7 +189,8 @@ when it is not will result in Postgresql throwing type mismatch errors." (int2 cl-postgres-oid:+int2+) (int4 cl-postgres-oid:+int4+) (int8 cl-postgres-oid:+int8+) - (single-float cl-postgres-oid:+float4+) + #-clisp (single-float cl-postgres-oid:+float4+) + #+clisp (float cl-postgres-oid:+float4+) (double-float cl-postgres-oid:+float8+) (boolean cl-postgres-oid:+bool+) (t 0))) diff --git a/cl-postgres/sql-string.lisp b/cl-postgres/sql-string.lisp index cae46bde..3a5b721d 100644 --- a/cl-postgres/sql-string.lisp +++ b/cl-postgres/sql-string.lisp @@ -151,7 +151,9 @@ that PostgreSQL understands when sent through its socket connection. May return a string or a (vector (unsigned-byte 8)).") (:method ((arg integer)) (int-to-vector arg)) - (:method ((arg single-float)) + #-clisp (:method ((arg single-float)) + (int32-to-vector (cl-postgres-ieee-floats:encode-float32 arg))) + #+clisp (:method ((arg float)) (int32-to-vector (cl-postgres-ieee-floats:encode-float32 arg))) #-clisp (:method ((arg double-float)) ;; CLISP doesn't allow methods on double-float (int64-to-vector (cl-postgres-ieee-floats:encode-float64 arg))) diff --git a/cl-postgres/tests/test-data-types.lisp b/cl-postgres/tests/test-data-types.lisp index 16813cd2..9f8cbe02 100644 --- a/cl-postgres/tests/test-data-types.lisp +++ b/cl-postgres/tests/test-data-types.lisp @@ -64,8 +64,10 @@ 123456789123456987654 'b #\d 12.2 nil t)) '(0 21 23 20 0 0 0 700 16 16))) - (is (equal (cl-postgres::parameter-list-types '(12413212.98324d0)) - '(701)))) + #-clisp (is (equal (cl-postgres::parameter-list-types '(12413212.98324d0)) + '(701))) + #+clisp (is (equal (cl-postgres::parameter-list-types '(12413212.98324d0)) + '(700)))) (test parameter-lists-match-oid-types (is (cl-postgres::parameter-lists-match-oid-types-p '(12413212.98324d0) '(124212.98324d0))) @@ -75,9 +77,15 @@ '(3))))) (test param-to-oid - (is (equal (loop for x in '(integer int2 int4 int8 boolean t nil float + #-clisp (is (equal (loop for x in '(integer int2 int4 int8 boolean t nil float double-float "jeff" 2 2000 12345678909 1.0 2.7d0 "12a") collect (list x (param-to-oid x))) '((INTEGER 0) (INT2 0) (INT4 0) (INT8 0) (BOOLEAN 0) (T 16) (NIL 16) (FLOAT 0) (DOUBLE-FLOAT 0) ("jeff" 0) (2 21) (2000 21) (12345678909 20) (1.0 700) - (2.7d0 701) ("12a" 0))))) + (2.7d0 701) ("12a" 0)))) + #+clisp (is (equal (loop for x in '(integer int2 int4 int8 boolean t nil float + double-float "jeff" 2 2000 12345678909 1.0 2.7d0 "12a") + collect (list x (param-to-oid x))) + '((INTEGER 0) (INT2 0) (INT4 0) (INT8 0) (BOOLEAN 0) (T 16) (NIL 16) (FLOAT 0) + (DOUBLE-FLOAT 0) ("jeff" 0) (2 21) (2000 21) (12345678909 20) (1.0 700) + (2.7d0 700) ("12a" 0))))) diff --git a/postmodern.asd b/postmodern.asd index dc730ed4..96d05070 100644 --- a/postmodern.asd +++ b/postmodern.asd @@ -20,7 +20,7 @@ :maintainer "Sabra Crolleton <sabra.crolleton@gmail.com>" :homepage "https://github.com/marijnh/Postmodern" :license "zlib" - :version "1.33.1" + :version "1.33.2" :depends-on ("alexandria" "cl-postgres" "s-sql" diff --git a/postmodern/json-encoder.lisp b/postmodern/json-encoder.lisp index 2f4eba68..b62cf820 100644 --- a/postmodern/json-encoder.lisp +++ b/postmodern/json-encoder.lisp @@ -498,14 +498,16 @@ characters in string S to STREAM." (format stream "\\~C~V,V,'0R" esc radix width code))))) (eval-when (:compile-toplevel) - (if (subtypep 'long-float 'single-float) + (if #-clisp (subtypep 'long-float 'single-float) + #+clisp (subtypep 'long-float 'float) ;; only one float type (pushnew :cl-json-only-one-float-type *features*) ;; else -- we check here only for the case where there are two ;; float types, single- and double- --- we don't consider the ;; "only single and short" case. Could be added if necessary. (progn - (when (subtypep 'single-float 'short-float) + (when #-clisp (subtypep 'single-float 'short-float) + #+clisp (subtypep 'float 'short-float) (pushnew :cl-json-single-float-is-subsumed *features*)) (when (subtypep 'long-float 'double-float) (pushnew :cl-json-double-float-is-subsumed *features*))))) @@ -517,7 +519,8 @@ characters in string S to STREAM." (real (let ((*read-default-float-format* (etypecase nr (short-float 'short-float) - (rational 'single-float) + #-clisp (rational 'single-float) + #+clisp (rational 'float) #-(or cl-json-single-float-is-subsumed cl-json-only-one-float-type) (single-float 'single-float) diff --git a/postmodern/tests/test-binary-parameters.lisp b/postmodern/tests/test-binary-parameters.lisp index 586432ca..83553e25 100644 --- a/postmodern/tests/test-binary-parameters.lisp +++ b/postmodern/tests/test-binary-parameters.lisp @@ -156,18 +156,22 @@ (is (equal (pomo:query (:select '$1) -1.4 :single) -1.4)) (is (equal (pomo:query "select $1" 2312321.321 :single) 2312321.3)) (is (equal (pomo:query "select $1" -2312321.321 :single) -2312321.3)) - (is (equal (pomo:query "select $1" 2312321.321d0 :single) 2312321.321d0)) - (is (equal (pomo:query "select $1" -2312321.321d0 :single) -2312321.321d0)) + #-clisp (is (equal (pomo:query "select $1" 2312321.321d0 :single) 2312321.321d0)) + #-clisp (is (equal (pomo:query "select $1" -2312321.321d0 :single) -2312321.321d0)) + #+clisp (is (equal (pomo:query "select $1" 2312321.321d0 :single) 2312321.3)) + #+clisp (is (equal (pomo:query "select $1" -2312321.321d0 :single) -2312321.3)) (is (equal (pomo:query "select $1" "foo" :single) "foo")) (is (equal (pomo:query (:select '$1) t :single) T)) (is (equal (pomo:query "select $1" t :single) T)) (is (equal (query "select $1" -64892312321987/1000 :single) "-64892312321.987")) - (is (equal (pomo:query "select $1::numeric(19,5)" -2312321.987d0 :single) - -2312321987/1000)) + #-clisp (is (equal (pomo:query "select $1::numeric(19,5)" -2312321.987d0 :single) + -2312321987/1000)) + #+clisp (is (equal (pomo:query "select $1::numeric(19,5)" -2312321.987d0 :single) + -2312320)) ;; The previous had an explicit double-float. If youremove the double float, it rounds down. Why? (is (equal (pomo:query "select $1::numeric(19,5)" -2312321.321 :single) - -2312320)) - ;; The following is because Postmodern will back out of binary parameters if any + -2312320)) + ;; The following is because Postmodern will back out of binary parameters if any ;; parameters are strings or other items that Postgresql might interpret as ;; different types. (is (equal (pomo:query (:select '$1 '$2) 1 "foo") '((1 "foo"))))))) @@ -321,8 +325,10 @@ '(("10" "20")))) (is (equal (pomo:query "select $1, $2" "10" (/ 1 3.0)) '(("10" "0.33333334")))) - (is (equal (pomo:query "select $1, $2" "10" (/ 1 3.0d0)) - '(("10" "3.333333333333333E-1")))) + #-clisp (is (equal (pomo:query "select $1, $2" "10" (/ 1 3.0d0)) + '(("10" "3.333333333333333E-1")))) + #+clisp (is (equal (pomo:query "select $1, $2" "10" (/ 1 3.0d0)) + '(("10" "0.3333333333333333")))) (is (equal (pomo:query "select $1, $2" "10" t) '(("10" "true")))) (is (equal (pomo:query "select $1, $2" "10" nil) @@ -357,8 +363,10 @@ '(("10" "20")))) (is (equal (pomo:query "select $1, $2" "10" (/ 1 3.0)) '(("10" "0.33333334")))) - (is (equal (pomo:query "select $1, $2" "10" (/ 1 3.0d0)) - '(("10" "3.333333333333333E-1")))) + #-clisp (is (equal (pomo:query "select $1, $2" "10" (/ 1 3.0d0)) + '(("10" "3.333333333333333E-1")))) + #+clisp (is (equal (pomo:query "select $1, $2" "10" (/ 1 3.0d0)) + '(("10" "0.3333333333333333")))) (is (equal (pomo:query "select $1, $2" "10" t) '(("10" "true")))) (is (equal (pomo:query "select $1, $2" "10" nil) @@ -385,7 +393,7 @@ "40e6214d-b5c6-4896-987c-f30f3678f608" -64892312321987/1000 :single) "<bar>zebra</bar>")))))) - ; setting up binary while setting up the connection +;; setting up binary while setting up the connection (test binary-parameters-basic-2-parameters-t-1 (with-binary-test-connection (with-build-binary-fixture @@ -393,10 +401,14 @@ '(("10" 20)))) (is (equal (pomo:query "select $1, $2" "10" (/ 1 3.0)) '(("10" 0.33333334)))) - (is (equal (pomo:query "select $1, $2" "10" (/ 1 3.0d0)) - '(("10" 0.3333333333333333d0)))) - (is (equal (pomo:query "select $1, $2" 10 (/ 1 3.0d0)) + #-clisp (is (equal (pomo:query "select $1, $2" "10" (/ 1 3.0d0)) + '(("10" 0.3333333333333333d0)))) + #+clisp (is (equal (pomo:query "select $1, $2" "10" (/ 1 3.0d0)) + '(("10" 0.33333334)))) + #-clisp (is (equal (pomo:query "select $1, $2" 10 (/ 1 3.0d0)) '((10 0.3333333333333333d0)))) + #+clisp (is (equal (pomo:query "select $1, $2" 10 (/ 1 3.0d0)) + '((10 0.33333334)))) (is (equal (pomo:query "select $1, $2" "10" t) '(("10" T)))) (is (equal (pomo:query "select $1, $2" "10" nil) @@ -404,9 +416,9 @@ (is (equal (pomo:query "select xml from data_type_tests where int2=$1 and float=$2" 2 -72.3 :single) "<foo>bar</foo>")) - (is (equal (pomo:query "select xml from data_type_tests where int4=$1 and dfloat=$2" + #-clisp (is (equal (pomo:query "select xml from data_type_tests where int4=$1 and dfloat=$2" 232 2312321.321d0 :single) - "<foo>bar</foo>")) + "<foo>bar</foo>")) (is (equal (pomo:query "select xml from data_type_tests where char=$1 and varchar=$2" "A" "a1b2" :single) "<foo>bar</foo>")) @@ -432,10 +444,14 @@ '(("10" 20)))) (is (equal (pomo:query "select $1, $2" "10" (/ 1 3.0)) '(("10" 0.33333334)))) - (is (equal (pomo:query "select $1, $2" "10" (/ 1 3.0d0)) + #-clisp (is (equal (pomo:query "select $1, $2" "10" (/ 1 3.0d0)) '(("10" 0.3333333333333333d0)))) - (is (equal (pomo:query "select $1, $2" 10 (/ 1 3.0d0)) - '((10 0.3333333333333333d0)))) + #-clisp (is (equal (pomo:query "select $1, $2" 10 (/ 1 3.0d0)) + '((10 0.3333333333333333d0)))) + #+clisp (is (equal (pomo:query "select $1, $2" "10" (/ 1 3.0d0)) + '(("10" 0.33333334)))) + #+clisp (is (equal (pomo:query "select $1, $2" 10 (/ 1 3.0d0)) + '((10 0.33333334)))) (is (equal (pomo:query "select $1, $2" "10" t) '(("10" T)))) (is (equal (pomo:query "select $1, $2" "10" nil) @@ -443,7 +459,7 @@ (is (equal (pomo:query "select xml from data_type_tests where int2=$1 and float=$2" 2 -72.3 :single) "<foo>bar</foo>")) - (is (equal (pomo:query "select xml from data_type_tests where int4=$1 and dfloat=$2" + #-clisp (is (equal (pomo:query "select xml from data_type_tests where int4=$1 and dfloat=$2" 232 2312321.321d0 :single) "<foo>bar</foo>")) (is (equal (pomo:query "select xml from data_type_tests where char=$1 and varchar=$2" diff --git a/postmodern/tests/test-execute-file.lisp b/postmodern/tests/test-execute-file.lisp index 2841b710..971daf69 100644 --- a/postmodern/tests/test-execute-file.lisp +++ b/postmodern/tests/test-execute-file.lisp @@ -16,42 +16,6 @@ (defparameter *bad-file* (asdf:system-relative-pathname :postmodern "postmodern/tests/test-execute-file-broken.sql")) (defparameter *bad-file-with-transaction* (asdf:system-relative-pathname :postmodern "postmodern/tests/test-execute-file-broken-transaction.sql")) -(test simple-execute-file - (with-test-connection - (when (table-exists-p 'company-employees) - (query (:drop-table :if-exists 'company-employees :cascade))) - (pomo:execute-file *good-file*) - (is (table-exists-p 'company-employees)) - (is (equal "Paul" (query (:select 'name :from 'company-employees :where (:= 'id 1)) :single))) - (is (equal 11 (query (:select (:count 'id) :from 'company-employees) :single))))) - -(test broken-execute-file - (with-test-connection - (when (table-exists-p 'company-employees) - (query (:drop-table :if-exists 'company-employees :cascade))) - (signals error (pomo:execute-file *bad-file*)) - (is (table-exists-p 'company-employees)) - (is (equal "paul" (query (:select 'name :from 'company-employees :where (:= 'id 1)) :single))) -;; the bad-file should stop executing on the attempt to insert a record with the same id as the first insertion - (is (equal 1 (query (:select (:count 'id) :from 'company-employees) :single))) - (query (:drop-table :if-exists 'company-employees :cascade)))) - -(test broken-execute-file-wrapped-in-transaction - (with-test-connection - (when (table-exists-p 'company-employees) - (query (:drop-table :if-exists 'company-employees :cascade))) - (signals error (pomo:execute-file *bad-file-with-transaction*))) - (with-test-connection - (is (not (table-exists-p 'company-employees))) - (query (:drop-table :if-exists 'company-employees :cascade)))) - -(test fail-include-execute-file - (with-test-connection - (when (table-exists-p 'company-employees) - (query (:drop-table :if-exists 'company-employees :cascade))) - (signals error (pomo:execute-file *fail-include-file*)) - (query (:drop-table :if-exists 'company-employees :cascade)))) - ;; Test Parse Comments (test basic-multi-line1 @@ -135,3 +99,39 @@ $function$"))) (test single-quote-sql (is (equal (pomo::parse-comments "REAL '1.23' -- string style") "REAL '1.23' "))) + +(test simple-execute-file + (with-test-connection + (when (table-exists-p 'company-employees) + (query (:drop-table :if-exists 'company-employees :cascade))) + (pomo:execute-file *good-file*) + (is (table-exists-p 'company-employees)) + (is (equal "Paul" (query (:select 'name :from 'company-employees :where (:= 'id 1)) :single))) + (is (equal 11 (query (:select (:count 'id) :from 'company-employees) :single))))) + +(test broken-execute-file + (with-test-connection + (when (table-exists-p 'company-employees) + (query (:drop-table :if-exists 'company-employees :cascade))) + (signals error (pomo:execute-file *bad-file*)) + (is (table-exists-p 'company-employees)) + (is (equal "paul" (query (:select 'name :from 'company-employees :where (:= 'id 1)) :single))) +;; the bad-file should stop executing on the attempt to insert a record with the same id as the first insertion + (is (equal 1 (query (:select (:count 'id) :from 'company-employees) :single))) + (query (:drop-table :if-exists 'company-employees :cascade)))) + +(test broken-execute-file-wrapped-in-transaction + (with-test-connection + (when (table-exists-p 'company-employees) + (query (:drop-table :if-exists 'company-employees :cascade))) + (signals error (pomo:execute-file *bad-file-with-transaction*))) + (with-test-connection + (is (not (table-exists-p 'company-employees))) + (query (:drop-table :if-exists 'company-employees :cascade)))) + +(test fail-include-execute-file + (with-test-connection + (when (table-exists-p 'company-employees) + (query (:drop-table :if-exists 'company-employees :cascade))) + (signals error (pomo:execute-file *fail-include-file*)) + (query (:drop-table :if-exists 'company-employees :cascade)))) diff --git a/s-sql.asd b/s-sql.asd index 1e7d5f08..2ea7a43e 100644 --- a/s-sql.asd +++ b/s-sql.asd @@ -9,7 +9,7 @@ :author "Marijn Haverbeke <marijnh@gmail.com>" :maintainer "Sabra Crolleton <sabra.crolleton@gmail.com>" :license "zlib" - :version "1.33.1" + :version "1.33.2" :depends-on ("cl-postgres" "alexandria") :components From 9b448c073a38e936df790bd18941bd119b10e7fd Mon Sep 17 00:00:00 2001 From: Sabra Crolleton <sabra.crolleton@gmail.com> Date: Sun, 26 Sep 2021 15:47:51 -0400 Subject: [PATCH 5/5] Updated docs on portability --- README.md | 4 +++- doc/index.html | 5 ++++- doc/index.org | 4 +++- 3 files changed, 10 insertions(+), 3 deletions(-) diff --git a/README.md b/README.md index 84702493..010513b7 100644 --- a/README.md +++ b/README.md @@ -625,10 +625,12 @@ the same sample data looks like: The Lisp code in Postmodern is theoretically portable across implementations, and seems to work on all major ones as well as some minor ones such as Genera. -It is regularly tested on ccl, sbcl, ecl and cmucl. +It is regularly tested on ccl, sbcl, ecl, abcl and cmucl. ABCL version 1.8.0 broke the dao class inheritance. See [https://abcl.org/trac/ticket/479](https://abcl.org/trac/ticket/479). Everything other than dao-classes works. +Clisp currently has issues with executing a file of sql statements (Postmodern's execute-file function). + Please let us know if it does not work on the implementation that you normally use. Implementations that do not have meta-object protocol support will not have DAOs, but all other parts of the library should work (all widely used implementations do support this). The library is not likely to work for PostgreSQL versions older than 8.4. Other features only work in newer Postgresql versions as the features were only introduced in those newer versions. diff --git a/doc/index.html b/doc/index.html index 174ed036..8f958758 100644 --- a/doc/index.html +++ b/doc/index.html @@ -1756,13 +1756,16 @@ <h3 id="bdf9ddb0-5f95-4807-8862-8970b35bd142">Portability</h3> <p> The Lisp code in Postmodern is theoretically portable across implementations, and seems to work on all major ones as well as some minor ones such as Genera. -It is regularly tested on ccl, sbcl, ecl and cmucl. +It is regularly tested on ccl, sbcl, ecl, abcl and cmucl. </p> <p> ABCL version 1.8.0 broke the dao class inheritance. See <a href="https://abcl.org/trac/ticket/479">https://abcl.org/trac/ticket/479</a>. Everything other than dao-classes works. </p> +<p> + Clisp currently has issues with executing a file of sql statements (Postmodern's execute-file function). + </p> <p> Implementations that do not have meta-object protocol support will not have diff --git a/doc/index.org b/doc/index.org index 1bbbc57d..ff1b4ea7 100644 --- a/doc/index.org +++ b/doc/index.org @@ -856,11 +856,13 @@ function. E.g. :END: The Lisp code in Postmodern is theoretically portable across implementations, and seems to work on all major ones as well as some minor ones such as Genera. -It is regularly tested on ccl, sbcl, ecl and cmucl. +It is regularly tested on ccl, sbcl, ecl, abcl and cmucl. ABCL version 1.8.0 broke the dao class inheritance. See [[https://abcl.org/trac/ticket/479]]. Everything other than dao-classes works. +Clisp currently has issues with executing a file of sql statements (Postmodern's execute-file function). + Implementations that do not have meta-object protocol support will not have DAOs, but all other parts of the library should work (all widely used implementations do support this).