From bd9733926076885e3417b74de76e4c9c7bc56254 Mon Sep 17 00:00:00 2001
From: Bryan Newbold <bnewbold@robocracy.org>
Date: Mon, 20 Feb 2017 00:05:28 -0800
Subject: Import Upstream version 2c7

---
 rdms.scm | 42 +++++++++++++++++++++++-------------------
 1 file changed, 23 insertions(+), 19 deletions(-)

(limited to 'rdms.scm')

diff --git a/rdms.scm b/rdms.scm
index 9f176f9..e0dbd3c 100644
--- a/rdms.scm
+++ b/rdms.scm
@@ -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)))))
-- 
cgit v1.2.3