Author: yamakenz
Date: Fri Jul 13 05:58:58 2007
New Revision: 4727
Modified:
sigscheme-trunk/lib/srfi-1.scm
sigscheme-trunk/test/test-assoc.scm
sigscheme-trunk/test/test-eval.scm
sigscheme-trunk/test/test-member.scm
Log:
* lib/srfi-1.scm
- (make-list): Change default value to #<undef>
* test/test-eval.scm
- Update hand-made env tests relaxed when let-optionals* had been introduced
* test/test-member.scm
* test/test-assoc.scm
- Fix unique object definition
Modified: sigscheme-trunk/lib/srfi-1.scm
==============================================================================
--- sigscheme-trunk/lib/srfi-1.scm (original)
+++ sigscheme-trunk/lib/srfi-1.scm Fri Jul 13 05:58:58 2007
@@ -18,6 +18,7 @@
;; - Fix broken lset-difference call of lset-xor and
;; lset-xor! (as like as Scheme48)
;; 2007-07-01 yamaken - Fix broken comparison of list= on 3 or more lists
+;; 2007-07-13 yamaken - Change default value for make-list to #<undef>
;;; This is a library of list- and pair-processing functions. I wrote it after
@@ -228,6 +229,8 @@
(use srfi-8)
(use srfi-23)
+(define %srfi-1:undefined (for-each values '()))
+
(define (check-arg pred val caller)
(let lp ((val val))
(if (pred val) val (lp (error "Bad argument" val pred caller)))))
@@ -259,7 +262,7 @@
(define (make-list len . maybe-elt)
(check-arg (lambda (n) (and (integer? n) (>= n 0))) len make-list)
- (let ((elt (cond ((null? maybe-elt) #f) ; Default value
+ (let ((elt (cond ((null? maybe-elt) %srfi-1:undefined) ; Default value
((null? (cdr maybe-elt)) (car maybe-elt))
(else (error "Too many arguments to MAKE-LIST"
(cons len maybe-elt))))))
@@ -1036,7 +1039,6 @@
(define map map-in-order)
;; Added by yamaken 2007-06-15
-(define %srfi-1:undefined (for-each values '()))
(define for-each
(lambda args
(apply map-in-order args)
Modified: sigscheme-trunk/test/test-assoc.scm
==============================================================================
--- sigscheme-trunk/test/test-assoc.scm (original)
+++ sigscheme-trunk/test/test-assoc.scm Fri Jul 13 05:58:58 2007
@@ -35,10 +35,10 @@
(define tn test-name)
-(define elm0 (list #t))
-(define elm1 (list #t))
-(define elm2 (list #t))
-(define elm3 (list #t))
+(define elm0 (lambda () 0))
+(define elm1 (lambda () 1))
+(define elm2 (lambda () 2))
+(define elm3 (lambda () 3))
(define nil '())
(define cdr3 (cons (cons elm3 3) nil))
(define cdr2 (cons (cons elm2 2) cdr3))
Modified: sigscheme-trunk/test/test-eval.scm
==============================================================================
--- sigscheme-trunk/test/test-eval.scm (original)
+++ sigscheme-trunk/test/test-eval.scm Fri Jul 13 05:58:58 2007
@@ -199,9 +199,11 @@
(eval '(+ 1 2)
'(((x y) . (4 6 . 8))))))
;; dotted actuals #3
- (assert-error (tn) (lambda ()
- (eval '(+ 1 2)
- '(((x . y) . (4 6 . 8))))))
+ ;; This pattern has been allowd when let-optionals* is introduced.
+ (assert-equal? (tn)
+ '(4 (6 . 8))
+ (eval '(list x y)
+ '(((x . y) . (4 6 . 8)))))
;; not a symbol in formals
(assert-error (tn) (lambda ()
(eval '(+ 1 2)
@@ -212,9 +214,11 @@
'(((x) . 4)
((y) . 6)))))
;; not a list as both formals and actuals
- (assert-error (tn) (lambda ()
- (eval '(+ 1 2)
- '((x . 4)
- (y . 6)))))))
+ ;; This pattern has been allowd when let-optionals* is introduced.
+ (assert-equal? (tn)
+ '(4 6)
+ (eval '(list x y)
+ '((x . 4)
+ (y . 6))))))
(total-report)
Modified: sigscheme-trunk/test/test-member.scm
==============================================================================
--- sigscheme-trunk/test/test-member.scm (original)
+++ sigscheme-trunk/test/test-member.scm Fri Jul 13 05:58:58 2007
@@ -35,10 +35,10 @@
(define tn test-name)
-(define elm0 (list #t))
-(define elm1 (list #t))
-(define elm2 (list #t))
-(define elm3 (list #t))
+(define elm0 (lambda () 0))
+(define elm1 (lambda () 1))
+(define elm2 (lambda () 2))
+(define elm3 (lambda () 3))
(define nil '())
(define cdr3 (cons elm3 nil))
(define cdr2 (cons elm2 cdr3))
