mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-29 22:40:34 +02:00
Code Activity

Changes from arch/CVS synchronization

Browse source
This commit is contained in:
Ludovic Courtès 2007-01-19 09:11:43 +00:00
parent 0c6f7f15c6
commit 09c9ec0533
5 changed files with 118 additions and 62 deletions
Download patch file Download diff file Expand all files Collapse all files

17
test-suite/tests/eval.test
View file

@ -1,5 +1,5 @@
;;;; eval.test --- tests guile's evaluator -*- scheme -*-
;;;; Copyright (C) 2000, 2001, 2006 Free Software Foundation, Inc.
;;;; Copyright (C) 2000, 2001, 2006, 2007 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@ -315,5 +315,20 @@
'(a b c d e f g h i j k l m
n o p q r s t u v w x y z))))
;;;
;;; values
;;;
(with-test-prefix "values"
(pass-if "single value"
(equal? 1 (values 1)))
(pass-if "call-with-values"
(equal? (call-with-values (lambda () (values 1 2 3 4)) list)
'(1 2 3 4)))
(pass-if "equal?"
(equal? (values 1 2 3 4) (values 1 2 3 4))))
;;; eval.test ends here

25
test-suite/tests/structs.test
View file

@ -1,7 +1,7 @@
;;;; structs.test --- Test suite for Guile's structures. -*- Scheme -*-
;;;; Ludovic Courtès <ludovic.courtes@laas.fr>, 2006-06-12.
;;;;
;;;; Copyright (C) 2006 Free Software Foundation, Inc.
;;;; Copyright (C) 2006, 2007 Free Software Foundation, Inc.
;;;;
;;;; 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
@ -18,7 +18,8 @@
;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;;;; Boston, MA 02110-1301 USA
(use-modules (test-suite lib))
(define-module (test-suite test-structs)
:use-module (test-suite lib))
@ -80,15 +81,27 @@
(pass-if "struct-set!"
(let ((ball (make-ball green "Bob")))
(set-owner! ball "Bill")
(string=? (owner ball) "Bill")))
(string=? (owner ball) "Bill"))))
(pass-if "equal?"
(with-test-prefix "equal?"
(pass-if "simple structs"
(let* ((vtable (make-vtable-vtable "pr" 0))
(s1 (make-struct vtable 0 "hello"))
(s2 (make-struct vtable 0 "hello")))
(equal? s1 s2)))
(pass-if "more complex structs"
(let ((first (make-ball red (string-copy "Bob")))
(second (make-ball red (string-copy "Bob"))))
(second (make-ball red (string-copy "Bob"))))
(equal? first second)))
(pass-if "not-equal?"
(not (or (equal? (make-ball red "Bob") (make-ball green "Bill"))
(not (or (equal? (make-ball red "Bob") (make-ball green "Bob"))
(equal? (make-ball red "Bob") (make-ball red "Bill"))))))
;;; Local Variables:
;;; coding: latin-1
;;; End: