+ This version introduces the all new SQLBindCol(), which might (in

contrast to former versions) someday be capable of returning things
  like SQL_TIME_STRUCT, SQL_DATE_STRUCT, SQL_TIMESTAMP_STRUCT and
  SQL_NUMERIC_STRUCT.
+ However, SQLGetData() is now even more broken than before (if used
  on integer columns). It seems, that I failed to understand the API
  reference on SQLGetData() completly!

scsh/odbc/odbc-bindcol.scm

@@ -23,31 +23,15 @@
   (check-arg statement-handle? stmt-handle odbc-sql-bindcol)
   (let ((handle (statement-handle-handle stmt-handle)))
     (odbc-sql-bindcol-internal handle column-no target-type buffer-len)
-    (cond ((equal? target-type sql-type-c-char)
+    (lambda ()
-	   (lambda ()
+      (bindcol-lookup-binding-scheme handle column-no))))
-	     (display "lookup char")
-	     (newline)
- 	     (bindcol-lookup-binding-char handle column-no)))
-	  ((or (equal? target-type sql-type-c-long)
-	       (equal? target-type sql-type-c-short))
-	   (lambda ()
-	     (display "lookup int")
-	     (newline)
-	     (bindcol-lookup-binding-int handle column-no)))
-	  (else
-	   (error "Can't handle that datatype yet" target-type)))))
 
 (import-lambda-definition odbc-sql-bindcol-internal
 			  (stmt-handle column-no target-type buffer-len)
 			  "odbc_sql_bindcol")
 
-(import-lambda-definition bindcol-lookup-binding-int
+(import-lambda-definition bindcol-lookup-binding-scheme
 			  (stmt-handle column-no)
-			  "bindcol_lookup_binding_int")
+			  "bindcol_lookup_binding_scheme")
-
-(import-lambda-definition bindcol-lookup-binding-char
-			  (stmt-handle column-no)
-			  "bindcol_lookup_binding_char")
-
 
 

scsh/odbc/odbc.c

