Changeset 14765 in project


Ignore:
Timestamp:
05/24/09 17:07:23 (10 years ago)
Author:
sjamaan
Message:

Rename to remove obnoxious result- prefix from procedures that happened to take a result object

Location:
release/4/postgresql/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/4/postgresql/trunk/postgresql.scm

    r14764 r14765  
    2929  exec-simple-queries exec-query
    3030 
    31   result? clear-result! result-row-count result-column-count
    32   result-column-index result-column-name result-column-names
    33   result-column-format result-column-type result-column-type-modifier
    34   result-table-oid result-table-column-index
    35   result-value result-row result-row-alist result-column
    36   result-affected-rows result-inserted-oid
     31  result? clear-result! row-count column-count
     32  column-index column-name column-names column-format
     33  column-type column-type-modifier table-oid table-column-index
     34  value-at row-values row-alist column-values affected-rows inserted-oid
    3735
    3836  invalid-oid
     
    315313    (PQclear result-ptr)))
    316314
    317 (define (result-row-count result)
     315(define (row-count result)
    318316  (PQntuples (pg-result-ptr result)))
    319317
    320 (define (result-column-count result)
     318(define (column-count result)
    321319  (PQnfields (pg-result-ptr result)))
    322320
    323321;; Helper procedures for bounds checking; so we can distinguish between
    324322;; out of bounds and nonexistant columns, and signal it.
    325 (define (check-result-column-index! result index location)
    326   (when (>= index (result-column-count result))
     323(define (check-column-index! result index location)
     324  (when (>= index (column-count result))
    327325    (postgresql-error
    328326     location (sprintf "Result column ~A out of bounds" index) result index)))
    329327
    330 (define (check-result-row-index! result index location)
    331   (when (>= index (result-row-count result))
     328(define (check-row-index! result index location)
     329  (when (>= index (row-count result))
    332330    (postgresql-error
    333331     location (sprintf "Result row ~A out of bounds" index) result index)))
    334332
    335 (define (result-column-name result index)
    336   (check-result-column-index! result index 'result-column)
     333(define (column-name result index)
     334  (check-column-index! result index 'column-name)
    337335  (string->symbol (PQfname (pg-result-ptr result) index)))
    338336
    339 (define (result-column-names result)
    340   (let loop ((ptr (pg-result-ptr result))
    341              (row '())
    342              (idx (result-column-count result)))
    343     (if (= idx 0)
    344         row
    345         (loop ptr (cons (string->symbol
    346                          (PQfname ptr (sub1 idx))) row) (sub1 idx)))))
    347 
    348 (define (result-column-index result name)
     337(define (column-names result)
     338  (let ((ptr (pg-result-ptr result)))
     339   (let loop ((names '())
     340              (column (column-count result)))
     341     (if (= column 0)
     342         names
     343         (loop (cons (string->symbol (PQfname ptr (sub1 column))) names)
     344               (sub1 column))))))
     345
     346(define (column-index result name)
    349347  (let ((idx (PQfnumber (pg-result-ptr result) (symbol->string name))))
    350348    (and (>= idx 0) idx)))
    351349
    352 (define (result-table-oid result index)
    353   (check-result-column-index! result index 'result-table-oid)
     350(define (table-oid result index)
     351  (check-column-index! result index 'table-oid)
    354352  (let ((oid (PQftable (pg-result-ptr result) index)))
    355353    (and (not (= oid invalid-oid)) oid)))
     
    358356;; consistent with the rest of Scheme.  However, this is inconsistent with
    359357;; almost all other PostgreSQL interfaces...
    360 (define (result-table-column-index result index)
    361   (check-result-column-index! result index 'result-table-column-index)
     358(define (table-column-index result index)
     359  (check-column-index! result index 'table-column-index)
    362360  (let ((idx (PQftablecol (pg-result-ptr result) index)))
    363361    (and (> idx 0) (sub1 idx))))
     
    375373      (postgresql-error 'format->symbol "Unknown format" symbol)))
    376374
    377 (define (result-column-format result index)
    378   (check-result-column-index! result index 'result-column-format)
     375(define (column-format result index)
     376  (check-column-index! result index 'column-format)
    379377  (format->symbol (PQfformat (pg-result-ptr result) index)))
    380378
    381 (define (result-column-type result index)
    382   (check-result-column-index! result index 'result-column-type)
     379(define (column-type result index)
     380  (check-column-index! result index 'column-type)
    383381  (PQftype (pg-result-ptr result) index))
    384382
    385383;; This is really not super-useful as it requires intimate knowledge
    386384;; about the internal implementations of types in PostgreSQL.
    387 (define (result-column-type-modifier result index)
    388   (check-result-column-index! result index 'result-column-type)
     385(define (column-type-modifier result index)
     386  (check-column-index! result index 'column-type)
    389387  (let ((mod (PQfmod (pg-result-ptr result) index)))
    390388    (and (>= mod 0) mod)))
    391389
    392390;; Unchecked version, for speed
    393 (define (result-value* result row column #!key raw)
     391(define (value-at* result row column #!key raw)
    394392  (if (PQgetisnull (pg-result-ptr result) row column)
    395393      (sql-null)
     
    409407            ((vector-ref (pg-result-value-parsers result) column) value)))))
    410408
    411 (define (result-value result row column #!key raw)
    412   (check-result-row-index! result row 'result-value)
    413   (check-result-column-index! result column 'result-value)
    414   (result-value* result row column raw: raw))
    415 
    416 (define (result-row result row #!key raw)
    417   (check-result-row-index! result row 'result-list)
     409(define (value-at result row column #!key raw)
     410  (check-row-index! result row 'value)
     411  (check-column-index! result column 'value)
     412  (value-at* result row column raw: raw))
     413
     414(define (row-values result row #!key raw)
     415  (check-row-index! result row 'row)
    418416  (let loop ((list '())
    419              (column (result-column-count result)))
     417             (column (column-count result)))
    420418    (if (= column 0)
    421419        list
    422         (loop (cons (result-value* result row (sub1 column) raw: raw) list)
     420        (loop (cons (value-at* result row (sub1 column) raw: raw) list)
    423421              (sub1 column)))))
    424422
    425 (define (result-column result column #!key raw)
    426   (check-result-column-index! result column 'result-list)
     423(define (column-values result column #!key raw)
     424  (check-column-index! result column 'column)
    427425  (let loop ((list '())
    428              (row (result-row-count result)))
     426             (row (row-count result)))
    429427    (if (= row 0)
    430428        list
    431         (loop (cons (result-value* result (sub1 row) column raw: raw) list)
     429        (loop (cons (value-at* result (sub1 row) column raw: raw) list)
    432430              (sub1 row)))))
    433431
    434 ;; (define (result-row-alist result row)
    435 ;;   (map cons (result-column-names result) (result-row result row)))
    436 (define (result-row-alist result row)
    437   (check-result-row-index! result row 'result-alist)
     432;; (define (row-alist result row)
     433;;   (map cons (column-names result) (row-values result row)))
     434(define (row-alist result row)
     435  (check-row-index! result row 'row-alist)
    438436  (let loop ((alist '())
    439              (column (result-column-count result)))
     437             (column (column-count result)))
    440438    (if (= column 0)
    441439        alist
    442440        (loop (cons (cons (string->symbol
    443441                           (PQfname (pg-result-ptr result) (sub1 column)))
    444                           (result-value* result row (sub1 column))) alist)
     442                          (value-at* result row (sub1 column))) alist)
    445443              (sub1 column)))))
    446444
    447445;;; TODO: Do we want/need PQnparams and PQparamtype bindings?
    448446
    449 (define (result-affected-rows result)
     447(define (affected-rows result)
    450448  (string->number (PQcmdTuples (pg-result-ptr result))))
    451449
    452 (define (result-inserted-oid result)
     450(define (inserted-oid result)
    453451  (let ((oid (PQoidValue (pg-result-ptr result))))
    454452    (and (not (= oid invalid-oid)) oid)))
     
    686684(define (%query-fold kons knil conn query params)
    687685  (let* ((result (exec-query conn query params))
    688          (rows (result-row-count result)))
     686         (rows (row-count result)))
    689687    (let loop ((seed knil)
    690688               (row 0))
    691689      (if (= row rows)
    692690          seed
    693           (loop (kons (result-row result row) seed) (add1 row))))))
     691          (loop (kons (row-values result row) seed) (add1 row))))))
    694692
    695693(define (%query-fold-right kons knil conn query params)
    696694  (let* ((result (exec-query conn query params))
    697          (rows (result-row-count result)))
     695         (rows (row-count result)))
    698696    (let loop ((seed knil)
    699697               (row 0))
    700698      (if (= row rows)
    701699          seed
    702           (kons (result-row result row) (loop seed (add1 row)))))))
     700          (kons (row-values result row) (loop seed (add1 row)))))))
    703701
    704702(define (query-fold kons knil conn query . params)
     
    726724(define (%query-map proc conn query params)
    727725  (let ((result (exec-query conn query params)))
    728     (let loop ((ans '())
    729                (row (result-row-count result)))
     726    (let loop ((lst '())
     727               (row (row-count result)))
    730728      (if (= row 0)
    731           ans
    732           (loop (cons (proc (result-row result (sub1 row))) ans) (sub1 row))))))
     729          lst
     730          (loop (cons (proc (row-values result (sub1 row))) lst) (sub1 row))))))
    733731(define (query-map proc conn query . params)
    734732  (%query-map proc conn query params))
  • release/4/postgresql/trunk/tests/run.scm

    r14762 r14765  
    3838  (test "Correct row count"
    3939        2
    40         (result-row-count (exec-query conn "SELECT 1 UNION SELECT 2")))
     40        (row-count (exec-query conn "SELECT 1 UNION SELECT 2")))
    4141  (test "Correct column count"
    4242        4
    43         (result-column-count (exec-query conn "SELECT 1, 2, 3, 4")))
     43        (column-count (exec-query conn "SELECT 1, 2, 3, 4")))
    4444  (test "Correct column name"
    4545        'one
    46         (result-column-name
     46        (column-name
    4747         (exec-query conn "SELECT 1 AS one, 2 AS two") 0))
    4848  (test "Correct column names"
    4949        '(one two)
    50         (result-column-names
     50        (column-names
    5151         (exec-query conn "SELECT 1 AS one, 2 AS two")))
    5252  (test-error "Condition for nonexistant column index"
    53               (result-column-name
     53              (column-name
    5454               (exec-query conn "SELECT 1 AS one, 2 AS two") 3))
    5555  (test "Not false for nameless column"
    5656        #f ;; Could check for ?column?, but that's a bit too specific
    57         (not (result-column-name
     57        (not (column-name
    5858              (exec-query conn "SELECT 1, 2") 0)))
    5959  ;; Maybe add a few tests here for case folding/noncase folding variants?
    60   ;; Perhaps result-column-index-ci vs result-column-index?  That would be
    61   ;; misleading though, since result-column-index-ci isn't really ci,
     60  ;; Perhaps column-index-ci vs column-index?  That would be
     61  ;; misleading though, since column-index-ci isn't really ci,
    6262  ;; it will not match columns that are explicitly uppercased in the query.
    6363  (test "Correct column index"
    6464        0
    65         (result-column-index
     65        (column-index
    6666         (exec-query conn "SELECT 1 AS one, 2 AS two") 'one))
    6767  (test "False column index for nonexistant column name"
    6868        #f
    69         (result-column-index
     69        (column-index
    7070         (exec-query conn "SELECT 1 AS one, 2 AS two") 'foo))
    7171  (test "False oid for virtual table"
    7272        #f
    73         (result-table-oid
     73        (table-oid
    7474         (exec-query conn "SELECT 1 AS one, 2 AS two") 0))
    7575  (test-assert "Number for nonvirtual table"
    7676               (number?
    77                 (result-table-oid
     77                (table-oid
    7878                 (exec-query conn "SELECT typlen FROM pg_type") 0)))
    7979  (test-error "Condition for column index out of bounds"
    80               (result-table-oid
     80              (table-oid
    8181               (exec-query conn "SELECT typname FROM pg_type") 1))
    8282  (test "Table column number for real table"
    8383        0
    84         (result-table-column-index
     84        (table-column-index
    8585         (exec-query conn "SELECT typname FROM pg_type") 0))
    8686  (test "Column format is text for normal data"
    8787        'text
    88         (result-column-format
     88        (column-format
    8989         (exec-query conn "SELECT 'hello'") 0))
    9090 
    9191  (test "Column format is binary for forced binary data"
    9292        'binary
    93         (result-column-format
     93        (column-format
    9494         (exec-query conn "SELECT 1" '() format: 'binary) 0))
    9595 
    9696  (test "Column type OID ok"
    9797        23 ;; from catalog/pg_type.h
    98         (result-column-type
     98        (column-type
    9999         (exec-query conn "SELECT 1::int4") 0))
    100100  (test "Column modifier false"
    101101        #f
    102         (result-column-type-modifier
     102        (column-type-modifier
    103103         (exec-query conn "SELECT 1") 0))
    104104  (test "Column modifier for bit ok"
    105105        2
    106         (result-column-type-modifier
     106        (column-type-modifier
    107107         (exec-query conn "SELECT '10'::bit(2)") 0))
    108108  (test "Result value string for strings"
    109109        "test"
    110         (result-value
     110        (value-at
    111111         (exec-query conn "SELECT 'test'") 0 0))
    112112  (test "Result row values"
    113113        '("one" "two")
    114         (result-row
     114        (row-values
    115115         (exec-query conn "SELECT 'one', 'two' UNION SELECT 'three', 'four'") 0))
    116116  (test "Result row alist"
    117117        '((a . "one") (b . "two"))
    118         (result-row-alist
     118        (row-alist
    119119         (exec-query conn "SELECT 'one' AS a, 'two' AS b UNION SELECT 'three', 'four'") 0))
    120120  (test "Result column values"
    121121        '("one" "three")
    122         (result-column
     122        (column-values
    123123         (exec-query conn "SELECT 'one', 'two' UNION SELECT 'three', 'four'") 0))
    124124  (test "Result value number for numbers"
    125125        1
    126         (result-value
     126        (value-at
    127127         (exec-query conn "SELECT 1") 0 0))
    128128  (test "Result value string for raw numbers"
    129129        "1"
    130         (result-value
     130        (value-at
    131131         (exec-query conn "SELECT 1") 0 0 raw: #t))
    132132  ;; We are using two levels of escaping here because the ::bytea cast
     
    134134  (test "Result value for null-terminated byte array"
    135135        (blob->u8vector (string->blob "h\x00ello"))
    136         (result-value
     136        (value-at
    137137         (exec-query conn "SELECT E'h\\\\000ello'::bytea") 0 0))
    138138  (test "Result value for raw null-terminated byte array"
    139139        "h\\000ello"
    140         (result-value
     140        (value-at
    141141         (exec-query conn "SELECT E'h\\\\000ello'::bytea") 0 0 raw: #t))
    142142
    143143  (test "Result value blob for binary string"
    144144        (string->blob "hello")
    145         (result-value
     145        (value-at
    146146         (exec-query conn "SELECT 'hello'" '() format: 'binary) 0 0))
    147147 
    148148  (test "Result value blob for binary integer"
    149149        (u8vector->blob (u8vector 0 0 0 1))
    150         (result-value (exec-query conn "SELECT 1::int4" '() format: 'binary) 0 0))
     150        (value-at (exec-query conn "SELECT 1::int4" '() format: 'binary) 0 0))
    151151
    152152  (test "Result value for binary string with NUL bytes"
    153153        (string->blob "h\x00ello")
    154         (result-value (exec-query conn "SELECT E'h\\\\000ello'::bytea" '() format: 'binary) 0 0))
     154        (value-at (exec-query conn "SELECT E'h\\\\000ello'::bytea" '() format: 'binary) 0 0))
    155155
    156156  (test-assert "Result value sql-null for NULL"
    157                (sql-null? (result-value
     157               (sql-null? (value-at
    158158                           (exec-query conn "SELECT NULL") 0 0)))
    159159  (test-error "Result value error for out of bounds column"
    160               (result-value
     160              (value-at
    161161               (exec-query conn "SELECT NULL") 0 1))
    162162  (test-error "Result value error for out of bounds row"
    163               (result-value
     163              (value-at
    164164               (exec-query conn "SELECT NULL") 1 0))
    165165  (test "Number of affected rows false with SELECT"
    166166        #f
    167         (result-affected-rows
     167        (affected-rows
    168168         (exec-query conn "SELECT 1")))
    169169
     
    172172  (test "Number of affected rows 1 with INSERT"
    173173        1
    174         (result-affected-rows
     174        (affected-rows
    175175         (exec-query conn "INSERT INTO foo (bar) VALUES (1);")))
    176176  (exec-query conn "COMMIT")
     
    182182  (test "Number of affected rows 2 with UPDATE of two rows"
    183183        2
    184         (result-affected-rows
     184        (affected-rows
    185185         (exec-query conn "UPDATE foo SET bar=102;")))
    186186  (exec-query conn "COMMIT")
     
    188188  (test "Inserted OID false on SELECT"
    189189        #f
    190         (result-inserted-oid
     190        (inserted-oid
    191191         (exec-query conn "SELECT 1")))
    192192
     
    195195  (test "Inserted OID false on OID-less table"
    196196        #f
    197         (result-inserted-oid
     197        (inserted-oid
    198198         (exec-query conn  "INSERT INTO foo (bar) VALUES (1);")))
    199199  (exec-query conn "COMMIT")
     
    203203  (test-assert "Inserted OID number on table with OID"
    204204               (number?
    205                 (result-inserted-oid
     205                (inserted-oid
    206206                 (exec-query conn "INSERT INTO foo (bar) VALUES (1)"))))
    207207  (exec-query conn "COMMIT")
     
    209209  (test "regular parameters"
    210210        "hi"
    211         (result-value (exec-query conn "SELECT $1::text" '("hi")) 0 0))
     211        (value-at (exec-query conn "SELECT $1::text" '("hi")) 0 0))
    212212  (test-assert "NULL parameters"
    213                (sql-null? (result-value
     213               (sql-null? (value-at
    214214                           (exec-query conn "SELECT $1::text" `(,(sql-null))) 0 0)))
    215215  (test "blob parameters"
    216216        "hi"
    217         (result-value (exec-query conn "SELECT $1::text" `(,(string->blob "hi"))) 0 0))
     217        (value-at (exec-query conn "SELECT $1::text" `(,(string->blob "hi"))) 0 0))
    218218  (test "boolean parameters"
    219219        '(#t #f)
    220         (result-row (exec-query conn "SELECT $1::bool, $2::bool" '(#t #f)) 0 0)))
     220        (row-values (exec-query conn "SELECT $1::bool, $2::bool" '(#t #f)) 0)))
    221221
    222222(test-group "value escaping"
Note: See TracChangeset for help on using the changeset viewer.