;;;;							-*- coding: latin-1 -*-
;;;;
;;;; test-r7rs.stk	-- Testing R7RS constructs/primitives
;;;;
;;;; Copyright © 2011 Erick Gallesio - Polytech'Nice-Sophia <eg@unice.fr>
;;;;
;;;;
;;;; This program 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 of the License, or
;;;; (at your option) any later version.
;;;;
;;;; This program 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 program; if not, write to the Free Software
;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
;;;; USA.
;;;;
;;;;           Author: Erick Gallesio [eg@unice.fr]
;;;;    Creation date: 17-Apr-2011 20:58 (eg)
;;;; Last file update: 20-Apr-2011 09:48 (eg)
;;;;

(require "test")

(test-section "R7RS")


;;------------------------------------------------------------------
(test-subsection "Control features")

(test "string-map 1"  "abdegh"  (string-map char-downcase "AbdEgH"))
(test "string-map 2"  "IBM"     (string-map (lambda (c)
					      (integer->char (+ 1 (char->integer c))))
					    "HAL"))
(test "string-map 3"  "StUdLyCaPs"  (string-map (lambda (c k)
						  (if (eqv? k #\u)
						      (char-upcase c)
						      (char-downcase c)))
						"studlycaps"
						"ululululul"))
;; **********
(test "vector-map 1"
      #(b e h)
      (vector-map cadr '#((a b) (d e) (g h))))

(test "vector-map 2" #(1 4 27 256 3125)
      (vector-map (lambda (n) (expt n n))
		  '#(1 2 3 4 5)))

(test "vector-map 3" #(5 7 9)
      (vector-map + '#(1 2 3) '#(4 5 6)))

(test "vector-map 4"  #(1 2)
      (let ((count 0))
	(vector-map (lambda (ignored)
		      (set! count (+ count 1))
		      count)
		    '#(a b))))

;; **********
(test "string-for-each"
      '(101 100 99 98 97)
      (let ((v (list)))
	(string-for-each (lambda (c) (set! v (cons (char->integer c) v)))
			 "abcde")
	 v))

;; **********
(test "vector-for-each"
      '#(0 1 4 9 16)
      (let ((v (make-vector 5)))
	(vector-for-each (lambda (i) (vector-set! v i (* i i)))
			 '#(0 1 2 3 4))
	v))


(test-section-end)