@@ -119,8 +119,8 @@ s48_value odbc_alloc_statement_handle(s48_value conn_handle) {
   SQLHANDLE ch;
 
   ch = (SQLHANDLE) s48_extract_integer(conn_handle);
-  
   retval = SQLAllocHandle(SQL_HANDLE_STMT, ch, &hstmt);
+
   ODBC_DEBUG_PRINTF_3("odbc_alloc_statement_handle() %x %x\n", ch, hstmt);
 
   switch (retval) 
@@ -1839,85 +1839,44 @@ s48_value odbc_sql_get_data(s48_value stmt_handle,
   SQLUSMALLINT cn;
   SQLSMALLINT tt;
   SQLRETURN retval;
-
+  SQLINTEGER buffer_needed, buffer_len = ODBC_RETVAL_BUFFER_INITIAL_SIZE;
-  ODBC_DEBUG_PRINTF_1("odbc_sql_get_data\n");
+  void *buffer = NULL;
 
   sh = (SQLHSTMT) s48_extract_integer(stmt_handle);
   cn = (SQLUSMALLINT) s48_extract_integer(column_number);
   tt = (SQLSMALLINT) s48_extract_integer(target_type);
 
+  ODBC_DEBUG_PRINTF_4("odbc_sql_get_data() sh:%x cn:%d tt:%d\n", sh, cn, tt);
 
-  switch (tt)
+  for (;;)
-  {
+    {
-  case SQL_C_CHAR:
+      odbc_sql_alloc((void **) &buffer, buffer_len, 
-  case SQL_C_BINARY:
+		     sizeof_sql_c_type_identifier(tt));
-  {
+      retval = SQLGetData(sh, cn, tt, buffer,
-    SQLCHAR *buffer = NULL;
+			  buffer_len, &buffer_needed);
-    SQLINTEGER buffer_len, buffer_needed;
+      if (ODBC_SUCCESS(retval) && (buffer_needed > buffer_len))
-    s48_value res = S48_UNSPECIFIC;
+	buffer_len = buffer_needed+1;
-
+      else
-    buffer_len = ODBC_RETVAL_BUFFER_INITIAL_SIZE;
+	break;
-    for (;;)
-      {
-	odbc_sql_alloc((void **) &buffer, buffer_len, sizeof(SQLCHAR)); 
-	retval = SQLGetData(sh, cn, tt,
-			    buffer, buffer_len, &buffer_needed);
-	if (ODBC_SUCCESS(retval) && (buffer_needed > buffer_len))
-	  buffer_len = buffer_needed+1;
-	else
-	  break;
       }
-    check_sql_get_data_result(retval, sh);
-    res = s48_enter_string(buffer);
-    free(buffer);
-    return res;
-  }
-  case SQL_C_SSHORT:
-  case SQL_C_USHORT:
-  case SQL_C_SLONG:
-  case SQL_C_ULONG:
-  {
-    long int i;
-    SQLINTEGER rest;
-    
-    retval = SQLGetData(sh, cn, tt,
-			&i, sizeof(long int), &rest);
-    check_sql_get_data_result(retval, sh);
-    return s48_enter_integer(i);
-  }
-  }
-}
-
-void check_sql_get_data_result(SQLRETURN retval, SQLHSTMT stmt_handle)
-{
 
   switch (retval)
-  {
+    {
-  case SQL_SUCCESS: case SQL_SUCCESS_WITH_INFO:
+    case SQL_SUCCESS: case SQL_SUCCESS_WITH_INFO:
-  {
+      {
-    return;
+	s48_value res = buffer_to_s48_value(buffer, tt);
-  }
+	free(buffer);
-  case SQL_NO_DATA:
+	return res;
-  {
+      }
-    ODBC_RAISE_EXCEPTION("SQLGetData returned SQL_NO_DATA");
+    case SQL_NO_DATA:
-    break;
+      ODBC_RAISE_EXCEPTION("SQLGetData returned SQL_NO_DATA");
-  }
+    case SQL_STILL_EXECUTING:
-  case SQL_STILL_EXECUTING:
+      ODBC_RAISE_EXCEPTION("SQLGetData returned SQL_STILL_EXECUTING, not yet implemented");
-  {
+    case SQL_ERROR:
-    ODBC_RAISE_EXCEPTION("SQLGetData returned SQL_STILL_EXECUTING, not yet implemented");
+      ODBC_RAISE_EXCEPTION("SQLGetData returned SQL_ERROR");
-    break;
+    default:
-  }
+      ODBC_RAISE_EXCEPTION("SQLGetData returned unknown error code");
-  case SQL_ERROR:
+    }
-  {
-    ODBC_RAISE_EXCEPTION("SQLGetData returned SQL_ERROR");
-    break;
-  }
-  case SQL_INVALID_HANDLE:
-  {
-    ODBC_RAISE_EXCEPTION("SQLGetData got invalid handle");
-    break;
-  }
-  }
 }
 
 /* Positions a cursor within a fetched block of data and allows an application
@@ -1930,13 +1889,13 @@ s48_value odbc_sql_set_pos(s48_value stmt_handle, s48_value row_number,
   SQLUSMALLINT rn, op, lt;
   SQLRETURN retval;
 
-  ODBC_DEBUG_PRINTF_1("odbc_sql_set_pos\n");
-
   sh = (SQLHSTMT) s48_extract_integer(stmt_handle);
   rn = (SQLUSMALLINT) s48_extract_integer(row_number);
   op = (SQLUSMALLINT) s48_extract_integer(operation);
   lt = (SQLUSMALLINT) s48_extract_integer(lock_type);
 
+  ODBC_DEBUG_PRINTF_5("odbc_sql_set_pos() sh:%x rn:%d op:%d lt:%d\n", sh, rn, op, lt);
+
   retval = SQLSetPos(sh, rn, op, lt);
 
   switch (retval)
@@ -2062,9 +2021,8 @@ s48_value odbc_sql_fetch(s48_value stmt_handle)
   SQLHSTMT sh;
   SQLRETURN retval;
   
-  ODBC_DEBUG_PRINTF_1("odbc_sql_fetch\n");
-  
   sh = (SQLHSTMT) s48_extract_integer(stmt_handle);
+  ODBC_DEBUG_PRINTF_2("odbc_sql_fetch() %x\n", sh);
   
   retval = SQLFetch(sh);
 
@@ -2308,16 +2266,16 @@ ColumnRecPtr bindcol_lookup_binding(SQLHSTMT stmt_handle, SQLUSMALLINT column_no
   return NULL;
 }
 
-s48_value bindcol_lookup_binding_int(s48_value stmt_handle, s48_value column_no)
+s48_value bindcol_lookup_binding_scheme(s48_value stmt_handle, s48_value column_no)
 {
   SQLHSTMT sh;
-  SQLSMALLINT cn;
+  SQLUSMALLINT cn;
   ColumnRecPtr col;
   
   sh = (SQLHSTMT) s48_extract_integer(stmt_handle);
-  cn = (SQLSMALLINT) s48_extract_integer(column_no);
+  cn = (SQLUSMALLINT) s48_extract_integer(column_no);
 
-  ODBC_DEBUG_PRINTF_3("bindcol_lookup_binding_int() %x %d\n", sh, cn);
+  ODBC_DEBUG_PRINTF_3("bindcol_lookup_binding_scheme() sh:%x cn:%d\n", sh, cn);
   col = bindcol_lookup_binding(sh, cn);
 
   if (col == NULL)
@@ -2325,36 +2283,11 @@ s48_value bindcol_lookup_binding_int(s48_value stmt_handle, s48_value column_no)
 		    stmt_handle, column_no);
   else
     {
-      ODBC_DEBUG_PRINTF_3("bindcol_lookup_binding_int(): %x %d\n", 
+      ODBC_DEBUG_PRINTF_2("bindcol_lookup_binding_scheme(): col_buf:%x\n", col->col_buffer);
-			  col->col_buffer, *((SQLINTEGER *) col->col_buffer)); 
+      return buffer_to_s48_value(col->col_buffer, col->target_type);
-      return s48_enter_integer(*((SQLINTEGER *) col->col_buffer));
     }
 }
 
-s48_value bindcol_lookup_binding_char(s48_value stmt_handle, s48_value column_no)
-{
-  ColumnRecPtr col;
-
-  ODBC_DEBUG_PRINTF_3("bindcol_lookup_binding_char(): %x %d\n", stmt_handle, column_no);
-  col = bindcol_lookup_binding((SQLHSTMT) s48_extract_integer(stmt_handle),
-			       (SQLUSMALLINT) s48_extract_integer(column_no));
-
-  if (col == NULL)
-    s48_call_scheme(S48_SHARED_BINDING_REF(signal_unbound_column), 2, stmt_handle, column_no);
-  else
-    {
-      ODBC_DEBUG_PRINTF_3("bindcol_lookup_binding_char(): %x %d\n", col->col_buffer, 
-			  (SQLCHAR *) col->col_buffer);
-      if (col->buffer_needed > col->buffer_len)
-	s48_call_scheme(S48_SHARED_BINDING_REF(signal_buffer_exceeded), 2,
-			s48_enter_integer(col->buffer_needed), 
-			s48_enter_string((SQLCHAR *) col->col_buffer));
-      else
-	return s48_enter_string((SQLCHAR *) col->col_buffer);
-    }
-}
-
-
 /* Semantics differs from original SQLBindCol(), due to the need of
    bookkeeping a target buffer list in C. odbc_sql_bindcol() handles
    column binding and rebinding, but not unbinding. To unbind a column
@@ -2525,7 +2458,7 @@ void bindcol_unbind_colum(SQLHSTMT stmt_handle, SQLUSMALLINT column_no)
       stmt = stmt->next;
     }
   s48_call_scheme(S48_SHARED_BINDING_REF(signal_unbound_column), 2, 
-		  s48_enter_integer(stmt_handle), s48_enter_integer(column_no));
+		  s48_enter_integer((SQLHSTMT) stmt_handle), s48_enter_integer(column_no));
 }
 
 s48_value bindcol_finalize_bindcols(s48_value stmt_handle)
@@ -3498,6 +3431,9 @@ s48_value struct_to_sql_date_record(SQL_DATE_STRUCT *ds)
 {
   s48_value sql_date;
 
+  S48_DECLARE_GC_PROTECT(1);
+  S48_GC_PROTECT_1(sql_date);
+
   sql_date = s48_make_record(sql_date_record_type);
 
   S48_RECORD_SET(sql_date, SR_SQL_DATE_YEAR,
@@ -3507,6 +3443,7 @@ s48_value struct_to_sql_date_record(SQL_DATE_STRUCT *ds)
   S48_RECORD_SET(sql_date, SR_SQL_DATE_DAY,
 		 s48_enter_integer(ds->day));
 
+  S48_GC_UNPROTECT();
   return sql_date;
 }
   
@@ -3528,6 +3465,9 @@ s48_value struct_to_sql_time_record(SQL_TIME_STRUCT *ts)
 {
   s48_value sql_time;
 
+  S48_DECLARE_GC_PROTECT(1);
+  S48_GC_PROTECT_1(sql_time);
+
   sql_time = s48_make_record(sql_time_record_type);
   
   S48_RECORD_SET(sql_time, SR_SQL_TIME_HOUR,
@@ -3539,6 +3479,7 @@ s48_value struct_to_sql_time_record(SQL_TIME_STRUCT *ts)
   S48_RECORD_SET(sql_time, SR_SQL_TIME_SECOND,
 		 s48_extract_integer(ts->second));
 
+  S48_GC_UNPROTECT();
   return sql_time;
 }
 
@@ -3573,6 +3514,9 @@ s48_value struct_to_sql_timestamp_record(SQL_TIMESTAMP_STRUCT *ts)
 {
   s48_value sql_timestamp;
 
+  S48_DECLARE_GC_PROTECT(1);
+  S48_GC_PROTECT_1(sql_timestamp);
+
   sql_timestamp = s48_make_record(sql_timestamp_record_type);
 
   S48_RECORD_SET(sql_timestamp, SR_SQL_TIMESTAMP_YEAR,
@@ -3596,6 +3540,7 @@ s48_value struct_to_sql_timestamp_record(SQL_TIMESTAMP_STRUCT *ts)
   S48_RECORD_SET(sql_timestamp, SR_SQL_TIMESTAMP_FRACTION,
 		 s48_extract_integer(ts->fraction));
 
+  S48_GC_UNPROTECT();
   return sql_timestamp;
 }
 
@@ -3635,14 +3580,15 @@ size_t sizeof_sql_c_type_identifier(SQLSMALLINT ctypeid)
 	
 void odbc_sql_alloc(void **buffer, size_t buffer_len, size_t type_len)
 {
+  ODBC_DEBUG_PRINTF_4("odbc_sql_alloc(): bf:%x bl:%d tl: %d\n", buffer, buffer_len, type_len);
   if (*buffer == NULL)
     {
-      ODBC_DEBUG_PRINTF_3("calloc %d %d\n", buffer_len+1, type_len);
+      ODBC_DEBUG_PRINTF_3("calloc bl:%d tl:%d\n", buffer_len+1, type_len);
       *buffer = (void *) calloc(buffer_len+1, type_len);
     }
   else
     {
-      ODBC_DEBUG_PRINTF_2("realloc %d\n", buffer_len*type_len);
+      ODBC_DEBUG_PRINTF_2("realloc bl:%d\n", buffer_len*type_len);
       *buffer = (void *) realloc(*buffer, buffer_len*type_len);
     }
 
@@ -3653,6 +3599,43 @@ void odbc_sql_alloc(void **buffer, size_t buffer_len, size_t type_len)
     }
 }
 
+s48_value buffer_to_s48_value(void *buffer, SQLSMALLINT ctypeid)
+{
+  ODBC_DEBUG_PRINTF_3("buffer_to_s48_value(): %x %d\n", buffer, ctypeid);
+  switch (ctypeid)
+    {
+    case SQL_C_CHAR:
+      return s48_enter_string((SQLCHAR *) buffer);
+    case SQL_C_SSHORT: case SQL_C_SHORT:
+      return s48_enter_integer(*((SQLSMALLINT*) buffer));
+    case SQL_C_USHORT:
+      return s48_enter_integer(*((SQLUSMALLINT*) buffer));
+    case SQL_C_SLONG: case SQL_C_LONG:
+      return s48_enter_integer(*((SQLINTEGER*) buffer));
+    case SQL_C_ULONG:
+      return s48_enter_integer(*((SQLUINTEGER*) buffer));
+      /* case SQL_C_FLOAT: */
+      /* case SQL_C_DOUBLE: */
+      /* case SQL_C_BIT: */
+    case SQL_C_STINYINT:
+      return s48_enter_integer(*((SQLSCHAR *) buffer));
+    case SQL_C_UTINYINT:
+      return s48_enter_integer(*((SQLCHAR *) buffer));
+    case SQL_C_BINARY:
+      return s48_enter_string((SQLCHAR *) buffer);
+    case SQL_C_TYPE_DATE: 
+      return struct_to_sql_date_record((SQL_DATE_STRUCT *) buffer);
+    case SQL_C_TYPE_TIME:
+      return struct_to_sql_time_record((SQL_TIME_STRUCT *) buffer);
+    case SQL_C_TYPE_TIMESTAMP:
+      return struct_to_sql_timestamp_record((SQL_TIMESTAMP_STRUCT *) buffer);
+      /*    case SQL_C_NUMERIC: */
+    default:
+      ODBC_RAISE_EXCEPTION("Unknown c data type identifier");
+      break;
+    }
+}
+
 void s48_init_odbc(void)
 {
   /* bindings for record types */
@@ -3678,8 +3661,7 @@ void s48_init_odbc(void)
   global_bindcol_list = NULL;
 
   /* functions for SQLBindCol() */
-  S48_EXPORT_FUNCTION(bindcol_lookup_binding_int);
+  S48_EXPORT_FUNCTION(bindcol_lookup_binding_scheme);
-  S48_EXPORT_FUNCTION(bindcol_lookup_binding_char);
   S48_EXPORT_FUNCTION(odbc_sql_bindcol);
 
   /* PART 1 */

scsh/odbc/odbc.h

@@ -141,8 +141,8 @@ StmtRecPtr global_bindcol_list = NULL;
 
 /* helper functions needed for SQLBindCol() */
 ColumnRecPtr bindcol_lookup_binding(SQLHSTMT stmt_handle, SQLUSMALLINT column_no);
-s48_value bindcol_lookup_binding_int(s48_value stmt_handle, s48_value column_no);
+s48_value bindcol_lookup_binding_scheme(s48_value stmt_handle, s48_value column_no);
-s48_value bindcol_lookup_binding_char(s48_value stmt_handle, s48_value column_no);
+
 void bindcol_bind_column(SQLHSTMT stmt_handle, SQLUSMALLINT column_no, ColumnRecPtr new_col);
 void bindcol_unbind_colum(SQLHSTMT stmt_handle, SQLUSMALLINT column_no);
 s48_value bindcol_finalize_bindcols(s48_value stmt_handle);
@@ -335,8 +335,6 @@ s48_value odbc_sql_bulk_operations(s48_value stmt_handle, s48_value operation);
    initializes processing for the next result set */
 s48_value odbc_sql_more_results(s48_value stmt_handle);
 
-void check_sql_get_data_result(SQLRETURN retval, SQLHSTMT stmt_handle);
-
 s48_value odbc_sql_fetch(s48_value stmt_handle);
 
 s48_value odbc_sql_num_result_cols(s48_value stmt_handle);
@@ -483,7 +481,10 @@ void sql_timestamp_record_to_struct(s48_value sql_timestamp,
 				    SQL_TIMESTAMP_STRUCT *ts);
 
 void odbc_sql_alloc(void **buffer, size_t buffer_len, size_t type_len);
+
 size_t sizeof_sql_c_type_identifier(SQLSMALLINT ctypeid);
 
+s48_value buffer_to_s48_value(void *buffer, SQLSMALLINT ctypeid);
+
 void s48_init_odbc(void);