scsh-conservatory
/
scsh-0.6
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

+ fixed various bugs introduced in last version

This commit is contained in:
eknauel 2003-03-20 16:28:50 +00:00
parent 45dfc0fbde
commit 2c1385f136
3 changed files with 1464 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1390
scsh/odbc/odbc-constants.scm
View File

File diff suppressed because it is too large Load Diff

25
scsh/odbc/odbc.c
View File

@ -21,7 +21,7 @@ s48_value odbc_alloc_environment_handle()
switch (retval)
{
case SQL_SUCCESS: case SQL_SUCCESS_WITH_INFO:
return s48_enter_integer(henv);
return s48_enter_integer((long)henv);
case SQL_ERROR:
ODBC_RAISE_EXCEPTION("SQLAllocHandle returned SQL_ERROR");
default:
@ -143,13 +143,13 @@ s48_value odbc_sql_alloc_env()
SQLRETURN retval;
SQLHENV eh;
ODBC_DEBUG_PRINTF("odbc_sql_alloc_env()\n");
ODBC_DEBUG_PRINTF_1("odbc_sql_alloc_env()\n");
retval = SQLAllocEnv(&eh);
switch (retval)
{
case SQL_SUCCESS: case SQL_SUCCESS_WITH_INFO:
return s48_enter_inteeger(eh);
return s48_enter_integer((long)eh);
case SQL_ERROR:
ODBC_RAISE_EXCEPTION("SQLAllocHandle() returned SQL_ERROR");
default:
@ -157,6 +157,7 @@ s48_value odbc_sql_alloc_env()
}
}
/* for ODBC 1.0 compatibility */
s48_value odbc_sql_alloc_connect(s48_value env_handle)
{
SQLRETURN retval;
@ -164,13 +165,13 @@ s48_value odbc_sql_alloc_connect(s48_value env_handle)
SQLHDBC ch;
eh = (SQLHENV) s48_extract_integer(env_handle);
ODBC_DEBUG_PRINTF("odbc_sql_alloc_connect(): eh:%d\n");
ODBC_DEBUG_PRINTF_2("odbc_sql_alloc_connect(): eh:%d\n", eh);
retval = SQLAllocConnect(ch, &eh);
switch (retval)
{
case SQL_SUCCESS: case SQL_SUCCESS_WITH_INFO:
return s48_enter_integer(ch);
return s48_enter_integer((long)ch);
case SQL_ERROR:
ODBC_RAISE_EXCEPTION("SQLAllocConnect returned SQL_ERROR");
case SQL_INVALID_HANDLE:
@ -180,6 +181,7 @@ s48_value odbc_sql_alloc_connect(s48_value env_handle)
}
}
/* for ODBC 1.0 compatibility */
s48_value odbc_sql_alloc_stmt(s48_value conn_handle)
{
SQLRETURN retval;
@ -187,13 +189,13 @@ s48_value odbc_sql_alloc_stmt(s48_value conn_handle)
SQLHSTMT sh;
ch = (SQLHDBC) s48_extract_integer(conn_handle);
ODBC_DEBUG_PRINTF("odbc_sql_alloc_stmt(): ch:%d\n");
ODBC_DEBUG_PRINTF_2("odbc_sql_alloc_stmt(): ch:%d\n", ch);
retval = SQLAllocStmt(ch, &eh);
retval = SQLAllocStmt(ch, &sh);
switch (retval)
{
case SQL_SUCCESS: case SQL_SUCCESS_WITH_INFO:
return s48_enter_integer(eh);
return s48_enter_integer((long)sh);
case SQL_ERROR:
ODBC_RAISE_EXCEPTION("SQLAllocStmt returned SQL_ERROR");
case SQL_INVALID_HANDLE:
@ -2509,7 +2511,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((SQLHSTMT) stmt_handle), s48_enter_integer(column_no));
s48_enter_integer((long) stmt_handle), s48_enter_integer(column_no));
}
s48_value bindcol_finalize_bindcols(s48_value stmt_handle)
@ -3719,6 +3721,11 @@ void s48_init_odbc(void)
S48_EXPORT_FUNCTION(odbc_alloc_environment_handle);
S48_EXPORT_FUNCTION(odbc_alloc_connection_handle);
S48_EXPORT_FUNCTION(odbc_alloc_statement_handle);
/* ODBC 1.0 compatibility */
S48_EXPORT_FUNCTION(odbc_sql_alloc_env);
S48_EXPORT_FUNCTION(odbc_sql_alloc_connect);
S48_EXPORT_FUNCTION(odbc_sql_alloc_stmt);
S48_EXPORT_FUNCTION(odbc_sql_connect);
S48_EXPORT_FUNCTION(odbc_sql_browse_connect);

