mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-28 16:00:22 +02:00
Code Activity

test-suite: Add a nameless form of `pass-if-equal'.

Browse source 
* test-suite/test-suite/lib.scm (pass-if-equal): Add a nameless pattern.
* test-suite/tests/arrays.test ("array->list"): Use `pass-if-equal'.
This commit is contained in:
Ludovic Courtès 2012-11-02 23:29:43 +01:00
parent 139ce19474
commit 80aeb9af0d
2 changed files with 8 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

4
test-suite/test-suite/lib.scm
View file

@ -360,8 +360,10 @@
(define-syntax pass-if-equal (define-syntax pass-if-equal
(syntax-rules () (syntax-rules ()
"Succeed if and only if BODY's return value is equal? to EXPECTED." "Succeed if and only if BODY's return value is equal? to EXPECTED."
((_ expected body)
(pass-if-equal 'body expected body))
((_ name expected body ...) ((_ name expected body ...)
(run-test 'name #t (run-test name #t
(lambda () (lambda ()
(let ((result (begin body ...))) (let ((result (begin body ...)))
(or (equal? expected result) (or (equal? expected result)

10
test-suite/tests/arrays.test
View file

@ -1,6 +1,6 @@
;;;; unif.test --- tests guile's uniform arrays -*- scheme -*- ;;;; unif.test --- tests guile's uniform arrays -*- scheme -*-
;;;; ;;;;
;;;; Copyright 2004, 2006, 2009, 2010, 2011 Free Software Foundation, Inc. ;;;; Copyright 2004, 2006, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
;;;; ;;;;
;;;; This library is free software; you can redistribute it and/or ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
@ -211,10 +211,10 @@
;;; ;;;
(with-test-prefix "array->list" (with-test-prefix "array->list"
(pass-if (equal? (array->list #s16(1 2 3)) '(1 2 3))) (pass-if-equal '(1 2 3) (array->list #s16(1 2 3)))
(pass-if (equal? (array->list #(1 2 3)) '(1 2 3))) (pass-if-equal '(1 2 3) (array->list #(1 2 3)))
(pass-if (equal? (array->list #2((1 2) (3 4) (5 6))) '((1 2) (3 4) (5 6)))) (pass-if-equal '((1 2) (3 4) (5 6)) (array->list #2((1 2) (3 4) (5 6))))
(pass-if (equal? (array->list #()) '()))) (pass-if-equal '() (array->list #())))
;;; ;;;