diff options
Diffstat (limited to 'rdms.scm')
| -rw-r--r-- | rdms.scm | 42 |
1 files changed, 23 insertions, 19 deletions
@@ -79,6 +79,7 @@ (not (negative? x)))) integer #f) + (number #f number? number #f) (expression #f #f expression #f) (boolean #f boolean? boolean #f) (symbol #f symbol? symbol #f) @@ -252,6 +253,7 @@ (primary-limit 1) (column-name-alist '()) (column-foreign-list '()) + (column-foreign-check-list '()) (column-domain-list '()) (column-type-list '()) (export-alist '()) @@ -283,24 +285,26 @@ (set! column-domain-list (cons column-domain column-domain-list)) (set! column-foreign-list - (cons - (let ((foreign-name - (row-ref dom:row domains:foreign-pos))) - (cond - ((or (not foreign-name) - (eq? foreign-name table-name)) #f) - (else - (let* ((tab (open-table foreign-name #f)) - (p? (and tab (tab 'get 1)))) - (cond - ((not tab) - (rdms:error "foreign key table missing for:" - foreign-name)) - ((not (= (tab 'primary-limit) 1)) - (rdms:error "foreign key table wrong type:" - foreign-name)) - (else p?)))))) - column-foreign-list)))) + (cons (let ((foreign-name + (row-ref dom:row domains:foreign-pos))) + (and (not (eq? foreign-name table-name)) + foreign-name)) + column-foreign-list)) + (set! column-foreign-check-list + (cons + (let ((foreign-name (car column-foreign-list))) + (and foreign-name + (let* ((tab (open-table foreign-name #f)) + (p? (and tab (tab 'get 1)))) + (cond + ((not tab) + (rdms:error "foreign key table missing for:" + foreign-name)) + ((not (= (tab 'primary-limit) 1)) + (rdms:error "foreign key table wrong type:" + foreign-name)) + (else p?))))) + column-foreign-check-list)))) (else (rdms:error "missing domain for column:" ci column-name))) (cond @@ -409,7 +413,7 @@ (rdms:error "foreign key missing:" table-name column-name value)))) cirs dirs row column-name-alist column-domain-list - column-foreign-list) + column-foreign-check-list) (cond ((and uir (not (uir row))) (rdms:error "violated user integrity rule:" row))))) |