60
scsh/odbc/odbc.scm
View File

@ -75,7 +75,7 @@
(define-exported-binding "odbc-column" :odbc-column)
(define-record-type odbc-parameter :odbc-parameter
(really-make-odbc-column type size digits nullable)
(really-make-odbc-parameter type size digits nullable)
odbc-parameter?
(type odbc-parameter-type)
(size odbc-parameter-size)
@ -125,6 +125,35 @@
(define sql-type-time 92) ; SQL_TYPE_TIME
(define sql-type-timestamp 93) ; SQL_TYPE_TIMESTAMP
(define (c-type-identifier->odbc-type-identifier c-type)
(error "Not yet implemented"))
(define (odbc-type-identifier->c-type-identifier odbc-type)
(cond ((member odbc-type '(sql-type-char sql-type-varchar))
sql-type-c-char)
((member odbc-type '(sql-type-real sql-type-float sql-type-double))
sql-type-c-double)
((equal? odbc-type sql-type-numeric)
sql-type-c-numeric)
((equal? odbc-type sql-type-decimal)
(error "Can't handle type SQL_DECIMAL yet"))
((equal? odbc-type sql-type-integer)
sql-type-c-long)
; ((equal? odbc-type sql-type-smallint)
; sql-type-c-smallint)
((equal? odbc-type sql-type-datetime)
(error "Can't handle type SQL_DATETIME yet"))
((equal? odbc-type sql-type-date)
(error "Can't handle type SQL_TYPE_DATE yet"))
((equal? odbc-type sql-type-time)
(error "Can't handle type SQL_TYPE_TIME yet"))
((equal? odbc-type sql-type-timestamp)
(error "Can't handle type SQL_TYPE_TIMESTAMP yet"))
((equal? odbc-type sql-type-unknown)
(error "Can't handle type SQL_UNKNOWN_TYPE"))
(else
(error "unknown SQL type"))))
;;; ODBC function ids for SQLGetFunctions
(define sql-api-sqlallocconnect 1)
(define sql-api-sqlallocenv 2)
@ -488,6 +517,7 @@
(stmt-handle)
"bindcol_finalize_bindcols")
;;; returns odbc-return-value
(define (odbc-sql-connect conn-handle server-name user-name auth)
(check-arg connection-handle? conn-handle odbc-sql-connect)
(let ((return-value (odbc-sql-connect-internal
@ -509,7 +539,33 @@
(import-lambda-definition odbc-sql-browse-connect-internal
(conn-handle connection-string)
"odbc_sql_browse_connect")
;;; for ODBC 1.0 compatibility
(define (odbc10-sql-alloc-env)
(really-make-environment-handle (odbc10-sql-alloc-env-internal)))
(import-lambda-definition odbc10-sql-alloc-env-internal
()
"odbc_sql_alloc_env")
(define (odbc10-sql-alloc-connect env-handle)
(check-arg environment-handle? env-handle odbc10-sql-alloc-connect)
(really-make-connection-handle
(odbc10-sql-alloc-connect-internal (environment-handle-handle env-handle)) env-handle #f))
(import-lambda-definition odbc10-sql-alloc-connect-internal
(env-handle)
"odbc_sql_alloc_env_handle")
(define (odbc10-sql-alloc-stmt conn-handle)
(check-arg connection-handle? conn-handle odbc10-sql-alloc-stmt)
(really-make-statement-handle
(odbc10-sql-alloc-stmt-internal (connection-handle-handle conn-handle))
conn-handle))
(import-lambda-definition odbc10-sql-alloc-stmt-internal
(conn-handle)
"odbc_sql_alloc_stmt_handle")
;;; PART 2