summaryrefslogtreecommitdiffstats
path: root/rdms.scm
diff options
context:
space:
mode:
authorDavid N. Welton <davidw@efn.org>1998-11-09 21:18:01 -0800
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:27 -0800
commit926b1b647ac830660933a5e63eb52d4a2552e264 (patch)
treee25db5f6e1441d67f5d9af063432018ee20a5f51 /rdms.scm
parentb21cac3362022718634f7086964208b2eed8e897 (diff)
parentfa3f23105ddcf07c5900de47f19af43d1db1b597 (diff)
downloadslib-926b1b647ac830660933a5e63eb52d4a2552e264.tar.gz
slib-926b1b647ac830660933a5e63eb52d4a2552e264.zip
Import Debian changes 2c3-3debian/2c3-3
slib (2c3-3) frozen unstable; urgency=low * Fixes #16235. * Fixes #19943. * Fixes #20265. * Fixes #24917. * Fixes #27389. slib (2c3-2) frozen unstable; urgency=low * Re-uploaded for slink freeze. slib (2c3-1) unstable; urgency=low * New upstream release.
Diffstat (limited to 'rdms.scm')
-rw-r--r--rdms.scm25
1 files changed, 13 insertions, 12 deletions
diff --git a/rdms.scm b/rdms.scm
index 8c20362..9f176f9 100644
--- a/rdms.scm
+++ b/rdms.scm
@@ -216,8 +216,9 @@
base:catalog base:domains rdms:catalog)
(define (write-database filename)
- (write-base lldb filename)
- (set! rdms:filename filename))
+ (let ((ans (write-base lldb filename)))
+ (and ans (set! rdms:filename filename))
+ ans))
(define (close-database)
(close-base lldb)
@@ -489,19 +490,19 @@
(let ((ci (translate-column (cadr args))))
(cond
((<= ci primary-limit) ;primary-key?
- (let ((key-extractor
- ((base 'make-key-extractor)
- primary-limit column-type-list ci)))
- (case (car args)
- ((get) (lambda keys
- (and (present? base-table (list->key keys))
- (list-ref keys (+ -1 ci)))))
- ((get*) (lambda mkeys
+ (case (car args)
+ ((get) (lambda gkeys
+ (and (present? base-table (list->key gkeys))
+ (list-ref gkeys (+ -1 ci)))))
+ ((get*) (let ((key-extractor
+ ((base 'make-key-extractor)
+ primary-limit column-type-list ci)))
+ (lambda mkeys
(base:map-primary-key
base-table
(lambda (ckey) (key-extractor ckey))
- (norm-mkeys mkeys))))
- (else #f))))
+ (norm-mkeys mkeys)))))
+ (else #f)))
(else
(let ((index (- ci (+ 1 primary-limit))))
(case (car args)