[m-dev.] for review: handle exceptions in the ODBC interface

[Simon Taylor]

Estimated hours taken: 2

Handle exceptions thrown by the closure passed to odbc__transaction.

extras/odbc/odbc.m:
	Abort the transaction if the closure passed to odbc__transaction
	throws an exception, and rethrow the exception to the caller.

extras/odbc/odbc_test.m:
	Add a transaction which throws an exception to the test.

extras/odbc/Mmakefile:
	Minor changes to the set-up for iODBC 2.50.3.


Index: Mmakefile
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/odbc/Mmakefile,v
retrieving revision 1.2
diff -u -u -r1.2 Mmakefile
--- Mmakefile	1997/10/07 12:09:07	1.2
+++ Mmakefile	2000/03/21 03:42:38
@@ -22,7 +22,7 @@
 #MODBC_DB=MODBC_SQL_SERVER
 
 # Pathname for iODBC (only for MODBC_IODBC)
-IODBC_DIR=/home/mercury1/stayl/iodbc/iODBC-2.12
+IODBC_DIR=/home/aditi_db1/stayl/libiodbc-2.50.3
 
 # Pathname for the ODBC SDK (only for MODBC_MS)
 ODBC_SDK_DIR=/odbcsdk
@@ -34,9 +34,9 @@
 	MLLIBS=-lodbc32
 else 
 	ODBC_LIB_DIR=$(IODBC_DIR)/lib
-	ODBC_INCL_DIR=$(IODBC_DIR)
+	ODBC_INCL_DIR=$(IODBC_DIR)/include
 	# note: on a DEC Alpha using OSF1 remove the -ldl.
-	MLLIBS=-L$(ODBC_LIB_DIR) -liodbc -ldl
+	MLLIBS=-L$(ODBC_LIB_DIR) -R$(ODBC_LIB_DIR) -liodbc -ldl
 endif
 
 MAIN_TARGET=odbc_test
Index: odbc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/odbc/odbc.m,v
retrieving revision 1.9
diff -u -u -r1.9 odbc.m
--- odbc.m	1999/11/01 06:20:58	1.9
+++ odbc.m	2000/03/21 03:46:51
@@ -23,9 +23,11 @@
 %	<http://www.cs.mu.OZ.AU/publications/tr_db/mu_96_45_cover.ps.gz>
 %	and <http://www.cs.mu.OZ.AU/publications/tr_db/mu_96_45.ps.gz>.
 %
-% This has been tested with MySQL 3.20.19 and iODBC 2.12 under Solaris 2.5,
-% and with Microsoft SQL Server 6.5 under Windows NT 4.0 with the GNU-Win32 
-% tools beta 17.1.
+% This has been tested using the following platforms:
+% - MySQL 3.20.19 and iODBC 2.12 under Solaris 2.5
+% - MySQL 3.22.32 and iODBC 2.50.3 under Solaris 2.6
+% - Microsoft SQL Server 6.5 under Windows NT 4.0 with the
+%	GNU-Win32 tools beta 17.1
 %
 % Notes:
 %
@@ -76,8 +78,20 @@
 
 :- type odbc__state.
 
-	% Perform the closure atomically on the given database connection.
-	% On error, the transaction is rolled back.
+	% odbc__transaction(Source, UserName, Password, Transaction, Result).
+	%
+	% Open a connection to `Source' using the given `UserName'
+	% and `Password', perform `Transaction' within a transaction
+	% using that connection, then close the connection.
+	%
+	% `Result' is `ok(Results) - Messages' if the transaction
+	% succeeds or `error - Messages' if the transaction is aborted.
+	% Whether updates are rolled back if the transaction aborts depends
+	% on the database. MySQL will not roll back updates.
+	%
+	% If `Transaction' throws an exception, odbc__transaction will
+	% attempt to roll back the transaction, and will then rethrow
+	% the exception to the caller.
 :- pred odbc__transaction(odbc__data_source, odbc__user_name, odbc__password,
 		odbc__transaction(T), odbc__result(T), io__state, io__state).
 :- mode odbc__transaction(in, in, in, odbc__transaction, out, di, uo) is det.
@@ -265,7 +279,7 @@
 %-----------------------------------------------------------------------------%
 :- implementation.
 
-:- import_module assoc_list, int, require, std_util, string.
+:- import_module assoc_list, exception, int, require, std_util, string.
 
 %-----------------------------------------------------------------------------%
 
