summaryrefslogtreecommitdiff
path: root/src/interfaces/perl5/test.pl
diff options
context:
space:
mode:
Diffstat (limited to 'src/interfaces/perl5/test.pl')
-rw-r--r--src/interfaces/perl5/test.pl275
1 files changed, 0 insertions, 275 deletions
diff --git a/src/interfaces/perl5/test.pl b/src/interfaces/perl5/test.pl
deleted file mode 100644
index 7b31427308a..00000000000
--- a/src/interfaces/perl5/test.pl
+++ /dev/null
@@ -1,275 +0,0 @@
-#!/usr/bin/perl -w
-
-# $Id: test.pl,v 1.14 2001/09/04 11:41:04 petere Exp $
-
-# Before `make install' is performed this script should be runnable with
-# `make test'. After `make install' it should work as `perl test.pl'
-
-######################### We start with some black magic to print on failure.
-
-BEGIN { $| = 1; }
-END {print "test failed\n" unless $loaded;}
-use Pg;
-$loaded = 1;
-use strict;
-
-######################### End of black magic.
-
-my $dbmain = 'template1';
-my $dbname = 'pgperltest';
-my $trace = '/tmp/pgtrace.out';
-my ($conn, $result, $i);
-
-my $DEBUG = 0; # set this to 1 for traces
-
-######################### the following methods will be tested
-
-# connectdb
-# conndefaults
-# db
-# user
-# port
-# status
-# errorMessage
-# trace
-# untrace
-# exec
-# getline
-# putline
-# endcopy
-# resultStatus
-# fname
-# fnumber
-# ftype
-# fsize
-# cmdStatus
-# oidStatus
-# cmdTuples
-# fetchrow
-
-######################### the following methods will not be tested
-
-# setdb
-# setdbLogin
-# reset
-# requestCancel
-# pass
-# host
-# tty
-# options
-# socket
-# backendPID
-# notifies
-# sendQuery
-# getResult
-# isBusy
-# consumeInput
-# getlineAsync
-# putnbytes
-# makeEmptyPGresult
-# ntuples
-# nfields
-# binaryTuples
-# fmod
-# getvalue
-# getlength
-# getisnull
-# print
-# displayTuples
-# printTuples
-# lo_import
-# lo_export
-# lo_unlink
-# lo_open
-# lo_close
-# lo_read
-# lo_write
-# lo_creat
-# lo_seek
-# lo_tell
-
-######################### handles error condition
-
-$SIG{PIPE} = sub { print "broken pipe\n" };
-
-######################### create and connect to test database
-
-my $Option_ref = Pg::conndefaults();
-my ($key, $val);
-( $$Option_ref{port} ne "" && $$Option_ref{dbname} ne "" && $$Option_ref{user} ne "" )
- and print "Pg::conndefaults ........ ok\n"
- or die "Pg::conndefaults ........ not ok: ", $conn->errorMessage;
-
-$conn = Pg::connectdb("dbname=$dbmain");
-( PGRES_CONNECTION_OK eq $conn->status )
- and print "Pg::connectdb ........... ok\n"
- or die "Pg::connectdb ........... not ok: ", $conn->errorMessage;
-
-# do not complain when dropping $dbname
-$conn->exec("DROP DATABASE $dbname");
-
-$result = $conn->exec("CREATE DATABASE $dbname");
-( PGRES_COMMAND_OK eq $result->resultStatus )
- and print "\$conn->exec ............. ok\n"
- or die "\$conn->exec ............. not ok: ", $conn->errorMessage;
-
-$conn = Pg::connectdb("dbname=rumpumpel");
-( $conn->errorMessage =~ 'Database "rumpumpel" does not exist' )
- and print "\$conn->errorMessage ..... ok\n"
- or die "\$conn->errorMessage ..... not ok: ", $conn->errorMessage;
-
-$conn = Pg::connectdb("dbname=$dbname");
-die $conn->errorMessage unless PGRES_CONNECTION_OK eq $conn->status;
-
-######################### debug, PQtrace
-
-if ($DEBUG) {
- open(FD, ">$trace") || die "can not open $trace: $!";
- $conn->trace("FD");
-}
-
-######################### check PGconn
-
-my $db = $conn->db;
-( $dbname eq $db )
- and print "\$conn->db ............... ok\n"
- or print "\$conn->db ............... not ok: $db\n";
-
-my $user = $conn->user;
-( "" ne $user )
- and print "\$conn->user ............. ok\n"
- or print "\$conn->user ............. not ok: $user\n";
-
-my $port = $conn->port;
-( "" ne $port )
- and print "\$conn->port ............. ok\n"
- or print "\$conn->port ............. not ok: $port\n";
-
-######################### create and insert into table
-
-# we test comments inside string and with no trailing newline here
-$result = $conn->exec("CREATE TABLE person (id int4, -- test\n name char(16)) -- test");
-die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus;
-my $cmd = $result->cmdStatus;
-( "CREATE" eq $cmd )
- and print "\$conn->cmdStatus ........ ok\n"
- or print "\$conn->cmdStatus ........ not ok: $cmd\n";
-
-for ($i = 1; $i <= 5; $i++) {
- $result = $conn->exec("INSERT INTO person VALUES ($i, 'Edmund Mergl')");
- die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus;
-}
-my $oid = $result->oidStatus;
-( 0 != $oid )
- and print "\$conn->oidStatus ........ ok\n"
- or print "\$conn->oidStatus ........ not ok: $oid\n";
-
-######################### copy to stdout, PQgetline
-
-$result = $conn->exec("COPY person TO STDOUT");
-die $conn->errorMessage unless PGRES_COPY_OUT eq $result->resultStatus;
-
-my $ret = 0;
-my $buf;
-my $string;
-$i = 1;
-while (-1 != $ret) {
- $ret = $conn->getline($buf, 256);
- last if $buf eq "\\.";
- $string = $buf if 1 == $i;
- $i++;
-}
-( "1 Edmund Mergl " eq $string )
- and print "\$conn->getline .......... ok\n"
- or print "\$conn->getline .......... not ok: $string\n";
-
-$ret = $conn->endcopy;
-( 0 == $ret )
- and print "\$conn->endcopy .......... ok\n"
- or print "\$conn->endcopy .......... not ok: $ret\n";
-
-######################### delete and copy from stdin, PQputline
-
-$result = $conn->exec("BEGIN");
-die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus;
-
-$result = $conn->exec("DELETE FROM person");
-die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus;
-$ret = $result->cmdTuples;
-( 5 == $ret )
- and print "\$result->cmdTuples ...... ok\n"
- or print "\$result->cmdTuples ...... not ok: $ret\n";
-
-$result = $conn->exec("COPY person FROM STDIN");
-die $conn->errorMessage unless PGRES_COPY_IN eq $result->resultStatus;
-
-for ($i = 1; $i <= 5; $i++) {
- # watch the tabs and do not forget the newlines
- $conn->putline("$i Edmund Mergl\n");
-}
-$conn->putline("\\.\n");
-
-die $conn->errorMessage if $conn->endcopy;
-
-$result = $conn->exec("END");
-die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus;
-
-######################### select from person, PQgetvalue
-
-$result = $conn->exec("SELECT * FROM person");
-die $conn->errorMessage unless PGRES_TUPLES_OK eq $result->resultStatus;
-
-my $fname = $result->fname(0);
-( "id" eq $fname )
- and print "\$result->fname .......... ok\n"
- or print "\$result->fname .......... not ok: $fname\n";
-
-my $ftype = $result->ftype(0);
-( 23 == $ftype )
- and print "\$result->ftype .......... ok\n"
- or print "\$result->ftype .......... not ok: $ftype\n";
-
-my $fsize = $result->fsize(0);
-( 4 == $fsize )
- and print "\$result->fsize .......... ok\n"
- or print "\$result->fsize .......... not ok: $fsize\n";
-
-my $fnumber = $result->fnumber($fname);
-( 0 == $fnumber )
- and print "\$result->fnumber ........ ok\n"
- or print "\$result->fnumber ........ not ok: $fnumber\n";
-
-$string = "";
-my @row;
-while (@row = $result->fetchrow) {
- $string = join(" ", @row);
-}
-( "5 Edmund Mergl " eq $string )
- and print "\$result->fetchrow ....... ok\n"
- or print "\$result->fetchrow ....... not ok: $string\n";
-
-######################### debug, PQuntrace
-
-if ($DEBUG) {
- close(FD) || die "bad TRACE: $!";
- $conn->untrace;
-}
-
-######################### disconnect and drop test database
-
-$conn = Pg::connectdb("dbname=$dbmain");
-die $conn->errorMessage unless PGRES_CONNECTION_OK eq $conn->status;
-
-# Race condition: it's quite possible that the DROP command will arrive
-# at the new backend before the old backend has finished shutting down,
-# resulting in an error message.
-# There doesn't seem to be any more graceful way around this than to
-# insert a small delay ...
-sleep(1);
-
-$result = $conn->exec("DROP DATABASE $dbname");
-die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus;
-
-print "test sequence finished.\n";
-
-######################### EOF
generated by cgit v1.2.3 (git 2.39.1) at 2025-12-23 07:16:44 +0000