[uim-commit] r2805 - branches/r5rs/sigscheme/test

[yamaken at freedesktop.org]

Author: yamaken
Date: 2006-01-06 05:47:30 -0800 (Fri, 06 Jan 2006)
New Revision: 2805

Modified:
   branches/r5rs/sigscheme/test/test-syntax.scm
Log:
* sigscheme/test/test-syntax.scm
  - Add tests for function calling and syntax application


Modified: branches/r5rs/sigscheme/test/test-syntax.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-syntax.scm	2006-01-06 12:04:06 UTC (rev 2804)
+++ branches/r5rs/sigscheme/test/test-syntax.scm	2006-01-06 13:47:30 UTC (rev 2805)
@@ -35,6 +35,8 @@
 
 (load "./test/unittest.scm")
 
+(define tn test-name)
+
 ;; All tests in this file are passed against r2302 (new repository)
 
 ;; See "7.1 Formal syntax" of R5RS
@@ -178,4 +180,113 @@
   (assert "dot pair without both space" "(\"foo\".\"bar\")")
   (assert "dot pair without both space" "(\"foo\" \"bar\".\"baz\")"))
 
+(tn "function calling variadic_0")
+(define f (lambda args args))
+(assert-equal? (tn) '()         (f))
+(assert-error  (tn) (lambda ()  (f . #t)))
+(assert-equal? (tn) '(#t)       (f #t))
+(assert-error  (tn) (lambda ()  (f #t . #t)))
+(assert-equal? (tn) '(#t #t)    (f #t #t))
+(assert-error  (tn) (lambda ()  (f #t #t . #t)))
+(assert-equal? (tn) '(#t #t #t) (f #t #t #t))
+(assert-error  (tn) (lambda ()  (f #t #t #t . #t)))
+(tn "function calling fixed_1")
+(define f (lambda (x) x))
+(assert-error  (tn) (lambda () (f)))
+(assert-error  (tn) (lambda () (f . #t)))
+(assert-equal? (tn) #t         (f #t))
+(assert-error  (tn) (lambda () (f #t . #t)))
+(assert-error  (tn) (lambda () (f #t #t)))
+(assert-error  (tn) (lambda () (f #t #t . #t)))
+(assert-error  (tn) (lambda () (f #t #t #t)))
+(assert-error  (tn) (lambda () (f #t #t #t . #t)))
+(tn "function calling variadic_1")
+(define f (lambda (x . rest) (list x rest)))
+(assert-error  (tn) (lambda ()    (f)))
+(assert-error  (tn) (lambda ()    (f . #t)))
+(assert-equal? (tn) '(#t ())      (f #t))
+(assert-error  (tn) (lambda ()    (f #t . #t)))
+(assert-equal? (tn) '(#t (#t))    (f #t #t))
+(assert-error  (tn) (lambda ()    (f #t #t . #t)))
+(assert-equal? (tn) '(#t (#t #t)) (f #t #t #t))
+(assert-error  (tn) (lambda ()    (f #t #t #t . #t)))
+(tn "function calling fixed_2")
+(define f (lambda (x y) (list x y)))
+(assert-error  (tn) (lambda ()    (f)))
+(assert-error  (tn) (lambda ()    (f . #t)))
+(assert-error  (tn) (lambda ()    (f #t)))
+(assert-error  (tn) (lambda ()    (f #t . #t)))
+(assert-equal? (tn) '(#t #t)      (f #t #t))
+(assert-error  (tn) (lambda ()    (f #t #t . #t)))
+(assert-error  (tn) (lambda ()    (f #t #t #t)))
+(assert-error  (tn) (lambda ()    (f #t #t #t . #t)))
+(tn "function calling variadic_2")
+(define f (lambda (x y . rest) (list x y rest)))
+(assert-error  (tn) (lambda ()    (f)))
+(assert-error  (tn) (lambda ()    (f . #t)))
+(assert-error  (tn) (lambda ()    (f #t)))
+(assert-error  (tn) (lambda ()    (f #t . #t)))
+(assert-equal? (tn) '(#t #t ())   (f #t #t))
+(assert-error  (tn) (lambda ()    (f #t #t . #t)))
+(assert-equal? (tn) '(#t #t (#t)) (f #t #t #t))
+(assert-error  (tn) (lambda ()    (f #t #t #t . #t)))
+
+;; Although SigScheme's eval facility itself does not ensure properness of
+;; syntax args, each syntax implementation must check it. These tests only
+;; indicate what should be done.
+(tn "syntax application variadic_0")
+(define s and)
+(assert-equal? (tn) #t          (s))
+(assert-error  (tn) (lambda ()  (s . #t)))
+(assert-equal? (tn) #t          (s #t))
+(assert-error  (tn) (lambda ()  (s #t . #t)))
+(assert-equal? (tn) #t          (s #t #t))
+(assert-error  (tn) (lambda ()  (s #t #t . #t)))
+(assert-equal? (tn) #t          (s #t #t #t))
+(assert-error  (tn) (lambda ()  (s #t #t #t . #t)))
+(tn "syntax application fixed_1")
+(define s quote)
+(assert-error  (tn) (lambda () (s)))
+(assert-error  (tn) (lambda () (s . #t)))
+(assert-equal? (tn) #t         (s #t))
+(assert-error  (tn) (lambda () (s #t . #t)))
+(assert-error  (tn) (lambda () (s #t #t)))
+(assert-error  (tn) (lambda () (s #t #t . #t)))
+(assert-error  (tn) (lambda () (s #t #t #t)))
+(assert-error  (tn) (lambda () (s #t #t #t . #t)))
+(tn "syntax application variadic_1")
+(define s let*)
+(assert-error  (tn) (lambda ()    (s)))
+(assert-error  (tn) (lambda ()    (s . #t)))
+(assert-equal? (tn) (undef)       (s ()))
+(assert-error  (tn) (lambda ()    (s #t . #t)))
+(assert-equal? (tn) #t            (s () #t))
+(assert-error  (tn) (lambda ()    (s #t #t . #t)))
+(assert-equal? (tn) #t            (s () #t #t))
+(assert-error  (tn) (lambda ()    (s #t #t #t . #t)))
+(tn "syntax application fixed_2")
+(define s set!)
+(define foo #f)
+(assert-error  (tn) (lambda ()    (s)))
+(assert-error  (tn) (lambda ()    (s . #t)))
+(assert-error  (tn) (lambda ()    (s #t)))
+(assert-error  (tn) (lambda ()    (s #t . #t)))
+(if (and (provided? "sigscheme")
+         (provided? "strict-r5rs"))
+    (assert-equal? (tn) (undef)   (s foo #t))
+    (assert-equal? (tn) #t        (s foo #t)))
+(assert-error  (tn) (lambda ()    (s #t #t . #t)))
+(assert-error  (tn) (lambda ()    (s #t #t #t)))
+(assert-error  (tn) (lambda ()    (s #t #t #t . #t)))
+(tn "syntax application variadic_2")
+(define s if)
+(assert-error  (tn) (lambda ()    (s)))
+(assert-error  (tn) (lambda ()    (s . #t)))
+(assert-error  (tn) (lambda ()    (s #t)))
+(assert-error  (tn) (lambda ()    (s #t . #t)))
+(assert-equal? (tn) #t            (s #t #t))
+(assert-error  (tn) (lambda ()    (s #t #t . #t)))
+(assert-equal? (tn) #t            (s #t #t #t))
+(assert-error  (tn) (lambda ()    (s #t #t #t . #t)))
+
 (total-report)