Commit 97bffc66 authored by Erick's avatar Erick

Added tests for circular lists

parent 9c7c4a80
;;;;
;;;; do-test.stk -- The pilot of all tests
;;;; do-test.stk -- The pilot of all tests
;;;;
;;;; Copyright © 2005-2011 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
;;;; Copyright © 2005-2018 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
;;;;
;;;;
;;;; This program is free software; you can redistribute it and/or modify
......@@ -21,11 +21,11 @@
;;;;
;;;; Author: Erick Gallesio [eg@essi.fr]
;;;; Creation date: 3-May-2005 12:28 (eg)
;;;; Last file update: 27-May-2011 23:38 (eg)
;;;; Last file update: 11-Jun-2018 15:23 (eg)
;;;;
(load-path (cons "../lib"
(load-path)))
(load-path)))
(load "./test.stk")
......@@ -44,6 +44,7 @@
(load "test-ffi.stk")
(load "test-r5.stk")
(load "test-r7rs.stk")
(load "test-circular.stk")
(load "test-utf8.stk")
(load "test-r5rs-pitfall.stk")
)
......
;;;;
;;;;
;;;; test-circular.stk -- Test circular structures
;;;;
;;;; Copyright © 2018 Erick Gallesio - I3S-CNRS/Polytech Nice-Sophia <eg@unice.fr>
;;;;
;;;;
;;;; This program is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
;;;; the Free Software Foundation; either version 2 of the License, or
;;;; (at your option) any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this program; if not, write to the Free Software
;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
;;;; USA.
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 11-Jun-2018 15:19
;;;; Last file update: 12-Jun-2018 09:49 (eg)
;;;;
(require "test")
(test-section "Circular structures")
;; ======================================================================
;; Writing
;;
(define (generate-circular n)
(let ((l '(end)))
(dotimes (i n)
(let ((x (list i i)))
(set-cdr! x x)
(set! l (cons (list x l (cdr l))
l))))
l))
(test "write.circular1"
"#0=(a . #0#)"
(let ((x (list 'a)))
(set-cdr! x x)
(with-output-to-string (lambda () (write* x)))))
(test "write.circular2"
"(#0=(a . #1=(b)) #0# #1#)"
(let* ((x (list 'a 'b))
(y (list x x (cdr x))))
(with-output-to-string (lambda () (write* y)))))
(test "write.circular3"
"#(1 #0=(a b) #0# 2)"
(let* ((x (list 'a 'b))
(y (vector 1 x x 2)))
(with-output-to-string (lambda () (write* y)))))
(test "write.circular4"
"#0=#(#0# #0#)"
(let* ((x (vector 0 0)))
(vector-set! x 0 x)
(vector-set! x 1 x)
(with-output-to-string (lambda () (write* x)))))
(test "write.circular5"
"((#0=#(#0# 1) . #1=(#0#)) #0# (x #1#))"
(let ((x (vector 0 1)))
(vector-set! x 0 x)
(let ((y (list x x)))
(with-output-to-string (lambda () (write* `(,y ,x (x ,(cdr y)))))))))
(test "write.circular6"
"((#0=(24 . #0#) #1=((#2=(23 . #2#) #3=((#4=(22 . #4#) #5=((#6=(21 . #6#) #7=((#8=(20 . #8#) #9=((#10=(19 . #10#) #11=((#12=(18 . #12#) #13=((#14=(17 . #14#) #15=((#16=(16 . #16#) #17=((#18=(15 . #18#) #19=((#20=(14 . #20#) #21=((#22=(13 . #22#) #23=((#24=(12 . #24#) #25=((#26=(11 . #26#) #27=((#28=(10 . #28#) #29=((#30=(9 . #30#) #31=((#32=(8 . #32#) #33=((#34=(7 . #34#) #35=((#36=(6 . #36#) #37=((#38=(5 . #38#) #39=((#40=(4 . #40#) #41=((#42=(3 . #42#) #43=((#44=(2 . #44#) #45=((#46=(1 . #46#) #47=((#48=(0 . #48#) #49=(end) ()) . #49#) #49#) . #47#) #47#) . #45#) #45#) . #43#) #43#) . #41#) #41#) . #39#) #39#) . #37#) #37#) . #35#) #35#) . #33#) #33#) . #31#) #31#) . #29#) #29#) . #27#) #27#) . #25#) #25#) . #23#) #23#) . #21#) #21#) . #19#) #19#) . #17#) #17#) . #15#) #15#) . #13#) #13#) . #11#) #11#) . #9#) #9#) . #7#) #7#) . #5#) #5#) . #3#) #3#) . #1#)"
(with-output-to-string (lambda ()
(write* (generate-circular 25)))))
;; ======================================================================
;; Reading
;;
(test "read.circular1"
#t
(let ((l '#0=(0 #0#)))
(and (eq? (car l) 0)
(eq? (cadr l) l))))
(test "read.circular2"
#t
(let* ((l1 '(#0=(1 2 3) #0# #1=(2 #0#) #1#))
(l2 '(#0=(1 2 3) #0# #1=(2 #0#) #1#)))
(equal? l1 l2)))
(test "read.circular3"
#t
(let* ((l1 '((#0=(1 2 3) #0# #1=(2 #0#) #1#)))
(l2 '((#3=(1 2 3) #3# #4=(2 #3#) #4#))))
(equal? l1 l2)))
(test "read.circular4"
#t
(let* ((l1 (with-output-to-string (lambda()
(write* (generate-circular 3)))))
(l2 (with-input-from-string l1 read))
(l3 (with-output-to-string (lambda() (write* l2)))))
(equal? l1 l3)))
(test "useless.circular1"
'((0 1) 2 3)
(cons '#0=(0 1) '#1=(2 3)))
(test "useless.circular2"
'((0 1) 2 3)
'(#0=(0 1) . #0=(2 3)))
;; ======================================================================
(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