Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
P
pg
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
0
Issues
0
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
pg
pg
Commits
e1b511fd
Commit
e1b511fd
authored
Mar 03, 2004
by
Eric Marsden
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
*** empty log message ***
parent
0cbcbb6d
Changes
7
Expand all
Hide whitespace changes
Inline
Side-by-side
Showing
7 changed files
with
1961 additions
and
0 deletions
+1961
-0
NEWS
NEWS
+68
-0
README
README
+274
-0
defpackage.lisp
defpackage.lisp
+33
-0
pg-tests.lisp
pg-tests.lisp
+305
-0
pg.asd
pg.asd
+22
-0
pg.lisp
pg.lisp
+979
-0
sysdep.lisp
sysdep.lisp
+280
-0
No files found.
NEWS
0 → 100644
View file @
e1b511fd
=== Version 0.20, 2003-xxxx ============================================
- added more tests for BOOLEAN types, to check the handling of
PostgreSQL errors (violation of an integrity constraint leads to an
error of type PG:BACKEND-ERROR being signaled). For CMUCL users who
use the multiprocessing support, there's a test that runs several data
producers and a consumer in different threads.
- error condition names (POSTGRESQL-ERROR, AUTHENTICATION-FAILURE,
BACKEND-ERROR are now exported from the PG package.
=== Version 0.19, 2003-10-10 ===========================================
- new multi-file organization: split out the system-dependent parts
and the tests into separate files. An ASDF system description is
provided in the file pg.asd.
- change to WITH-PG-TRANSACTION: the previous version would abort the
current transaction upon encountering an error, which made
debugging difficult. The new version (thanks to Daniel Barlow)
maintains the transaction open until you have exited the debugger.
- support for connecting to PostgreSQL using a local socket instead
of using TCP/IP, when you're on the same host as the backend. To
enable, use a NIL host argument to PG-CONNECT. This makes it
possible to connect to the database without enabling TCP/IP
connections in the backend ("-i" option), and (depending on the
access configuration parameters specified in pg_hba.conf) possibly
without supplying a password. This is currently only supported for
CMUCL and SBCL.
- parser support for the INTERVAL type (you get this by subtracting
two timestamps). They are coerced by pg-dot-lisp to a number of
seconds, represented in floating point.
- new configuration variable *PG-CLIENT-ENCODING*, that supports
client-side encoding of text data, as per
<http://www.postgresql.org/docs/7.3/static/multibyte.html>.
Function PG-CLIENT-ENCODING, and corresponding setf
function, that allows you to retrieve and modify the current client
encoding.
- new configuration variable *PG-DATE-STYLE* that allows you to
change the style in which date types are printed. Function
PG-DATE-STYLE that allows you to retrieve (and modify via its SETF
function) the current backend's date style.
- CMUCL: loading the file cmucl-install-subsystem.lisp (as a user who
has write access to the directory where CMUCL is installed) will
cause this package to be installed as a CMUCL "subsystem", that can
thereafter be loaded by saying "(require :pg)".
- SBCL: fix for new sb-bsd-sockets
- support for a new Common Lisp implementation, Armed Bear Lisp for
the JVM
=== Version 0.18, 2003-06-01 ============================================
- Fix for parsing of TIMESTAMP fields in PostgreSQL 7.3, thanks to
James Anderson. These can now contain timezone and millisecond
fields.
README
0 → 100644
View file @
e1b511fd
pg.lisp -- socket level interface to the PostgreSQL RDBMS for Common Lisp
Author: Eric Marsden <emarsden@laas.fr>
Time-stamp: <2003-10-10 emarsden>
Version: 0.20
Copyright (C) 1999,2000,2001,2002,2003 Eric Marsden
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with this library; if not, write to the Free
Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
Please send suggestions and bug reports to <emarsden@laas.fr>
The latest version of this package should be available from
<URL:http://purl.org/net/emarsden/home/downloads/>
== Overview =========================================================
This module lets you access the PostgreSQL object-relational DBMS
from Common Lisp. The code implements the client part of the
socket-level frontend/backend protocol, rather than providing a
wrapper around the libpq library. The module is capable of type
coercions from a range of SQL types to the equivalent Lisp type.
The only non portable code is the use of 'socket-connect' and
(optional) some way of accessing the Unix crypt() function.
Works with CMUCL, SBCL, CLISP, OpenMCL, ACL, Lispworks, MCL and
ArmedBear Lisp. CormanLisp has socket support but not for binary I/O.
== Entry points =======================================================
(with-pg-connection ((con &rest open-args) &body body)
A macro which opens a connection to database DBNAME, executes the
BODY forms then disconnects. See function `pg-connect' for details
of the connection arguments OPEN-ARGS.
(with-pg-transaction con &body body)
A macro which executes the BODY forms wrapped in an SQL transaction.
CON is a connection to the database. If an error occurs during the
execution of the forms, a ROLLBACK instruction is executed.
(pg-connect dbname user &key password host port) -> connection
Connect to the database DBNAME on HOST (defaults to localhost) at
PORT (defaults to 5432), and log in as USER. If HOST is nil,
attempt to connect to the localhost using a Unix domain socket;
otherwise the connection is established using TCP/IP. If the
database requires a password, send PASSWORD (as clear text unless
the backend demands crypt() authentication). Set the output date
type to 'ISO', and initialize our type parser tables.
(pg-exec connection &rest sql) -> pgresult
Concatenate the SQL strings and send to the backend. Retrieve
all the information returned by the database and return it in
an opaque record PGRESULT.
(pg-result pgresult what &rest args) -> info
Extract information from the PGRESULT. WHAT can be one of
* :connection
* :status
* :attributes
* :tuples
* :tuple tupleNumber
* :oid
`connection' allows you to retrieve the database connection.
`status' is a string returned by the backend to indicate the
status of the command; it is normally "SELECT" for a select
command, "DELETE 1" if the deletion affected a single row, etc.
`attributes' is a list of tuples providing metadata: the first
component of each tuple is the attribute's name as a string,
the second an integer representing its PostgreSQL type, and the
third an integer representing the size of that type. `tuples'
returns all the data retrieved from the database, as a list of
lists, each list corresponding to one row of data returned by
the backend. `tuple num' can be used to extract a specific
tuple. `oid' allows you to retrieve the OID returned by the
backend if the command was an insertion; the OID is a unique
identifier for that row in the database (this is
PostgreSQL-specific, please refer to the documentation for more
details).
(pg-for-each connection select-form callback)
Calls CALLBACK on each tuple returned by SELECT-FORM. Declares
a cursor for SELECT-FORM, then fetches tuples using repeated
executions of FETCH 1, until no results are left. The cursor is
then closed. The work is performed within a transaction. When
you have a large amount of data to handle, this usage is more
efficient than fetching all the tuples in one go.
(pg-disconnect connection) -> nil
Close the database connection.
(pg-databases connection) -> list of strings
Return a list of the databases available at this site (a
database is a set of tables; in a virgin PostgreSQL
installation there is a single database named "template1").
(pg-tables connection) -> list of strings
Return a list of the tables present in the database to which we
are currently connected. Only include user tables: system
tables are excluded.
(pg-columns connection table) -> list of strings
Return a list of the columns (or attributes) in TABLE, which
must be a table in the database to which we are currently
connected. We only include the column names; if you want more
detailed information (attribute types, for example), it can be
obtained from `pg-result' on a SELECT statement for that table.
(pglo-create conn . args) -> oid
Create a new large object (BLOB, or binary large object in
other DBMSes parlance) in the database to which we are
connected via CONN. Returns an OID (which is represented as an
integer) which will allow you to use the large object.
Optional ARGS are a Unix-style mode string which determines the
permissions of the newly created large object, one of "r" for
read-only permission, "w" for write-only, "rw" for read+write.
Default is "r".
Large-object functions MUST be used within a transaction (see
the macro `with-pg-transaction').
(pglo-open conn oid . args) -> fd
Open a large object whose unique identifier is OID (an integer)
in the database to which we are connected via CONN. Optional ARGS
is a Unix-style mode string as for pglo-create; which defaults to
"r" read-only permissions. Returns a file descriptor (an integer)
which can be used in other large-object functions.
(pglo-close conn fd)
Close the file descriptor FD which was associated with a large
object. Note that this does not delete the large object; use
PGLO-UNLINK for that.
(pglo-read conn fd bytes) -> string
Read BYTES from the file descriptor FD which is associated with a
large object. Return a string which should be BYTES characters
long.
(pglo-write connection fd buf)
Write the bytes contained in the string BUF to the large object
associated with the file descriptor FD.
(pglo-lseek conn fd offset whence)
Do the equivalent of a lseek(2) on the file descriptor FD which
is associated with a large object; ie reposition the read/write
file offset for that large object to OFFSET (an integer). WHENCE
has the same significance as in lseek(); it should be one of
SEEK_SET (set the offset to the absolute position), SEEK_CUR (set
the offset relative to the current offset) or SEEK_END (set the
offset relative to the end of the file). WHENCE should be an
integer whose values can be obtained from the header file
<unistd.h> (probably 0, 1 and 2 respectively).
(pglo-tell conn oid) -> integer
Do the equivalent of an ftell(3) on the file associated with
the large object whose unique identifier is OID. Returns the
current position of the file offset for the object's associated
file descriptor, as an integer.
(pglo-unlink conn oid)
Remove the large object whose unique identifier is OID from the
system (in the current implementation of large objects in
PostgreSQL, each large object is associated with an object in
the filesystem).
(pglo-import conn filename) -> oid
Create a new large object and initialize it to the data contained
in the file whose name is FILENAME. Returns an OID (as an
integer). Note that is operation is only syntactic sugar around
the basic large-object operations listed above.
(pglo-export conn oid filename)
Create a new file named FILENAME and fill it with the contents
of the large object whose unique identifier is OID. This
operation is also syntactic sugar.
Boolean variable `*PG-DISABLE-TYPE-COERCION*' which can be set to
non-nil (before initiating a connection) to disable the library's
type coercion facility. Default is t.
SECURITY NOTE: please note that your postmaster has to be started
with the `-i' option in order for it to accept TCP/IP connections
(typically this is not the default setting). See the PostgreSQL
documentation at <URL:http://www.PostgreSQL.org/> for more
information.
Setting up PostgreSQL to accept TCP/IP connections has security
implications; please consult the documentation for details. You can
connect to the database using Unix domain sockets if you wish to
avoid setting up PostgreSQL to listen on a TCP socket.
pg.lisp is able to use the crypt authentication method to avoid
sending the password in cleartext over the wire (this assumes access
to the `crypt' function via the FFI). It does not support the
Kerberos authentication method, nor OpenSSL connections (though this
should not be difficult if your Common Lisp implementation is able to
open SSL streams). However, it is possible to use the port forwarding
capabilities of ssh to establish a connection to the backend over
TCP/IP, which provides both a secure authentication mechanism and
encryption (and optionally compression) of data passing through the
tunnel. Here's how to do it (thanks to Gene Selkov, Jr.
<selkovjr@mcs.anl.gov> for the description):
1. Establish a tunnel to the backend machine, like this:
ssh -L 3333:backend.dom:5432 postgres@backend.dom
The first number in the -L argument, 3333, is the port number of
your end of the tunnel. The second number, 5432, is the remote
end of the tunnel -- the port number your backend is using. The
name or the address in between the port numbers belongs to the
server machine, as does the last argument to ssh that also includes
the optional user name. Without the user name, ssh will try the
name you are currently logged on as on the client machine. You can
use any user name the server machine will accept, not necessarily
those related to postgres.
2. Now that you have a running ssh session, you can point pg.lisp to
the local host at the port number which you specified in step 1.
For example,
(pg-connect "dbname" "user" :port 3333)
You can omit the port argument if you chose 5432 as the local
end of the tunnel, since pg.lisp defaults to this value.
This code has been tested or reported to work with
* CMUCL 18d on Solaris/SPARC and Linux/x86
* CLISP 2.30 on LinuxPPC and SPARC
* ACL 6.1 trial/x86
* PostgreSQL 6.5, 7.0, 7.1.2, 7.2.
Thanks to Marc Battyani for the LW port and for bugfixes, to Johannes
Grødem <johs@copyleft.no> for a fix to parsing of DATE types, to Doug
McNaught and Howard Ding for bugfixes, to Ernst Jeschek for pointing
out a bug in float parsing, to Brian Lui for providing fixes for ACL6,
to James Anderson for providing a fix for a change in PostgreSQL
timestamp format.
You may be interested in using "pg-psql" by Harley Gorrell, which
provides a psql-like listener interface to PostgreSQL (together with
tabulated output), on top of this library. See
<URL:http://www.mahalito.net/~harley/cl/pg-psql.lisp>
== TODO ============================================================
* add a mechanism for parsing user-defined types. The user should
be able to define a parse function and a type-name; we query
pg_type to get the type's OID and add the information to
pg:*parsers*.
defpackage.lisp
0 → 100644
View file @
e1b511fd
(
defpackage
:postgresql
(
:nicknames
:pg
)
(
:use
:common-lisp
#+
cmu
:alien
#+
cmu
:c-call
#+
openmcl
:ccl
)
#+
openmcl
(
:shadow
ccl:socket-connect
)
(
:export
#:pg-connect
#:pg-exec
#:pg-result
#:pg-disconnect
#:*pg-disable-type-coercion*
#:pg-databases
#:pg-tables
#:pg-columns
#:pg-backend-version
#:pg-date-style
#:pg-client-encoding
#:with-pg-connection
#:with-pg-transaction
#:pg-for-each
#:pglo-create
#:pglo-open
#:pglo-close
#:pglo-read
#:pglo-write
#:pglo-lseek
#:pglo-tell
#:pglo-unlink
#:pglo-import
#:pglo-export
#:postgresql-error
#:connection-failure
#:authentication-failure
#:protocol-error
#:backend-error
))
;; EOF
pg-tests.lisp
0 → 100644
View file @
e1b511fd
;; == testing ==============================================================
;;
;;
;; These tests assume that a table named "test" is defined in the
;; system catalog, and that the user identified in
;; CALL-WITH-TEST-CONNECTION has the rights to access that table.
(
defpackage
:pg-tests
(
:use
:cl
:pg
#+
cmu
:fwrappers
))
(
in-package
:pg-tests
)
;; !!! CHANGE THE VALUES HERE !!!
(
defun
call-with-test-connection
(
function
)
(
with-pg-connection
(
conn
"test"
"emarsden"
:host
"melbourne"
:port
5433
)
(
funcall
function
conn
)))
(
defmacro
with-test-connection
((
conn
)
&body
body
)
`
(
call-with-test-connection
(
lambda
(
,
conn
)
,@
body
)))
(
defun
test-insert
()
(
format
*debug-io*
"Testing INSERT & SELECT on integers ...~%"
)
(
with-test-connection
(
conn
)
(
let
((
res
nil
)
(
count
0
)
(
created
nil
))
(
unwind-protect
(
progn
(
pg-exec
conn
"CREATE TABLE count_test(key int, val int)"
)
(
loop
:for
i
:from
1
:to
100
:for
sql
=
(
format
nil
"INSERT INTO count_test VALUES(~s, ~s)"
i
(
*
i
i
))
:do
(
pg-exec
conn
sql
))
(
setq
created
t
)
(
setq
res
(
pg-exec
conn
"SELECT count(val) FROM count_test"
))
(
assert
(
eql
100
(
first
(
pg-result
res
:tuple
0
))))
(
setq
res
(
pg-exec
conn
"SELECT sum(key) FROM count_test"
))
(
assert
(
eql
5050
(
first
(
pg-result
res
:tuple
0
))))
;; this iterator does the equivalent of the sum(key) SQL statement
;; above, but on the client side.
(
pg-for-each
conn
"SELECT key FROM count_test"
(
lambda
(
tuple
)
(
incf
count
(
first
tuple
))))
(
assert
(
=
5050
count
)))
(
when
created
(
pg-exec
conn
"DROP TABLE count_test"
))))))
(
defun
test-insert/float
()
(
format
*debug-io*
"Testing INSERT & SELECT on floats ...~%"
)
(
with-test-connection
(
conn
)
(
let
((
res
nil
)
(
sum
0.0
)
(
created
nil
))
(
flet
((
float-eql
(
a
b
)
(
<
(
/
(
abs
(
-
a
b
))
b
)
1e-5
)))
(
unwind-protect
(
progn
(
pg-exec
conn
"CREATE TABLE count_test_float(key int, val float)"
)
(
setq
created
t
)
(
loop
:for
i
:from
1
:to
1000
:for
sql
=
(
format
nil
"INSERT INTO count_test_float VALUES(~d, ~f)"
i
i
)
:do
(
pg-exec
conn
sql
))
(
setq
res
(
pg-exec
conn
"SELECT count(val) FROM count_test_float"
))
(
assert
(
eql
1000
(
first
(
pg-result
res
:tuple
0
))))
(
setq
res
(
pg-exec
conn
"SELECT sum(key) FROM count_test_float"
))
(
assert
(
float-eql
500500.0
(
first
(
pg-result
res
:tuple
0
))))
;; this iterator does the equivalent of the sum(key) SQL statement
;; above, but on the client side.
(
pg-for-each
conn
"SELECT val FROM count_test_float"
(
lambda
(
tuple
)
(
incf
sum
(
first
tuple
))))
(
assert
(
float-eql
500500
sum
)))
(
when
created
(
pg-exec
conn
"DROP TABLE count_test_float"
)))))))
(
defun
test-date
()
(
format
*debug-io*
"Testing DATE and TIMESTAMP parsing ...~%"
)
(
with-test-connection
(
conn
)
(
let
((
created
nil
))
(
unwind-protect
(
progn
(
pg-exec
conn
"CREATE TABLE pgltest (a timestamp, b abstime, c time, d date)"
)
(
setq
created
t
)
(
pg-exec
conn
"INSERT INTO pgltest VALUES "
"(current_timestamp, 'now', 'now', 'now')"
)
(
let*
((
res
(
pg-exec
conn
"SELECT * FROM pgltest"
))
(
parsed
(
first
(
pg-result
res
:tuples
))))
(
format
t
"attributes ~a~%"
(
pg-result
res
:attributes
))
(
format
t
"Timestamp = ~s~%abstime = ~s~%time = ~s (CL universal-time = ~d)~%date = ~s~%"
(
first
parsed
)
(
second
parsed
)
(
third
parsed
)
(
get-universal-time
)
(
fourth
parsed
))))
(
when
created
(
pg-exec
conn
"DROP TABLE pgltest"
))))))
(
defun
test-booleans
()
(
format
*debug-io*
"Testing support for BOOLEAN type ...~%"
)
(
with-test-connection
(
conn
)
(
let
((
created
nil
))
(
unwind-protect
(
progn
(
pg-exec
conn
"CREATE TABLE pgbooltest (a BOOLEAN, b INT4)"
)
(
setq
created
t
)
(
pg-exec
conn
"INSERT INTO pgbooltest VALUES ('t', 42)"
)
(
dotimes
(
i
100
)
(
pg-exec
conn
(
format
nil
"INSERT INTO pgbooltest VALUES ('f', ~D)"
i
)))
(
let
((
sum
0
))
(
pg-for-each
conn
"SELECT * FROM pgbooltest"
(
lambda
(
tuple
)
(
when
(
first
tuple
)
(
incf
sum
(
second
tuple
)))))
(
assert
(
eql
42
sum
))))
(
when
created
(
pg-exec
conn
"DROP TABLE pgbooltest"
))))))
(
defun
test-integrity
()
(
format
*debug-io*
"Testing integrity constaint signaling ...~%"
)
(
with-test-connection
(
conn
)
(
let
((
created
nil
))
(
unwind-protect
(
progn
(
pg-exec
conn
"CREATE TABLE pgintegritycheck (a INTEGER UNIQUE)"
)
(
setq
created
t
)
(
dotimes
(
i
100
)
(
pg-exec
conn
(
format
nil
"INSERT INTO pgintegritycheck VALUES (~D)"
i
)))
(
handler-case
(
pg-exec
conn
"INSERT INTO pgintegritycheck VALUES (1)"
)
(
pg:backend-error
(
exc
)
(
format
*debug-io*
"OK: integrity constraint handled: ~A~%"
exc
))
(
error
(
exc
)
(
format
*debug-io*
"FAIL: unhandled integrity constraint: ~A~%"
exc
))))
(
when
created
(
pg-exec
conn
"DROP TABLE pgintegritycheck"
))))))
(
defun
test-introspection
()
(
format
*debug-io*
"Testing support for introspection ...~%"
)
(
with-test-connection
(
conn
)
(
dotimes
(
i
500
)
(
pg-tables
conn
))))
;; Fibonnaci numbers with memoization via a database table
(
defun
fib
(
n
)
(
declare
(
type
integer
n
))
(
if
(
<
n
2
)
1
(
+
(
fib
(
-
n
1
))
(
fib
(
-
n
2
)))))
;; (compile 'fib)
#+
cmu
(
define-fwrapper
memoize-fib
(
n
)
(
let*
((
conn
(
fwrapper-user-data
fwrapper
))
(
res
(
pg-exec
conn
(
format
nil
"SELECT fibn FROM fib WHERE n = ~d"
n
)))
(
tuples
(
pg-result
res
:tuples
)))
(
cond
((
zerop
(
length
tuples
))
(
let
((
fibn
(
call-next-function
)))
(
pg-exec
conn
(
format
nil
"INSERT INTO fib VALUES (~D, ~D)"
n
fibn
))
fibn
))
((
eql
1
(
length
tuples
))
(
caar
tuples
))
(
t
(
error
"integrity error in fibn table"
)))))
(
defun
test-fib
()
(
format
*debug-io*
"Testing fibonnaci number generation ...~%3"
)
(
with-test-connection
(
conn
)
(
let
((
created
nil
)
(
non-memoized
0
)
(
memoized
0
))
(
unwind-protect
(
progn
(
pg-exec
conn
"CREATE TABLE fib (n INTEGER, fibn INT8)"
)
(
setq
created
t
)
(
funwrap
'fib
)
(
time
(
setq
non-memoized
(
fib
40
)))
#+
cmu
(
fwrap
'fib
#'
memoize-fib
:user-data
conn
)
(
update-fwrappers
'fib
)
; remove stale conn user-data object
(
time
(
setq
memoized
(
fib
40
)))
(
format
t
"~S"
(
pg-exec
conn
"SELECT COUNT(n) FROM fib"
))
(
assert
(
eql
non-memoized
memoized
)))
(
when
created
(
pg-exec
conn
"DROP TABLE fib"
))))))
(
defun
test-lo
()
(
format
*debug-io*
"Testing large object support ...~%"
)
(
with-test-connection
(
conn
)
(
with-pg-transaction
conn
(
let*
((
oid
(
pglo-create
conn
))
(
fd
(
pglo-open
conn
oid
)))
(
sleep
1
)
(
pglo-tell
conn
fd
)
(
sleep
1
)
(
pglo-unlink
conn
oid
)))))
;; test of large-object interface
(
defun
test-lo-read
()
(
format
*debug-io*
"Testing read of large object ...~%"
)
(
with-test-connection
(
conn
)
(
with-pg-transaction
conn
(
let*
((
oid
(
pglo-create
conn
"rw"
))
(
fd
(
pglo-open
conn
oid
"rw"
)))
(
pglo-write
conn
fd
"Hi there mate"
)
(
pglo-lseek
conn
fd
3
0
)
; SEEK_SET = 0
(
assert
(
=
3
(
pglo-tell
conn
fd
)))
;; this should print "there mate"
(
format
*debug-io*
"Read ~s from lo~%"
(
pglo-read
conn
fd
10
))
(
pglo-close
conn
fd
)
(
pglo-unlink
conn
oid
)))))
#+
cmu
(
defun
test-lo-import
()
(
format
*debug-io*
"Testing import of large object ...~%"
)
(
with-test-connection
(
conn
)
(
with-pg-transaction
conn
(
let
((
oid
(
pglo-import
conn
"/etc/group"
)))
(
pglo-export
conn
oid
"/tmp/group"
)
(
cond
((
zerop
(
ext:process-exit-code
(
ext:run-program
"diff"
(
list
"/tmp/group"
"/etc/group"
))))
(
format
*debug-io*
"pglo-import test succeeded~%"
)
(
unix:unix-unlink
"/tmp/group"
))
(
t
(
format
*debug-io*
"pglo-import test failed: check differences
between files /etc/group and /tmp/group"
)))
(
pglo-unlink
conn
oid
)))))
(
defun
test-simple
()
(
let
((
*pg-disable-type-coercion*
t
))
(
with-test-connection
(
conn
)
(
format
t
"backend ~a~%"
(
pg-backend-version
conn
)))))
(
defun
test-notifications
()
(
with-test-connection
(
conn
)
(
let
(
res
)
(
setq
res
(
pg-exec
conn
"LISTEN pg_test_listen"
))
(
format
t
"LISTEN -> ~S~%"
(
pg-result
res
:status
))
(
assert
(
null
(
pg::pgcon-notices
conn
)))
(
pg-exec
conn
"SELECT * FROM pg_type"
)
(
assert
(
null
(
pg::pgcon-notices
conn
)))
(
setq
res
(
pg-exec
conn
"NOTIFY pg_test_listen"
))
(
format
t
"NOTIFY -> ~S~%"
(
pg-result
res
:status
))
(
format
t
"In TEST-NOTIFICATIONS notices are ~S~%"
(
pg::pgcon-notices
conn
)))))
;; FIXME could add interaction between producer and consumers via NOTIFY
#+
(
and
cmu
mp
)
(
defun
test-multiprocess
()
(
format
*debug-io*
"Testing multiprocess database access~%"
)
(
when
(
eq
mp::*current-process*
mp::*initial-process*
)
(
mp::startup-idle-and-top-level-loops
))
(
with-test-connection
(
conn
)
(
pg-exec
conn
"CREATE TABLE pgmt (a TEXT, b INTEGER, C FLOAT)"
))
(
flet
((
producer
()
(
with-test-connection
(
conn
)
(
dotimes
(
i
5000
)
(
pg-exec
conn
(
format
nil
"INSERT INTO pgmt VALUES (~S, ~D, ~F)"
i
i
i
))
(
when
(
zerop
(
mod
i
100
))
(
pg-exec
conn
"COMMIT WORK"
)))))
(
consumer
()
(
with-test-connection
(
conn
)
(
dotimes
(
i
10
)
(
sleep
1
)
(
let
((
res
(
pg-exec
conn
"SELECT count(*) FROM pgmt"
)))
(
format
*debug-io*
" Consumer sees ~D rows~%"
(
first
(
pg-result
res
:tuple
0
))))))))
(
let
((
p1
(
mp:make-process
#'
producer
:name
"PG data producer"
))
(
p2
(
mp:make-process
#'
producer
:name
"PG data producer"
))
(
p3
(
mp:make-process
#'
producer
:name
"PG data producer"
))
(
co
(
mp:make-process
#'
consumer
:name
"PG data consumer"
)))
(
loop
:while
(
some
'mp:process-alive-p
(
list
p1
p2
p3
co
))
:do
(
sleep
5
)
(
mp:show-processes
t
))))
(
with-test-connection
(
conn
)
(
pg-exec
conn
"DROP TABLE pgmt"
)))
(
defun
test
()
(
with-test-connection
(
conn
)
(
format
t
"Running pg.lisp tests against backend ~a~%"
(
pg-backend-version
conn
))
;; client encoding supported since PostgreSQL v7.1
(
format
t
"Client encoding is ~A~%"
(
pg-client-encoding
conn
))
(
format
t
"Date style is ~A~%"
(
pg-date-style
conn
))
(
let
((
r2
(
pg-exec
conn
"CREATE TABLE pgltest (a int, b float, c money)"
))
(
r3
(
pg-exec
conn
"INSERT INTO pgltest VALUES (3, -1234.5e67, '$123.45')"
))
(
r4
(
pg-exec
conn
"DROP TABLE pgltest"
)))