@@ -398,7 +412,8 @@
 static Word	odbc_message_list;
 
 static void odbc_transaction_c_code(Word type_info, Word Connection, 
-			Word Closure, Word *Results, Word *Status, 
+			Word Closure, Word *Results, Word *GotMercuryException,
+			Word *Exception, Word *Status, 
 			Word *Msgs, Word IO0, Word *IO);
 static bool odbc_check(SQLHENV, SQLHDBC, SQLHSTMT, SQLRETURN);
 
@@ -419,11 +434,22 @@
 
 		% Do the transaction.
 		odbc__transaction_2(Connection, Closure, Data, 
-			Status, RevMessages),
+			GotMercuryException, Exception, Status, RevMessages),
 		{ list__reverse(RevMessages, TransMessages) },
 
 		odbc__close_connection(Connection,
 			CloseStatus - CloseMessages),
+
+		%
+		% Pass on any exception that was found while
+		% processing the transaction.
+		%
+		( { GotMercuryException = 1 } ->
+			{ rethrow(exception(Exception)) }
+		;
+			[]
+		),
+
 		{ list__condense(
 			[ConnectMessages, TransMessages, CloseMessages], 
 			Messages) },
@@ -439,15 +465,15 @@
 
 :- pred odbc__transaction_2(odbc__connection,
 		pred(T, odbc__state, odbc__state), T, 
-		int, list(odbc__message), io__state, io__state).  
+		int, univ, int, list(odbc__message), io__state, io__state).  
 :- mode odbc__transaction_2(in, pred(out, di, uo) is det, 
-		out, out, out, di, uo) is det.
+		out, out, out, out, out, di, uo) is det.
 
 :- pragma c_code(
 		odbc__transaction_2(Connection::in, 
 			Closure::pred(out, di, uo) is det,
-			Results::out, Status::out, Msgs::out,
-			IO0::di, IO::uo),
+			Results::out, GotMercuryException::out, Exception::out,
+			Status::out, Msgs::out, IO0::di, IO::uo),
 		may_call_mercury,
 "
 	/*
@@ -460,7 +486,8 @@
 	*/
 	save_transient_registers();
 	odbc_transaction_c_code(TypeInfo_for_T, Connection, Closure, 
-			&Results, &Status, &Msgs, IO0, &IO);
+			&Results, &GotMercuryException, &Exception, 
+			&Status, &Msgs, IO0, &IO);
 	restore_transient_registers();
 ").
 
