~ubuntu-branches/ubuntu/hardy/sigscheme/hardy-proposed

« back to all changes in this revision

Viewing changes to test/bigloo-vector.scm

  • Committer: Bazaar Package Importer
  • Author(s): NIIBE Yutaka
  • Date: 2006-05-23 21:46:41 UTC
  • mfrom: (1.1.1 upstream)
  • Revision ID: james.westby@ubuntu.com-20060523214641-6ix4gz34wpiehub8
Tags: 0.5.0-2
* debian/control (Build-Depends): Added ruby.
  Thanks to Frederik Schueler.  Closes: #368571
* debian/rules (clean): invoke 'distclean' instead of 'clean'.

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
;*---------------------------------------------------------------------*/
 
2
;*    serrano/prgm/project/bigloo/recette/vector.scm                   */
 
3
;*                                                                     */
 
4
;*    Author      :  Manuel Serrano                                    */
 
5
;*    Creation    :  Tue Nov  3 09:39:09 1992                          */
 
6
;*    Last change :  Mon Jun  7 11:46:40 2004 (serrano)                */
 
7
;*                                                                     */
 
8
;*    On test les operations primitives sur les vecteurs               */
 
9
;*---------------------------------------------------------------------*/
 
10
 
 
11
(load "./test/unittest-bigloo.scm")
 
12
 
 
13
;*---------------------------------------------------------------------*/
 
14
;*    Tvector optimization check                                       */
 
15
;*---------------------------------------------------------------------*/
 
16
(define *number-images* (vector #\0 #\1 #\2))
 
17
(define *foo*           (vector "toto" "toto"))
 
18
 
 
19
(define (prin-integer n)
 
20
   (let ((x (vector-ref *number-images* 2)))
 
21
      x))
 
22
 
 
23
(define (foo n)
 
24
   (vector-ref (if (equal? 5 n) *number-images* *foo*) 0)
 
25
   (prin-integer n)) 
 
26
 
 
27
;*---------------------------------------------------------------------*/
 
28
;*    test-vector ...                                                  */
 
29
;*---------------------------------------------------------------------*/
 
30
(define (test-vector)
 
31
   (test "vector?" (vector? '#()) #t)
 
32
   (test "vector?" (vector? '#(1)) #t)
 
33
   (test "ref" (vector-ref '#(1 2 3 4) 2) 3)
 
34
   (test "set" (let ((v (make-vector 1 '())))
 
35
                  (vector-set! v 0 'toto)
 
36
                  (vector-ref  v 0))
 
37
         'toto)
 
38
   (test "length" (vector-length '#(1 2 3 4 5)) 5)
 
39
   (test "length" (vector-length (make-vector 5 'toto)) 5)
 
40
   (test "equal vector" (let ((v (make-vector 3 '())))
 
41
                           (vector-set! v 0 '(1 2 3))
 
42
                           (vector-set! v 1 '#(1 2 3))
 
43
                           (vector-set! v 2 'hello)
 
44
                           v)
 
45
         '#((1 2 3) #(1 2 3) hello))
 
46
   (test "vector-fill" (let ((v (make-vector 3 1)))
 
47
                          (vector-fill! v 2)
 
48
                          (+ (vector-ref v 0)
 
49
                             (vector-ref v 1)
 
50
                             (vector-ref v 2)))
 
51
         6)
 
52
   (test "tvector.1" (let ((t '#(1 2 3)))
 
53
                        (vector-ref t 2))
 
54
         3)
 
55
;   (test "tvector2"
 
56
;        (string? (with-output-to-string
 
57
;                    (lambda ()
 
58
;                       (print (make-array-of-int 1 1)))))
 
59
;        #t)
 
60
   (test "vector-ref" (foo 10) #\2)
 
61
   (test "vector-ref" (vector-ref (let ((v (vector 0 1 2))) v) 2) 2))
 
62
 
 
63
(test-vector)
 
64
 
 
65
(total-report)