Changeset mysql-test,3 for mysql-test/src/odbc/odbc-functions.lisp
- Timestamp:
- 12/07/2007 02:13:22 PM (19 years ago)
- revision id:
- svn-v3-trunk1:1c22b0a8-4d0b-0410-a296-af6a2e6f35e3:plain-odbc%2Ftrunk:8
- File:
-
- 1 edited
-
mysql-test/src/odbc/odbc-functions.lisp (modified) (17 diffs)
Legend:
- Unmodified
- Added
- Removed
-
mysql-test/src/odbc/odbc-functions.lisp
r1 r3 17 17 `(let (,@allocs) 18 18 (unwind-protect 19 (progn ,@body) 20 ,@(mapcar (lambda (alloc) (list 'cffi:foreign-free (first alloc))) allocs)))) 21 22 19 (progn ,@body) 20 ,@(mapcar (lambda (alloc) (list 'cffi:foreign-free (first alloc))) 21 allocs)))) 22 23 23 24 24 25 … … 44 45 ()) 45 46 47 ;; TODO: Why doesn't this use with-temporary-allocations? -dso 46 48 (defun handle-error (henv hdbc hstmt) 47 48 49 50 (error-code (cffi:foreign-alloc :long))51 (msg-length (cffi:foreign-alloc :short)))52 (SQLError henv53 hdbc54 55 56 57 58 59 60 (cffi:mem-ref msg-length :short)61 (cffi:mem-ref error-code :long))))49 (let 50 ((sql-state (alloc-chars 256)) 51 (error-message (alloc-chars #.$SQL_MAX_MESSAGE_LENGTH)) 52 (error-code (cffi:foreign-alloc 'sql-integer)) 53 (msg-length (cffi:foreign-alloc 'sql-small-int))) 54 (SQLError henv 55 hdbc 56 hstmt sql-state 57 error-code error-message 58 $SQL_MAX_MESSAGE_LENGTH msg-length) 59 (values 60 (get-string-nts error-message) 61 (get-string-nts sql-state) 62 (cffi:mem-ref msg-length 'sql-small-int) 63 (cffi:mem-ref error-code 'sql-integer)))) 62 64 63 65 … … 67 69 ;#+ignore 68 70 (defun sql-state (henv hdbc hstmt) 69 (with-temporary-allocations 71 (with-temporary-allocations 70 72 ((sql-state (cffi:foreign-alloc :char :count 256)) 71 73 (error-message (cffi:foreign-alloc :char :count $SQL_MAX_MESSAGE_LENGTH)) 72 (error-code (cffi:foreign-alloc :long))73 (msg-length (cffi:foreign-alloc :short)))74 (error-code (cffi:foreign-alloc 'sql-integer)) 75 (msg-length (cffi:foreign-alloc 'sql-small-int))) 74 76 (SQLError henv hdbc hstmt sql-state error-code 75 77 error-message $SQL_MAX_MESSAGE_LENGTH msg-length) 76 (get-string sql-state 5) ;(%cstring-to-keyword sql-state)78 (get-string sql-state 5) ;(%cstring-to-keyword sql-state) 77 79 )) 78 80 … … 165 167 166 168 (defun %new-environment-handle () 167 (cffi:with-foreign-object (phenv 'sql-h andle)169 (cffi:with-foreign-object (phenv 'sql-h-env) 168 170 (with-error-handling 169 () 170 (SQLAllocEnv phenv) 171 (cffi:mem-ref phenv 'sql-handle) 172 ))) 173 174 (defun %sql-free-environment (henv) 175 (with-error-handling 176 (:henv henv) 177 (SQLFreeEnv henv))) 171 () 172 (SQLAllocEnv phenv) 173 (cffi:mem-ref phenv 'sql-h-env)))) 178 174 179 175 (defun %new-db-connection-handle (henv) 180 (cffi:with-foreign-object (phdbc 'sql-h andle)176 (cffi:with-foreign-object (phdbc 'sql-h-dbc) 181 177 (with-error-handling 182 178 (:henv henv) 183 (SQLAllocConnect henv phdbc)184 (cffi:mem-ref phdbc 'sql-h andle))))179 (SQLAllocConnect henv phdbc) 180 (cffi:mem-ref phdbc 'sql-h-dbc)))) 185 181 186 182 (defun %free-statement (hstmt option) 187 (with-error-handling 183 (with-error-handling 188 184 (:hstmt hstmt) 189 (SQLFreeStmt 190 hstmt 185 (SQLFreeStmt 186 hstmt 191 187 (ecase option 192 188 (:drop $SQL_DROP) … … 217 213 ;; functional interface 218 214 219 (defun %sql-connect (hdbc server uid pwd)220 (cffi:with-foreign-string (server-ptr server)221 (cffi:with-foreign-string (uid-ptr uid)222 (cffi:with-foreign-string (pwd-ptr pwd)223 (with-error-handling224 (:hdbc hdbc)225 (SQLConnect hdbc server-ptr $SQL_NTS uid-ptr226 $SQL_NTS pwd-ptr $SQL_NTS))))))227 228 215 ;; 229 216 (defun %sql-driver-connect (henv hdbc connection-string completion-option) 217 (declare (string connection-string)) 230 218 (let ((completion-option 231 219 (ecase completion-option … … 234 222 (:prompt $SQL_DRIVER_PROMPT) 235 223 (:noprompt $SQL_DRIVER_NOPROMPT)))) 236 (cffi:with-foreign-string (connection-str-ptr 224 (cffi:with-foreign-string (connection-str-ptr connection-string) 237 225 (with-temporary-allocations 238 226 ((complete-connection-str-ptr (alloc-chars 1024)) 239 (length-ptr (cffi:foreign-alloc :short)))240 (with-error-handling 227 (length-ptr (cffi:foreign-alloc 'sql-small-int))) 228 (with-error-handling 241 229 (:henv henv :hdbc hdbc) 242 243 (SQLDriverConnect hdbc 244 (cffi:null-pointer) ; no window 245 connection-str-ptr 246 (length connection-string) 247 ;$SQL_NTS 248 complete-connection-str-ptr 249 1024 250 length-ptr 251 completion-option)) 230 231 (SQLDriverConnect hdbc 232 (cffi:null-pointer) ; no window 233 connection-str-ptr ; TODO: How does 234 ; encoding affect the 235 ; length? 236 (length connection-string) ;$SQL_NTS 237 complete-connection-str-ptr 238 1024 239 length-ptr 240 completion-option)) 252 241 (get-string-nts complete-connection-str-ptr))))) 253 242 254 243 (defun %disconnect (hdbc) 255 (with-error-handling 256 (:hdbc hdbc)257 (SQLDisconnect hdbc)))244 (with-error-handling 245 (:hdbc hdbc) 246 (SQLDisconnect hdbc))) 258 247 259 248 (defun %commit (henv hdbc) 260 (with-error-handling 261 (:henv henv :hdbc hdbc)262 (SQLTransact263 henv hdbc $SQL_COMMIT)))249 (with-error-handling 250 (:henv henv :hdbc hdbc) 251 (SQLTransact 252 henv hdbc $SQL_COMMIT))) 264 253 265 254 (defun %rollback (henv hdbc) 266 (with-error-handling 267 (:henv henv :hdbc hdbc)268 (SQLTransact269 henv hdbc $SQL_ROLLBACK)))255 (with-error-handling 256 (:henv henv :hdbc hdbc) 257 (SQLTransact 258 henv hdbc $SQL_ROLLBACK))) 270 259 271 260 ; col-nr is zero-based in Lisp 272 261 ; col-nr = :bookmark retrieves a bookmark. 273 262 (defun %bind-column (hstmt column-nr c-type data-ptr precision out-len-ptr) 274 (with-error-handling 275 (:hstmt hstmt) 276 (SQLBindCol hstmt 277 (if (eq column-nr :bookmark) 0 (1+ column-nr)) 278 c-type data-ptr precision out-len-ptr))) 263 (declare (type (integer 0) column-nr)) 264 (with-error-handling 265 (:hstmt hstmt) 266 (SQLBindCol hstmt 267 (if (eq column-nr :bookmark) 0 (1+ column-nr)) 268 c-type data-ptr precision out-len-ptr))) 279 269 280 270 ; parameter-nr is zero-based in Lisp 281 271 (defun %sql-bind-parameter (hstmt parameter-nr parameter-type c-type 282 sql-type precision scale data-ptr 283 max-value out-len-ptr) 284 (with-error-handling 285 (:hstmt hstmt) 286 (SQLBindParameter hstmt (1+ parameter-nr) 287 parameter-type ;$SQL_PARAM_INPUT 288 c-type ;$SQL_C_CHAR 289 sql-type ;$SQL_VARCHAR 290 precision ;(1- (length str)) 291 scale ;0 292 data-ptr 293 max-value 294 out-len-ptr ;#.(cffi:null-pointer) 295 ))) 272 sql-type precision scale data-ptr 273 max-value out-len-ptr) 274 (declare (type (integer 0) parameter-nr)) 275 (with-error-handling 276 (:hstmt hstmt) 277 (SQLBindParameter hstmt (1+ parameter-nr) 278 parameter-type ;$SQL_PARAM_INPUT 279 c-type ;$SQL_C_CHAR 280 sql-type ;$SQL_VARCHAR 281 precision ;(1- (length str)) 282 scale ;0 283 data-ptr 284 max-value 285 out-len-ptr ;#.(cffi:null-pointer) 286 ))) 296 287 297 288 (defun %sql-fetch (hstmt) … … 301 292 302 293 (defun %new-statement-handle (hdbc) 303 (with-temporary-allocations 304 ((hstmt-ptr (cffi:foreign-alloc 'sql-h andle)))305 (with-error-handling 294 (with-temporary-allocations 295 ((hstmt-ptr (cffi:foreign-alloc 'sql-h-stmt))) 296 (with-error-handling 306 297 (:hdbc hdbc) 307 (SQLAllocStmt hdbc hstmt-ptr)308 (cffi:mem-ref hstmt-ptr 'sql-h andle))))298 (SQLAllocStmt hdbc hstmt-ptr) 299 (cffi:mem-ref hstmt-ptr 'sql-h-stmt)))) 309 300 310 301 (defun %sql-get-info (hdbc info-type) … … 344 335 #.$SQL_TABLE_TERM 345 336 #.$SQL_USER_NAME) 346 (with-temporary-allocations 337 (with-temporary-allocations 347 338 ((info-ptr (alloc-chars 1024)) 348 (info-length-ptr (cffi:foreign-alloc :short)))349 (with-error-handling 350 (:hdbc hdbc)351 339 (info-length-ptr (cffi:foreign-alloc 'sql-small-int))) 340 (with-error-handling 341 (:hdbc hdbc) 342 #-pcl 352 343 (SQLGetInfo hdbc info-type info-ptr 1023 info-length-ptr) 353 344 #+pcl 354 345 (SQLGetInfo-Str hdbc info-type info-ptr 1023 info-length-ptr) 346 ;; TODO: I believe the following assumes that the buffer was 347 ;; big enough to include the null-terminator. 355 348 (get-string-nts info-ptr)))) 356 ;; those returning a word349 ;; those returning a 16-bit integer 357 350 ((#.$SQL_ACTIVE_CONNECTIONS 358 351 #.$SQL_ACTIVE_STATEMENTS … … 383 376 #.$SQL_TXN_CAPABLE) 384 377 (with-temporary-allocations 385 ((info-ptr (cffi::foreign-alloc :short)) 386 (info-length-ptr (cffi::foreign-alloc :short))) 387 (with-error-handling 388 (:hdbc hdbc) 389 (SQLGetInfo hdbc 390 info-type 391 info-ptr 392 255 393 info-length-ptr) 394 (cffi:mem-ref info-ptr :short))) 395 ) 396 ;; those returning a long bitmask 397 ((#.$SQL_ALTER_TABLE 378 ((info-ptr (cffi::foreign-alloc 'sql-small-int)) 379 (info-length-ptr (cffi::foreign-alloc 'sql-small-int))) 380 (with-error-handling 381 (:hdbc hdbc) 382 (SQLGetInfo hdbc 383 info-type 384 info-ptr 385 0 386 info-length-ptr) 387 (cffi:mem-ref info-ptr 'sql-small-int)))) 388 ;; those returning a 32-bit bitmask 389 ((#.$SQL_ALTER_TABLE 398 390 #.$SQL_BOOKMARK_PERSISTENCE 399 391 #.$SQL_CONVERT_BIGINT … … 440 432 #.$SQL_TXN_ISOLATION_OPTION 441 433 #.$SQL_UNION) 442 (with-temporary-allocations 443 ((info-ptr (cffi:foreign-alloc :unsigned-long)) 444 (info-length-ptr (cffi:foreign-alloc :short))) 445 (with-error-handling 446 (:hdbc hdbc) 447 (SQLGetInfo hdbc 448 info-type 449 info-ptr 450 255 451 info-length-ptr) 452 (cffi:mem-ref info-ptr :unsigned-long))) 453 ) 454 ;; those returning a long integer 434 (with-temporary-allocations 435 ;; TODO: It'd be nice to have this as a sql-* type. However, 436 ;; while the X/Open spec is usually quiet about data sizes, 437 ;; it specifically says a 32-bit bitmask for these; so if 438 ;; SQL-INTEGER changes to 64-bit, these may or may not change 439 ;; as well. -dso 440 ((info-ptr (cffi:foreign-alloc :uint32)) 441 (info-length-ptr (cffi:foreign-alloc 'sql-small-int))) 442 (with-error-handling 443 (:hdbc hdbc) 444 (SQLGetInfo hdbc 445 info-type 446 info-ptr 447 0 448 info-length-ptr) 449 (cffi:mem-ref info-ptr :uint32)))) 450 ;; those returning an integer 455 451 ((#.$SQL_DEFAULT_TXN_ISOLATION 456 452 #.$SQL_DRIVER_HDBC … … 462 458 #.$SQL_MAX_BINARY_LITERAL_LEN 463 459 #.$SQL_MAX_CHAR_LITERAL_LEN 464 #.$SQL_ACTIVE_ENVIRONMENTS 465 ) 466 (with-temporary-allocations 467 ((info-ptr (cffi:foreign-alloc :long)) 468 (info-length-ptr (cffi:foreign-alloc :short))) 469 (with-error-handling 470 (:hdbc hdbc) 471 (SQLGetInfo hdbc info-type info-ptr 255 info-length-ptr) 472 (cffi:mem-ref info-ptr :unsigned-long)))))) 460 #.$SQL_ACTIVE_ENVIRONMENTS) 461 (with-temporary-allocations 462 ((info-ptr (cffi:foreign-alloc 'sql-integer)) 463 (info-length-ptr (cffi:foreign-alloc 'sql-small-int))) 464 (with-error-handling 465 (:hdbc hdbc) 466 (SQLGetInfo hdbc info-type info-ptr 0 info-length-ptr) 467 (cffi:mem-ref info-ptr 'sql-integer)))))) 473 468 474 469 (defun %sql-exec-direct (sql hstmt henv hdbc) 470 (declare (string sql)) 475 471 (cffi:with-foreign-string (sql-ptr sql) 476 472 (with-error-handling 477 473 (:hstmt hstmt :henv henv :hdbc hdbc) 478 (SQLExecDirect hstmt sql-ptr $SQL_NTS)))) 479 480 (defun %sql-cancel (hstmt) 481 (with-error-handling 482 (:hstmt hstmt) 483 (SQLCancel hstmt))) 474 (SQLExecDirect hstmt sql-ptr $SQL_NTS)))) 484 475 485 476 (defun %sql-execute (hstmt) 486 477 (with-error-handling 487 (:hstmt hstmt)488 (SQLExecute hstmt)))478 (:hstmt hstmt) 479 (SQLExecute hstmt))) 489 480 490 481 (defun result-columns-count (hstmt) 491 482 (with-temporary-allocations 492 ((columns-nr-ptr (cffi:foreign-alloc :short)))483 ((columns-nr-ptr (cffi:foreign-alloc 'sql-small-int))) 493 484 (with-error-handling (:hstmt hstmt) 494 495 (cffi:mem-ref columns-nr-ptr :short))))485 (SQLNumResultCols hstmt columns-nr-ptr) 486 (cffi:mem-ref columns-nr-ptr 'sql-small-int)))) 496 487 497 488 (defun result-rows-count (hstmt) 498 489 (with-temporary-allocations 499 ((row-count-ptr (cffi:foreign-alloc :long)))490 ((row-count-ptr (cffi:foreign-alloc 'sql-len))) 500 491 (with-error-handling (:hstmt hstmt) 501 502 (cffi:mem-ref row-count-ptr :long))))492 (SQLRowCount hstmt row-count-ptr) 493 (cffi:mem-ref row-count-ptr 'sql-len)))) 503 494 504 495 … … 508 499 ;; Column counting is 1-based 509 500 (defun %describe-column (hstmt column-nr) 510 (with-temporary-allocations ((column-name-ptr (alloc-chars 256)) 511 (column-name-length-ptr (cffi:foreign-alloc :short)) 512 (column-sql-type-ptr (cffi:foreign-alloc :short)) 513 (column-precision-ptr (cffi:foreign-alloc :unsigned-long)) 514 (column-scale-ptr (cffi:foreign-alloc :short)) 515 (column-nullable-p-ptr (cffi:foreign-alloc :short))) 501 (declare (type (integer 1) column-nr)) 502 (with-temporary-allocations 503 ((column-name-ptr (alloc-chars 256)) 504 (column-name-length-ptr (cffi:foreign-alloc 'sql-small-int)) 505 (column-sql-type-ptr (cffi:foreign-alloc 'sql-small-int)) 506 (column-precision-ptr (cffi:foreign-alloc 'sql-u-len)) 507 (column-scale-ptr (cffi:foreign-alloc 'sql-small-int)) 508 (column-nullable-p-ptr (cffi:foreign-alloc 'sql-small-int))) 516 509 (with-error-handling (:hstmt hstmt) 517 518 519 520 521 522 510 (SQLDescribeCol hstmt column-nr column-name-ptr 256 511 column-name-length-ptr 512 column-sql-type-ptr 513 column-precision-ptr 514 column-scale-ptr 515 column-nullable-p-ptr) 523 516 (values 524 517 (get-string-nts column-name-ptr) 525 (cffi:mem-ref column-sql-type-ptr :short) 526 (cffi:mem-ref column-precision-ptr :unsigned-long) 527 (cffi:mem-ref column-scale-ptr :short) 528 (cffi:mem-ref column-nullable-p-ptr :short))))) 529 530 ;; parameter counting is 1-based 531 (defun %describe-parameter (hstmt parameter-nr) 532 (with-temporary-allocations ((column-sql-type-ptr (cffi:foreign-alloc :short)) 533 (column-precision-ptr (cffi:foreign-alloc :long)) 534 (column-scale-ptr (cffi:foreign-alloc :short)) 535 (column-nullable-p-ptr (cffi:foreign-alloc :short))) 536 (with-error-handling 537 (:hstmt hstmt) 538 (SQLDescribeParam hstmt parameter-nr 539 column-sql-type-ptr 540 column-precision-ptr 541 column-scale-ptr 542 column-nullable-p-ptr) 543 (values 544 (cffi:mem-ref column-sql-type-ptr :short) 545 (cffi:mem-ref column-precision-ptr :unsigned-long) 546 (cffi:mem-ref column-scale-ptr :short) 547 (cffi:mem-ref column-nullable-p-ptr :short))))) 548 549 (defun %column-attributes (hstmt column-nr descriptor-type) 550 (with-temporary-allocations 551 ((descriptor-info-ptr (alloc-chars 256)) 552 (descriptor-length-ptr (cffi:foreign-alloc :short)) 553 (numeric-descriptor-ptr (cffi:foreign-alloc :long))) 554 (with-error-handling 555 (:hstmt hstmt) 556 (SQLColAttributes hstmt column-nr descriptor-type descriptor-info-ptr 256 557 descriptor-length-ptr 558 numeric-descriptor-ptr) 559 (values 560 (get-string-nts descriptor-info-ptr) 561 (cffi:mem-ref numeric-descriptor-ptr :long))))) 518 (cffi:mem-ref column-sql-type-ptr 'sql-small-int) 519 (cffi:mem-ref column-precision-ptr 'sql-u-len) 520 (cffi:mem-ref column-scale-ptr 'sql-small-int) 521 (cffi:mem-ref column-nullable-p-ptr 'sql-small-int))))) 562 522 563 523 … … 590 550 (fetch-all-rows hstmt))) 591 551 592 (defun %sql-data-sources (henv &key (direction :first))593 (with-temporary-allocations594 ((name-ptr (alloc-chars (1+ $SQL_MAX_DSN_LENGTH)))595 (name-length-ptr (cffi:foreign-alloc :short))596 (description-ptr (alloc-chars 1024))597 (description-length-ptr (cffi:foreign-alloc :short)))598 (let ((res (with-error-handling599 (:henv henv)600 (SQLDataSources henv601 (ecase direction602 (:first $SQL_FETCH_FIRST)603 (:next $SQL_FETCH_NEXT))604 name-ptr605 (1+ $SQL_MAX_DSN_LENGTH)606 name-length-ptr607 description-ptr608 1024609 description-length-ptr))))610 (unless (= res $SQL_NO_DATA_FOUND)611 (values (get-string-nts name-ptr)612 (get-string-nts description-ptr))))))613 614 552 615 553 (defun %sql-prepare (hstmt sql) 554 (declare (string sql)) 616 555 (cffi:with-foreign-string (sql-ptr sql) 617 556 (with-error-handling (:hstmt hstmt) 618 (SQLPrepare hstmt sql-ptr $SQL_NTS)))) 619 620 ;; depending on option, we return a long int or a string; string not implemented 621 (defun get-connection-option (hdbc option) 622 (with-temporary-allocations 623 ((param-ptr (cffi:foreign-alloc :long))) ;#+ignore #.(1+ $SQL_MAX_OPTION_STRING_LENGTH))) 624 (with-error-handling (:hdbc hdbc) 625 (SQLGetConnectOption hdbc option param-ptr) 626 (cffi:mem-ref param-ptr :long)))) 557 (SQLPrepare hstmt sql-ptr $SQL_NTS)))) 627 558 628 559 (defun set-connection-option (hdbc option param) 629 560 (with-error-handling (:hdbc hdbc) 630 (SQLSetConnectOption hdbc option param)))561 (SQLSetConnectOption hdbc option param))) 631 562 632 563 (defun disable-autocommit (hdbc) … … 637 568 638 569 639 ***570 ;;;*** 640 571 ;;; rav, 11.6.2005 641 572 ;;; added tracing support … … 643 574 (defun set-connection-attr-integer (hdbc option val) 644 575 (with-error-handling (:hdbc hdbc) 645 (SQLSetConnectAttr_long hdbc option val 0)))576 (SQLSetConnectAttr_long hdbc option val 0))) 646 577 647 578 (defun set-connection-attr-string (hdbc option val) 648 (with-error-handling (:hdbc hdbc) 649 (cffi:with-foreign-string (ptr val) 650 (SQLSetConnectAttr_string hdbc option ptr (length val))))) 579 (with-error-handling (:hdbc hdbc) 580 (cffi:with-foreign-string (ptr val) 581 ;; TODO: Null-terminator with length? 582 (SQLSetConnectAttr_string hdbc option ptr (length val))))) 651 583 652 584 (defun %start-connection-trace (hdbc filename) … … 656 588 (defun %stop-connection-trace (hdbc) 657 589 (set-connection-attr-integer hdbc $SQL_ATTR_TRACE $SQL_OPT_TRACE_OFF)) 658 659 660 (defun get-connection-attr-integer (hdbc attr)661 (with-temporary-allocations662 ((ptr (cffi:foreign-alloc :long))663 (lenptr (cffi:foreign-alloc :long)))664 (with-error-handling (:hdbc hdbc)665 (SQLGetConnectAttr hdbc attr ptr 0 lenptr))666 (cffi:mem-ref ptr :long)))667 668 (defun get-connection-attr-string (hdbc attr)669 (with-temporary-allocations670 ((ptr (alloc-chars 256))671 (lenptr (cffi:foreign-alloc :long)))672 (with-error-handling (:hdbc hdbc)673 (SQLGetConnectAttr hdbc attr ptr 256 lenptr))674 (get-string ptr (cffi:mem-ref lenptr :long))))675 676 ;;; small test for the get-connection-attr677 (defun %get-current-catalog (hdbc)678 (get-connection-attr-string hdbc $SQL_ATTR_CURRENT_CATALOG))679 680 (defun %set-current-catalog (hdbc catalog)681 (set-connection-attr-string hdbc $SQL_ATTR_CURRENT_CATALOG catalog))682 683 684 685 (defun %connection-ok-p (hdbc)686 (with-error-handling (:hdbc hdbc)687 (ecase (get-connection-attr-integer hdbc $SQL_ATTR_CONNECTION_DEAD)688 (#.$sql_cd_true nil)689 (#.$sql_cd_false t))))690 590 691 591 ;;; 692 693 694 (defun %sql-set-pos (hstmt row option lock)695 (with-error-handling696 (:hstmt hstmt)697 (SQLSetPos hstmt row option lock)))698 699 (defun %sql-extended-fetch (hstmt fetch-type row)700 (with-temporary-allocations701 ((row-count-ptr (cffi:foreign-alloc :unsigned-long))702 (row-status-ptr (cffi:foreign-alloc :short)))703 (with-error-handling (:hstmt hstmt)704 (SQLExtendedFetch hstmt fetch-type row row-count-ptr705 row-status-ptr)706 (values (cffi:mem-ref row-count-ptr :unsigned-long)707 (cffi:mem-ref row-status-ptr :short)))))708 592 709 593 ; column-nr is zero-based 710 594 (defun %sql-get-data (hstmt column-nr c-type data-ptr precision out-len-ptr) 711 (with-error-handling 712 (:hstmt hstmt :print-info nil) 713 (SQLGetData hstmt (if (eq column-nr :bookmark) 0 (1+ column-nr)) 714 c-type data-ptr precision out-len-ptr))) 595 (declare (type (integer 0) column-nr)) 596 (with-error-handling 597 (:hstmt hstmt :print-info nil) 598 (SQLGetData hstmt (if (eq column-nr :bookmark) 0 (1+ column-nr)) 599 c-type data-ptr precision out-len-ptr))) 715 600 716 601 (defun %sql-get-data-raw (hstmt position c-type data-ptr buffer-length ind-ptr) 602 (declare (type (integer 0) position)) 717 603 (SQLGetData hstmt (1+ position) 718 604 c-type data-ptr buffer-length ind-ptr)) … … 727 613 (with-error-handling 728 614 (:hstmt hstmt :print-info t) ;; nil 729 (SQLPutData hstmt data-ptr size)))615 (SQLPutData hstmt data-ptr size))) 730 616 731 617
Note: See TracChangeset
for help on using the changeset viewer.
