#! /bin/sh
exec ../src/sizzle -qs $0 $*
!#
;; test/basic2.scm -- basic tests for Sizzle-specific primitives
;;
;; 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.  

;; Load the test framework.

(load "test-suite.scm")

(use-modules (core list-lib))

;; Actual tests.

(begin-section "boolean functions")

(begin-sub-section "boolean->integer")
(pass-if (boolean->integer #f) 0 =)
(pass-if (boolean->integer #t) 1 =)

(begin-sub-section "integer->boolean")
(pass-if (integer->boolean 0) #f eq?)
(pass-if (integer->boolean 1) #t eq?)
(pass-if (integer->boolean 42) #t eq?)

(begin-section "character functions")

(begin-sub-section "char->integer")
(pass-if (char->integer #\A) 65 =)
(pass-if (char->integer #\ ) 32 =)

(begin-sub-section "integer->char")
(pass-if (integer->char 65) #\A char=?)
(pass-if (integer->char 32) #\  char=?)

(begin-section "numerical operations")

(begin-sub-section "long?")
(pass-if (long? -45) #f eq?)
(pass-if (long? 11) #f eq?)
(pass-if (long? -268435456) #f eq?)
(pass-if (long? 268435455) #f eq?)
(pass-if (long? -268435457) #t eq?)
(pass-if (long? 268435456) #t eq?)

(begin-sub-section "lsh")
(pass-if (lsh 1 0) 1 =)
(pass-if (lsh 1 1) 2 =)
(pass-if (lsh 2 -1) 1 =)
(pass-if (lsh -1 -1) -1 (lambda (x y) (not (= x y))))

(begin-sub-section "ash")
(pass-if (ash 2 -1) 1 =)
(pass-if (ash -1 -1) -1 =)

(begin-sub-section "!=")
(pass-if (!= 1 2) #t eq?)
(pass-if (!= 1 1) #f eq?)
(pass-if (!= 1 2 3) #t eq?)
(pass-if (!= 1 1 1) #f eq?)
(pass-if (!= 1.1 2.1) #t eq?)
(pass-if (!= 1.1 1.1) #f eq?)
(pass-if (!= 1.1 2.1 3.1) #t eq?)
(pass-if (!= 1.1 1.1 1.1) #f eq?)

(begin-section "list functions")

(begin-sub-section "last")
(pass-if (last '(1)) 1 =)
(pass-if (last '(1 2 3)) 3 =)

(begin-sub-section "take")
(pass-if (take '() 2) '() equal?)
(pass-if (take '(1 2 3) 2) '(1 2) equal?)

(begin-sub-section "drop")
(pass-if (drop '() 1) '() equal?)
(pass-if (drop '(1 2 3) 1) '(2 3) equal?)

(begin-section "evaluation functions")

(begin-sub-section "interaction-environment")
(pass-if (not (null? (interaction-environment))) #t eq?)
(pass-if (eval '(+ 1 1) (interaction-environment)) 2 =)

(begin-sub-section "scheme-report-environment")
(pass-if (not (null? (scheme-report-environment 5))) #t eq?)
(pass-if (eval '(+ 1 1) (scheme-report-environment 5)) 2 =)

(begin-sub-section "null-environment")
(pass-if (not (null? (null-environment 5))) #t eq?)
(pass-if (eval '(+ 1 1) (null-environment 5)) 2 =)

(begin-sub-section "current-environment")
(pass-if (not (null? (current-environment))) #t eq?)
(pass-if (eval '(+ 1 1) (current-environment)) 2 =)

(begin-section "control operations")

(begin-sub-section "primitive-procedure?")
(pass-if (primitive-procedure? +) #t eq?)
(pass-if (primitive-procedure? (lambda x x)) #f eq?)

(begin-sub-section "form?")
(pass-if (form? if) #t eq?)
(pass-if (form? +) #f eq?)
(pass-if (form? (lambda x x)) #f eq?)

(begin-sub-section "closure?")
(pass-if (closure? +) #f eq?)
(pass-if (closure? (lambda x x)) #t eq?)

(test-summary)

