#! /bin/sh
exec ../src/sizzle -qs $0 $*
!#
;; test/forms.scm -- syntax form tests
;;
;; Copyright (C) 2000 Martin Grabmueller <mgrabmue@cs.tu-berlin.de>
;;
;; This 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, or (at your option)
;; any later version.
;; 
;; This software 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 package; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.  

;; NOTE: this test file should pass Guile too, so keep it standard.

;; Load the test framework.

(load "test-suite.scm")

;; Actual tests.

(begin-section "conditional expressions")

(begin-sub-section "and / or")
(define a #t)
(define b #t)
(define c #t)
(define e #f)
(define f #f)

(pass-if (and a (or b e)) #t eq?)
(pass-if (or e (and (not f) a c)) #t eq?)
(pass-if (not (or (not a) (not b))) #t eq?)
(pass-if (and (or a f) (not (or b e))) #f eq?)

(define expr #f)
(pass-if (or (symbol? expr) (not (symbol? expr))) #t eq?)
(pass-if (and (null? expr) (not (null? expr))) #f eq?)
(pass-if (not (and (or expr #f) (not expr))) #t eq?)
(pass-if (not (or expr #t)) #f eq?)
(set! expr #t)
(pass-if (or (symbol? expr) (not (symbol? expr))) #t eq?)
(pass-if (and (null? expr) (not (null? expr))) #f eq?)
(pass-if (not (and (or expr #f) (not expr))) #t eq?)
(pass-if (not (or expr #t)) #f eq?)

(begin-sub-section "cond")
(define type-of
  (lambda (item)
    (cond
     ((pair? item) 'pair)
     ((null? item) 'empty-list)
     ((number? item) 'number)
     ((symbol? item) 'symbol)
     (else 'some-other-type))))
(pass-if (type-of (cons 'a 'b)) 'pair eq?)
(pass-if (type-of '(1 2 3)) 'pair eq?)
(pass-if (type-of '()) 'empty-list eq?)
(pass-if (type-of 24) 'number eq?)
(pass-if (type-of 24.42) 'number eq?)
(pass-if (type-of '_) 'symbol eq?)
(pass-if (type-of 'long-symbol-this-is) 'symbol eq?)
(pass-if (type-of '#(1 2 3)) 'some-other-type eq?)
(pass-if (type-of #\a) 'some-other-type eq?)
(pass-if (type-of "foobar") 'some-other-type eq?)
(pass-if (type-of #f) 'some-other-type eq?)

(begin-sub-section "if")
(pass-if (if #t #t #f) #t eq?)
(pass-if (if #f #t #f) #f eq?)

(begin-sub-section "case")
(define letter-type
  (lambda (item)
    (case item
      ((a e i o u) 'vowel)
      ((w y) 'semi-vowel)
      (else 'consonant))))
(pass-if (letter-type 'a) 'vowel eq?)
(pass-if (letter-type 'e) 'vowel eq?)
(pass-if (letter-type 'k) 'consonant eq?)
(pass-if (letter-type 'w) 'semi-vowel eq?)
(pass-if (letter-type 'y) 'semi-vowel eq?)

(begin-section "loops")

(begin-sub-section "do")
(define (do-test-0 n)
  (do ((vec (make-vector n))
       (i 0 (+ i 1)))
      ((= i n) vec)
    (vector-set! vec i i)))
(define (do-test-1)
  (let ((x '(1 3 5 7 9)))
    (do ((x x (cdr x))
	 (sum 0 (+ sum (car x))))
	((null? x) sum))))
(pass-if (do-test-0 3) '#(0 1 2) equal?)
(pass-if (do-test-0 10) '#(0 1 2 3 4 5 6 7 8 9) equal?)
(pass-if (do-test-1) 25 =)

(begin-sub-section "named let")

(pass-if (let loop ((x 1) (b 2))
	   (if (and (< x 0) (< b 0))
	       4242
	       (loop (- x 1) (- b 1))))
	 4242 =)

(pass-if (let loop ((x -1000) (y 1000))
	   (if (< x y)
	       (loop (+ x 1) (- y 1))
	       2323))
	 2323 =)

(begin-section "binding constructs")

(begin-sub-section "let")

(pass-if (let ((a 10) (b 2))
	   (let ((a (+ a 5)))
	     (* a b)))
	 30 =)
(pass-if (let ((b 2))
	   (let ((add2 (lambda (x) (+ x 2)))
		 (b 0.5))
	     (/ b (add2 b))))
	 0.2 =)

(begin-section "quoting functions")

(begin-sub-section "quote")
(pass-if (quote a) 'a eq?)
(pass-if (quote 1) 1 =)
(pass-if (quote 1.0) 1.0 =)
(pass-if (quote (1 2 3)) '(1 2 3) equal?)

(begin-sub-section "quasiquote")
(pass-if (quasiquote a) 'a eq?)
(pass-if (quasiquote 1) 1 =)
(pass-if (quasiquote 1.0) 1.0 =)
(pass-if (quasiquote (1 2 3)) '(1 2 3) equal?)

(begin-sub-section "quasiquote / unquote")
(pass-if (quasiquote ,(+ 1 2)) 3 =)
(pass-if (quasiquote (1 2 ,(+ 1 2))) '(1 2 3) equal?)
(pass-if (quasiquote (1 2 ,(quasiquote ,(+ 1 2)))) '(1 2 3) equal?)

(begin-sub-section "quasiquote / unquote-splicing")
(pass-if (quasiquote (1 ,@(list 2 3))) '(1 2 3) equal?)
(pass-if (quasiquote (1 ,@(list 2) 3)) '(1 2 3) equal?)
(pass-if (quasiquote (,@(list 1 2) 3)) '(1 2 3) equal?)

(test-summary)
