[OSSTEST PATCH 15/33] Database locking: Tcl: for errorCode, use pg_exec, not pg_execute

[Ian Jackson <ian.jackson@eu.citrix.com>]

We would like to be able to retry db transactions.  To do this we need
to know why they failed (if they did).

But pg_execute does not set errorCode.  (This is clearly a bug.)  And
since it immediately discards a failed statement, any error
information has been lost by the time pg_execute returns.

So, instead, use pg_exec, and manually mess about with fishing
suitable information out of a failed statement handle, and generating
an appropriate errorCode.

There are no current consumers of this errorCode: that will come in a
moment.

A wrinkle is that as a result it is no longer possible to use
db-execute on a SELECT statement nor db-execute-array on a non-SELECT
statement.  This is because 1. the `ok' status that we have to
check for is different for statements which are commands and ones
which return tuples and 2. we need to fish a different return value out
of the statement handle (-cmdTuples vs -numTuples).  But all uses in
the codebase are now fine for this distinction.

Signed-off-by: Ian Jackson <Ian.Jackson@eu.citrix.com>
Acked-by: Ian Campbell <ian.campbell@citrix.com>
---
 tcl/JobDB-Executive.tcl | 54 ++++++++++++++++++++++++++++++++++++++++++++++---
 1 file changed, 51 insertions(+), 3 deletions(-)

diff --git a/tcl/JobDB-Executive.tcl b/tcl/JobDB-Executive.tcl
index bbce6fc..ed9abbb 100644
--- a/tcl/JobDB-Executive.tcl
+++ b/tcl/JobDB-Executive.tcl
@@ -121,13 +121,61 @@ proc db-execute-debug {stmt} {
 	puts stderr "EXECUTING >$stmt<"
     }
 }
+
+proc db--exec-check {shvar stmt expected_status body} {
+    # pg_execute does not set errorCode and it throws away the
+    # statement handle so we can't get the error out.  So
+    # use pg_exec, as wrapped up here.
+
+    # db--exec-check executes stmt and checks that the status is
+    # `expected_status'.  If OK, executes body with $shvar set to the
+    # stmt handle.   Otherwise throws with errorCode
+    #   {OSSTEST-PSQL <pg-status> <pg-sqlstate>}
+
+    global errorInfo errorCode
+    upvar 1 $shvar sh
+
+    set sh [pg_exec dbh $stmt]
+
+    set rc [catch {
+	set status [pg_result $sh -status]
+	if {[string compare $status $expected_status]} {
+	    set emsg [pg_result $sh -error]
+	    set sqlstate [pg_result $sh -error sqlstate]
+	    if {![string length $emsg]} {
+		set emsg "osstest expected status $expected_status got $status"
+	    }
+	    set context [pg_result $sh -error context]
+	    error $emsg \
+		"    while executing SQL\n$stmt\n    in SQL context\n$context" \
+		[list OSSTEST-PSQL $status $sqlstate]
+	}
+	uplevel 1 $body
+    } emsg]
+
+    set ei $errorInfo
+    set ec $errorCode
+    catch { pg_result $sh -clear }
+
+    return -code $rc -errorinfo $ei -errorcode $ec $emsg
+}
+
 proc db-execute {stmt} {
     db-execute-debug $stmt
-    uplevel 1 [list pg_execute dbh $stmt]
+    db--exec-check sh $stmt PGRES_COMMAND_OK {
+	return [pg_result $sh -cmdTuples]
+    }
 }
-proc db-execute-array {arrayvar stmt args} {
+proc db-execute-array {arrayvar stmt {body {}}} {
     db-execute-debug $stmt
-    uplevel 1 [list pg_execute -array $arrayvar dbh $stmt] $args
+    db--exec-check sh $stmt PGRES_TUPLES_OK {
+	set nrows [pg_result $sh -numTuples]
+	for {set row 0} {$row < $nrows} {incr row} {
+	    uplevel 1 [list pg_result $sh -tupleArray $row $arrayvar]
+	    uplevel 1 $body
+	}
+	return $nrows
+    }
 }
 
 proc lock-tables {tables} {
-- 
2.1.4


_______________________________________________
Xen-devel mailing list
Xen-devel@lists.xen.org
https://lists.xen.org/xen-devel