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

(begin-section "long lists")

(begin-sub-section "make-list")
(define long-list (make-list 1000000))
(pass-if (length long-list) 1000000 =)
(set! long-list (cdr long-list))
(pass-if (length long-list) 999999 =)
(garbage-collect)
(pass-if (length long-list) 999999 =)

(begin-sub-section "list-tabulate")
(define long-list (list-tabulate 100000 (lambda (x) x)))
(pass-if (length long-list) 100000 =)
(pass-if (list-ref long-list 0) 0 =)
(pass-if (list-ref long-list 99999) 99999 =)

(begin-section "large vectors")

(begin-sub-section "vector")
(define big-vector (make-vector 1000000 'blarch))
(pass-if (vector-length big-vector) 1000000 =)
(pass-if (vector-ref big-vector 500000) 'blarch eq?)


(begin-section "memory-intensive calculations")

(define ls (make-list 100000))

(define f
  (let ((vec (make-vector 100000 '(a b c))))
    (lambda ()
      (let ((avec (make-vector (vector-length vec))))
	(let lp ((idx 0))
	  (if (< idx (vector-length avec))
	      (begin
		(vector-set! avec idx (vector-ref avec idx))
		(lp (+ idx 1)))))))))

(f)
(pass-if (length ls) 100000 =)
(f)
(pass-if (length ls) 100000 =)

(begin-section "symbol table torture")

(let lp ((x 100000))
  (if (positive? x)
      (begin
	(gensym)
	(lp (- x 1)))))
(pass-if (length ls) 100000 =)
(let lp ((x 100000))
  (if (positive? x)
      (begin
	(gensym)
	(lp (- x 1)))))
(pass-if (length ls) 100000 =)
(garbage-collect)
(pass-if (length ls) 100000 =)


(test-summary)
