Megatest

Check-in [c2a555afb1]
Login
Overview
Comment:fixed unprotected vector-length
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.80
Files: files | file ages | folders
SHA1: c2a555afb1cf79d1c5442948b9d5a6e11a109745
User & Date: matt on 2023-03-11 12:39:21
Other Links: branch diff | manifest | tags
Context
2023-03-11
13:10
Partially complete update to configuration' check-in: 0f8bf614e9 user: matt tags: v1.80
12:39
fixed unprotected vector-length check-in: c2a555afb1 user: matt tags: v1.80
10:37
WIP, getting nfs working again check-in: 79f9af8364 user: matt tags: v1.80
Changes

Modified db.scm from [5255866c2a] to [26c881329f].

1535
1536
1537
1538
1539
1540
1541

1542


1543
1544
1545
1546
1547
1548
1549
1550
1551
1552

1553
1554
1555
1556
1557
1558
1559
1535
1536
1537
1538
1539
1540
1541
1542

1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553

1554
1555
1556
1557
1558
1559
1560
1561







+
-
+
+









-
+








;; extract index number given a header/data structure
(define (db:get-index-by-header header field)
  (list-index (lambda (x)(equal? x field)) header))

;; look up values in a header/data structure
(define (db:get-value-by-header row header field)
  (let ((len (if (vector? row)
  (let ((len (vector-length row)))
		 (vector-length row)
		 0)))
    (if (or (null? header) (not row))
	#f
	(let loop ((hed (car header))
		   (tal (cdr header))
		   (n   0))
	  (if (equal? hed field)
	      (handle-exceptions
	       exn
	       (begin
		 (debug:print 0 *default-log-port* "WARNING: attempt to read non-existant field, row="
		 (debug:print 4 *default-log-port* "WARNING: attempt to read non-existant field, row="
			      row " header=" header " field=" field ", exn=" exn)
		 #f)
	       (if (>= n len)
		   #f
		   (vector-ref row n)))
	      (if (null? tal) #f (loop (car tal)(cdr tal)(+ n 1))))))))