#! /bin/sh
exec ../src/sizzle -qs $0 $*
!#
;; test/functions.scm -- user-defined function 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.

;; Routines partly taken from the book: Scheme and the Art of
;; Programming by George Springer and Daniel P. Friedman.

;; Load the test framework.

(load "test-suite.scm")

;; Actual tests.

(begin-section "recursion")

(begin-sub-section "tail recursion")

(define t-r-f
  (lambda (x)
    (if (> x 0)
	(t-r-f (- x 1))
	0)))
(pass-if (t-r-f 10) 0 =)
(pass-if (t-r-f 100000) 0 =)

(begin-sub-section "mutual tail recursion")

(define m-t-r-f
  (lambda (x)
    (if (> x 0)
	(m-t-r-g (- x 1))
	0)))
(define m-t-r-g
  (lambda (x)
    (m-t-r-f x)))
(pass-if (m-t-r-g 10) 0 =)
(pass-if (m-t-r-f 100000) 0 =)

(begin-sub-section "tak")
(define tak
  (lambda (x y z)
    (if (>= y x) z
	(tak (tak (- x 1) y z)
	     (tak (- y 1) z x)
	     (tak (- z 1) x y)))))
(define test-tak
  (lambda ()
    (tak 18 12 6)))
(pass-if (test-tak) 7 =)

(begin-section "arithmetic functions")

(begin-sub-section "add1")
(define add1 (lambda (n) (+ n 1)))
(pass-if (add1 7) 8 =)
(pass-if (add1 -37) -36 =)

(begin-sub-section "sub1")
(define sub1 (lambda (n) (- n 1)))
(pass-if (sub1 7) 6 =)
(pass-if (sub1 -37) -38 =)

(begin-sub-section "harmonic-sum")
(define harmonic-sum
  (lambda (n)
    (cond
     ((zero? n) 0)
     (else (+ (/ 1 n) (harmonic-sum (sub1 n)))))))
(display (harmonic-sum 10)) (newline)

(begin-section "list processing")

(begin-sub-section "last-item")
(define last-item
  (lambda (ls)
    (cond 
     ((null? (cdr ls)) (car ls))
     (else (last-item (cdr ls))))))
(pass-if (last-item '(1)) 1 =)
(pass-if (last-item '(1 2 3 4 5 6 7 8 9 0)) 0 =)
(pass-if (last-item '(1 2 3 4 5)) 5 =)
(pass-if (last-item '(a b (c d))) '(c d) equal?)
(pass-if (last-item '(cat)) 'cat eq?)
(pass-if (last-item '((cat))) '(cat) equal?)

(begin-sub-section "member?")
(define member?
  (lambda (item ls)
    (cond
     ((null? ls) #f)
     (else (or (equal? (car ls) item) (member? item (cdr ls)))))))
(pass-if (member? 1 '()) #f eq?)
(pass-if (member? 1 '(2 3 5 1 2)) #t eq?)
(pass-if (member? '(1 2) '(2 3 (1 2) 5 1 2)) #t eq?)
(pass-if (member? 'cat '(dog hen cat pig)) #t eq?)
(pass-if (member? 'fox '(dog hen cat pig)) #f eq?)
(pass-if (member? 2 '(1 (2 3) 4)) #f eq?)
(pass-if (member? '(2 3) '(1 (2 3) 4)) #t eq?)
(pass-if (member? 'cat '()) #f eq?)

(begin-sub-section "remove-1st")
(define remove-1st
  (lambda (item ls)
    (cond
     ((null? ls) '())
     ((equal? (car ls) item) (cdr ls))
     (else (cons (car ls) (remove-1st item (cdr ls)))))))
(pass-if (remove-1st 'fox '(hen fox chick cock))
	 '(hen chick cock) equal?)
(pass-if (remove-1st 'fox '(hen fox chick fox cock))
	 '(hen chick fox cock) equal?)
(pass-if (remove-1st 'fox '()) '() equal?)
(pass-if (remove-1st '(1 2) '(1 2 (1 2) ((1 2))))
	 '(1 2 ((1 2))) equal?)

(begin-sub-section "swapper")
(define swapper
  (lambda (x y ls)
    (cond
     ((null? ls) '())
     ((equal? (car ls) x)
      (cons y (swapper x y (cdr ls))))
     ((equal? (car ls) y)
      (cons x (swapper x y (cdr ls))))
     (else
      (cons (car ls) (swapper x y (cdr ls)))))))
(pass-if (swapper 'cat 'dog '(my cat eats dog food))
	 '(my dog eats cat food) equal?)
(pass-if (swapper 'john 'mary '(john loves mary))
	 '(mary loves john) equal?)
(pass-if (swapper 'a 'n '(b n a n a n)) '(b a n a n a) equal?)
(pass-if (swapper 'a 'b '(c (a b) d)) '(c (a b) d) equal?)
(pass-if (swapper 'a 'b '()) '() eq?)

(begin-sub-section "=length=")
(define =length=
  (lambda (ls)
    (if (null? ls)
	0
	(add1 (=length= (cdr ls))))))
(pass-if (=length= '()) 0 =)
(pass-if (=length= '(one)) 1 =)
(pass-if (=length= '(a b c d e)) 5 =)
(pass-if (=length= '(1 (2 3) (4 5 6))) 3 =)

(begin-section "higher-order functions")

(begin-sub-section "make-counter")
; Create a function which will evaluate to an increasing number every
; time it is called.
(define (make-counter init)
  (lambda ()
    (set! init (+ init 1))
    init))
(define c (make-counter 2))
(define cc (make-counter -2))
(pass-if (c) 3 =)
(pass-if (c) 4 =)
(pass-if (cc) -1 =)
(pass-if (cc) 0 =)

(begin-sub-section "make-countdown")
; Create a countdown function.  It will evaluate to init-1 when it is
; called the first time and then to numbers in decreasing order until
; zero is reached; then it will return the symbol `boom!!!'
(define (make-countdown init)
  (lambda ()
    (if (> init 1)
	(begin (set! init (- init 1)) init)
	'boom!!!)))
(define cd (make-countdown 2))
(pass-if (cd) 1 =)
(pass-if (cd) 'boom!!! eq?)
(test-summary)