@@ -469,8 +496,8 @@
 "
 static void 
 odbc_transaction_c_code(Word TypeInfo_for_T, Word Connection, 
-		Word Closure, Word *Results, Word *Status, 
-		Word *Msgs, Word IO0, Word *IO)
+		Word Closure, Word *Results, Word *GotMercuryException,
+		Word *Exception, Word *Status, Word *Msgs, Word IO0, Word *IO)
 {
 	Word DB0 = (Word) 0;
 	Word DB = (Word) 0;
@@ -496,19 +523,32 @@
 	** MODBC_odbc__do_transaction() must be declared volatile.
 	*/
 
-	MODBC_odbc__do_transaction(TypeInfo_for_T, Closure, Results, DB0, &DB);
+	MODBC_odbc__do_transaction(TypeInfo_for_T, Closure,
+		GotMercuryException, Results, Exception, DB0, &DB);
 
 	/*
 	** MR_longjmp() cannot be called after here.
 	*/
 
-	rc = SQLTransact(odbc_env_handle, odbc_connection, SQL_COMMIT);
+	if (*GotMercuryException == 0) {
 
-	if (! odbc_check(odbc_env_handle, odbc_connection, 
-			SQL_NULL_HSTMT, rc)) {
-		goto transaction_error;
+		rc = SQLTransact(odbc_env_handle, odbc_connection, SQL_COMMIT);
+
+		if (! odbc_check(odbc_env_handle, odbc_connection, 
+				SQL_NULL_HSTMT, rc)) {
+			goto transaction_error;
+		}
+
+	} else {
+
+		/*
+		** There was a Mercury exception -- abort the transaction.
+		*/
+		DEBUG(printf(
+			""Mercury exception in transaction: aborting\\n""));
+		SQLTransact(odbc_env_handle, odbc_connection, SQL_ROLLBACK);
 	}
-	
+		
 	*Status = SQL_SUCCESS;
 
 	goto transaction_done;
@@ -522,6 +562,8 @@
 
 	*Status = odbc_ret_code;
 
+	*GotMercuryException = 0;
+
 	rc = SQLTransact(odbc_env_handle, odbc_connection, SQL_ROLLBACK);
 
 	odbc_check(odbc_env_handle, odbc_connection, SQL_NULL_HSTMT, rc);
@@ -543,15 +585,40 @@
 %-----------------------------------------------------------------------------%
 
 	% Call the transaction closure.
-:- pred odbc__do_transaction(odbc__transaction(T), T,
+:- pred odbc__do_transaction(odbc__transaction(T), int, T, univ,
 		odbc__state, odbc__state).
-:- mode odbc__do_transaction(odbc__transaction, out, di, uo) is det.
+:- mode odbc__do_transaction(odbc__transaction,
+		out, out, out, di, uo) is cc_multi.
 
-:- pragma export(odbc__do_transaction(odbc__transaction, out, di, uo), 
+:- pragma export(odbc__do_transaction(odbc__transaction,
+		out, out, out, di, uo), 
 		"MODBC_odbc__do_transaction").
+
+odbc__do_transaction(Closure, GotException, Results,
+		Exception, State0, State) :-
+	try((pred(TryResult::out) is det :-
+		unsafe_promise_unique(State0, State1),
+		Closure(Result, State1, ResultState),
+		TryResult = Result - ResultState
+	), ExceptResult),
+	(
+		ExceptResult = succeeded(Results - State2),
+		unsafe_promise_unique(State2, State),
+		make_dummy_value(Exception),
+		GotException = 0
+	;
+		ExceptResult = exception(Exception),
+		make_dummy_value(Results),
+		unsafe_promise_unique(State0, State),
+		GotException = 1
+	).
 
-odbc__do_transaction(Closure, Results) -->
-	call(Closure, Results).
+	% Produce a value which is never looked at, for returning
+	% discriminated unions to C.
+:- pred make_dummy_value(T::out) is det.
+:- pragma c_code(make_dummy_value(T::out),
+		[will_not_call_mercury, thread_safe],
+		"T = 0;").
 
 %-----------------------------------------------------------------------------%
 
@@ -958,6 +1025,7 @@
 static SQLRETURN odbc_do_cleanup_statement(MODBC_Statement *stat);
 static size_t sql_type_to_size(SWORD sql_type, UDWORD cbColDef, 
 		SWORD ibScale, SWORD fNullable);
+static MODBC_AttrType sql_type_to_attribute_type(SWORD sql_type);
 static SWORD attribute_type_to_sql_c_type(MODBC_AttrType AttrType);
 static bool is_variable_length_sql_type(SWORD);
 void odbc_do_get_data(MODBC_Statement *stat, int column_id);
Index: odbc_test.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/odbc/odbc_test.m,v
retrieving revision 1.2
diff -u -u -r1.2 odbc_test.m
--- odbc_test.m	1997/10/04 23:13:32	1.2
+++ odbc_test.m	2000/03/21 03:26:55
@@ -12,12 +12,12 @@
 
 :- import_module io.
 
-:- pred main(io__state::di, io__state::uo) is det.
+:- pred main(io__state::di, io__state::uo) is cc_multi.
 
 %-----------------------------------------------------------------------------%
 :- implementation.
 
-:- import_module list, string, std_util.
+:- import_module exception, list, string, std_util.
 :- import_module odbc.
 
 main -->
@@ -50,6 +50,7 @@
 	),
 	io__write_list(TableMessages, "\n", io__write),
 	io__nl,
+
 	odbc__transaction("test", "", "", test_trans, 
 		TransResult - TransMessages),
 	( 
@@ -66,13 +67,40 @@
 		io__write_string("error in transaction:\n")
 	),
 	io__write_list(TransMessages, "\n", io__write),
-	io__nl.
+	io__nl,
+
+	try_io(odbc__transaction("test", "", "", test_trans_2),
+		ExceptionResult),
+	(
+		{ ExceptionResult = succeeded(Results2) },
+		io__set_exit_status(1),
+		io__write_string("Error: expected exception, got results:"),
+		io__write(Results2),
+		io__nl
+	;
+		{ ExceptionResult = exception(Exception) },
+		{ det_univ_to_type(Exception, ExceptionString) },
+		io__write_string("Got exception: "),
+		io__write_string(ExceptionString),
+		io__nl
+	).
 
 :- pred test_trans(list(odbc__row)::out,
 		odbc__state::di, odbc__state::uo) is det.
 
 test_trans(Results) -->
 	odbc__solutions("select * from test", Results).
+
+:- pred test_trans_2(list(odbc__row)::out,
+		odbc__state::di, odbc__state::uo) is det.
+
+test_trans_2(Results) -->
+	odbc__solutions("select * from test", Results),
+	( { semidet_succeed } ->
+		{ throw("exception in test_trans_2") }
+	;	
+		[]
+	).
 
 :- pred output_results(list(odbc__row)::in,
 		io__state::di, io__state::uo) is det.
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to:       mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions:          mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------