summaryrefslogtreecommitdiff
path: root/os2/OS2/REXX/t/rx_tiesql.test
diff options
context:
space:
mode:
Diffstat (limited to 'os2/OS2/REXX/t/rx_tiesql.test')
-rw-r--r--os2/OS2/REXX/t/rx_tiesql.test86
1 files changed, 86 insertions, 0 deletions
diff --git a/os2/OS2/REXX/t/rx_tiesql.test b/os2/OS2/REXX/t/rx_tiesql.test
new file mode 100644
index 0000000000..2947516755
--- /dev/null
+++ b/os2/OS2/REXX/t/rx_tiesql.test
@@ -0,0 +1,86 @@
+BEGIN {
+ chdir 't' if -d 't/lib';
+ @INC = '../lib';
+ require Config; import Config;
+ if ($Config{'extensions'} !~ /\bOS2::REXX\b/) {
+ print "1..0\n";
+ exit 0;
+ }
+}
+
+#extproc perl5 -Rx
+#! perl
+
+use REXX;
+
+$db2 = load REXX "sqlar" or die "load";
+tie $sqlcode, REXX, "SQLCA.SQLCODE";
+tie $sqlstate, REXX, "SQLCA.SQLSTATE";
+tie %rexx, REXX, "";
+
+sub stmt
+{
+ my ($s) = @_;
+ $s =~ s/\s*\n\s*/ /g;
+ $s =~ s/^\s+//;
+ $s =~ s/\s+$//;
+ return $s;
+}
+
+sub sql
+{
+ my ($stmt) = stmt(@_);
+ return 0 if $db2->SqlExec($stmt);
+ return $sqlcode >= 0;
+}
+
+sub dbs
+{
+ my ($stmt) = stmt(@_);
+ return 0 if $db2->SqlDBS($stmt);
+ return $sqlcode >= 0;
+}
+
+sub error
+{
+ my ($where) = @_;
+ print "ERROR in $where: sqlcode=$sqlcode, sqlstate=$sqlstate\n";
+ dbs("GET MESSAGE INTO :msg LINEWIDTH 75");
+ print "\n", $rexx{'MSG'};
+ exit 1;
+}
+
+sql(<<) or error("connect");
+ CONNECT TO sample IN SHARE MODE
+
+$rexx{'STMT'} = stmt(<<);
+ SELECT name FROM sysibm.systables
+
+sql(<<) or error("prepare");
+ PREPARE s1 FROM :stmt
+
+sql(<<) or error("declare");
+ DECLARE c1 CURSOR FOR s1
+
+sql(<<) or error("open");
+ OPEN c1
+
+while (1) {
+ sql(<<) or error("fetch");
+ FETCH c1 INTO :name
+
+ last if $sqlcode == 100;
+
+ print "Table name is $rexx{'NAME'}\n";
+}
+
+sql(<<) or error("close");
+ CLOSE c1
+
+sql(<<) or error("rollback");
+ ROLLBACK
+
+sql(<<) or error("disconnect");
+ CONNECT RESET
+
+exit 0;