Commit b0ffc82a authored by Erick's avatar Erick

Added test on circular lists

parent bda0a507
......@@ -22,7 +22,7 @@
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 11-Jun-2018 15:19
;;;; Last file update: 22-Oct-2018 17:24 (eg)
;;;; Last file update: 27-Nov-2018 18:42 (eg)
;;;;
......@@ -30,7 +30,7 @@
(test-section "Circular structures")
(define (circular-list val1 . vals) ; The SRFI-1 function
(define (circular-list val1 . vals) ; The SRFI-1 function
(let ((ans (cons val1 vals)))
(set-cdr! (last-pair ans) ans)
ans))
......@@ -190,6 +190,96 @@
'(#0=(0 1) . #0=(2 3)))
;; ======================================================================
;; Tests from William D Clinger equiv? implementtation
;;
(test "Clinger.1" #t
(let ()
(define x
(let ((x1 (vector 'h))
(x2 (let ((x (list #f))) (set-car! x x) x)))
(vector x1 (vector 'h) x1 (vector 'h) x1 x2)))
(define y
(let ((y1 (vector 'h))
(y2 (vector 'h))
(y3 (let ((x (list #f))) (set-car! x x) x)))
(vector (vector 'h) y1 y1 y2 y2 y3)))
(equal? x y)))
(test "Clinger.2" #t
(let ()
(define x
(let ((x (cons (cons #f 'a) 'a)))
(set-car! (car x) x)
x))
(define y
(let ((y (cons (cons #f 'a) 'a)))
(set-car! (car y) (car y))
y))
(equal? x y)))
(test "Clinger.3" #t
(let ((k 100))
(define x
(let ((x1 (cons
(let f ((n k))
(if (= n 0)
(let ((x0 (cons #f #f)))
(set-car! x0 x0)
(set-cdr! x0 x0)
x0)
(let ((xi (cons #f (f (- n 1)))))
(set-car! xi xi)
xi)))
#f)))
(set-cdr! x1 x1)
x1))
(define y
(let* ((y2 (cons #f #f)) (y1 (cons y2 y2)))
(set-car! y2 y1)
(set-cdr! y2 y1)
y1))
(equal? x y)))
(test "Clinger.4 (as 3 but read)" #t
(equal?
'#0=(#1=(#1# . #2=(#2# . #3=(#3# . #4=(#4# . #5=(#5# . #6=(#6# . #7=(#7# . #8=(#8# . #9=(#9# . #10=(#10# . #11=(#11# . #12=(#12# . #13=(#13# . #14=(#14# . #15=(#15# . #16=(#16# . #17=(#17# . #18=(#18# . #19=(#19# . #20=(#20# . #21=(#21# . #22=(#22# . #23=(#23# . #24=(#24# . #25=(#25# . #26=(#26# . #27=(#27# . #28=(#28# . #29=(#29# . #30=(#30# . #31=(#31# . #32=(#32# . #33=(#33# . #34=(#34# . #35=(#35# . #36=(#36# . #37=(#37# . #38=(#38# . #39=(#39# . #40=(#40# . #41=(#41# . #42=(#42# . #43=(#43# . #44=(#44# . #45=(#45# . #46=(#46# . #47=(#47# . #48=(#48# . #49=(#49# . #50=(#50# . #51=(#51# . #52=(#52# . #53=(#53# . #54=(#54# . #55=(#55# . #56=(#56# . #57=(#57# . #58=(#58# . #59=(#59# . #60=(#60# . #61=(#61# . #62=(#62# . #63=(#63# . #64=(#64# . #65=(#65# . #66=(#66# . #67=(#67# . #68=(#68# . #69=(#69# . #70=(#70# . #71=(#71# . #72=(#72# . #73=(#73# . #74=(#74# . #75=(#75# . #76=(#76# . #77=(#77# . #78=(#78# . #79=(#79# . #80=(#80# . #81=(#81# . #82=(#82# . #83=(#83# . #84=(#84# . #85=(#85# . #86=(#86# . #87=(#87# . #88=(#88# . #89=(#89# . #90=(#90# . #91=(#91# . #92=(#92# . #93=(#93# . #94=(#94# . #95=(#95# . #96=(#96# . #97=(#97# . #98=(#98# . #99=(#99# . #100=(#100# . #101=(#101# . #101#))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) . #0#)
'#200=(#201=(#200# . #200#) . #201#)))
(test "vectors.1" #t
(let ((v1 (vector 0 1 2 3))
(v2 (vector 0 1 2 3)))
(vector-set! v1 2 v1)
(vector-set! v2 2 v2)
(equal? v1 v2)))
(test "vectors.2" #t
(let ((v1 (vector 0 1 2 3))
(v2 (vector 0 1 2 3)))
(vector-set! v1 2 v2)
(vector-set! v2 2 v1)
(equal? v1 v2)))
(test "vectors.3" #f
(let ((v1 (vector 0 1 2 3 4))
(v2 (vector 0 1 2 3)))
(vector-set! v1 2 v2)
(vector-set! v2 2 v1)
(equal? v1 v2)))
(test "vectors.4" #t
(let ((v1 (vector 0))
(v2 (vector 0)))
(vector-set! v1 0 v1)
(vector-set! v2 0 v2)
(equal? v1 v2)))
(test "vectors.5" #t (equal? '#0=#(a #0# b #0#) '#1=#(a #1# b #1#)))
(test "vectors.6" #f (equal? '#0=#(a #0# a #0#) '#1=#(a #1# b #1#)))
;; ======================================================================
(test-section-end)
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment