Changeset 9910 in project


Ignore:
Timestamp:
03/20/08 17:34:27 (11 years ago)
Author:
kon
Message:

Save.

Location:
release/3/array-lib/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/3/array-lib/trunk/array-lib-equal.scm

    r6087 r9910  
    88;; - Data of extended-procedure, tagged-pointer, etc., not followed with
    99;; rebound equal? procedure.
    10 
    11 (use lolevel srfi-4 srfi-69)
    12 (use vector-lib)
    13 (use array-lib array-lib-sem)
    1410
    1511(eval-when (compile)
     
    2319    (export
    2420      equal?) ) )
     21
     22(use lolevel srfi-4 srfi-69
     23     vector-lib
     24     array-lib array-lib-sem)
    2525
    2626;;;
  • release/3/array-lib/trunk/tests/array-lib-test.scm

    r9544 r9910  
    1818|#
    1919
    20 (define-for-syntax test::timing #f)
    21 
    2220(define-expect-binary array-equal?)
    2321
     
    2624(define-test array-shape-test "Array Shape"
    2725  (initial
    28     (define shpobj #f)
    29   )
     26    (define shpobj) )
    3027
    3128  (expect-set! shpobj (make-array-shape 1 3 0 1 1 4))
     
    5451(define-test array-dimensions-test "Array Dimensions"
    5552  (initial
    56     (define dimsobj #f)
    57     (define shpobj #f)
    58   )
     53    (define dimsob)
     54    (define shpobj) )
    5955
    6056  (expect-set! dimsobj (make-array-dimensions 2 1 3))
     
    194190  )
    195191
    196   (test/case "O Dimension" (warn "0 Dimensions unsupported - Test WILL Fail") (
     192  (test/case "O Dimension" (warn "0 Dimensions Unsupported - Test WILL Fail") (
    197193      [arr1 (make-array '#(#f) 2 0 3)]
    198194      [arr2 (make-array '#(#f) 0 2 3)]
     
    233229    (expect-true (array-ref arr3 1 2 0))
    234230
    235     (expect-equal (array '(2 1 3) 1 2 3 4 5 6)
    236       (array (make-array-shape 0 2 0 0 0 3) 1 2 3 4 5 6))
     231    (expect-equal
     232     (array '(2 1 3) 1 2 3 4 5 6)
     233     (array (make-array-shape 0 2 0 0 0 3) 1 2 3 4 5 6))
    237234  )
    238235
     
    316313
    317314(define-test array-srfi-58-test "SRFI 58"
    318   (expect-true (array? '#2A:fixN16b((0 1 2) (3 5 4))))
     315
     316  ; Note mixture of w/ & w/o whitespace btwn spec & value
     317
     318  (expect-true (array? '#2A:fixN16b ((0 1 2) (3 5 4))))
    319319  (expect-true (array? '#2A2*3:fixN16b((0 1 2) (3 5 4))))
    320   (expect-true (array? '#A2*3:fixN16b((0 1 2) (3 5 4))))
     320  (expect-true (array? '#A2*3:fixN16b ((0 1 2) (3 5 4))))
    321321  (expect-true (array? '#0a sym))
    322322  (expect-true (array? '#0A:floR32b 237.0))
    323323  (expect-true (array? '#A0*2()))
    324   (expect-true (array? '#A2*0(() ())))
     324  (expect-true (array? '#A2*0 (() ())))
    325325  (expect-true (array? '#A2*0*3(() ())))
    326   (expect-true (array? '#A2*3*0((() () ()) (() () ()))))
     326  (expect-true (array? '#A2*3*0 ((() () ()) (() () ()))))
    327327)
    328328
     
    331331(define-test array-examples-test "Examples"
    332332  (initial
    333     (define fred #f)
    334     (define freds-diagonal #f)
    335     (define freds-center #f)
    336     (define freds-large #f)
    337     (define arr1 #f)
    338     (define arr2 #f) )
     333    (define fred)
     334    (define freds-diagonal)
     335    (define freds-center)
     336    (define freds-large)
     337    (define arr1)
     338    (define arr2) )
    339339
    340340  (expect-equal '(3 5) (array-dimensions (make-array '#() 3 5)))
     
    374374
    375375  (expect-failure
    376     (make-shared-array fred (lambda (i j) (list (+ 3 i) (+ 3 j))) '(-2 0) '(35 37)))
     376   (make-shared-array fred
     377                      (lambda (i j) (list (+ 3 i) (+ 3 j)))
     378                      '(-2 0) '(35 37)))
    377379
    378380  (expect-set! freds-center
    379     (make-shared-array fred
    380                        (lambda (i j) (list (+ (+ i 2) 3) (+ (- j 35) 3)))
    381                        '(-2 0) '(35 37)))
     381   (make-shared-array fred
     382                      (lambda (i j) (list (+ (+ i 2) 3) (+ (- j 35) 3)))
     383                      '(-2 0) '(35 37)))
    382384  (expect-eq 'foo (array-ref freds-center -2 35))
    383385
    384386  ; This "works" but unsure what it means
    385387  ; Should it be legal?
    386   (expect-set! freds-large
    387     (make-shared-array fred
    388                        (lambda (i j k) (list (+ (+ i 2) 3) (+ (+ j 37) 3)))
    389                        '(-2 0) '(-37 -35) '(45 456)))
     388  (expect-set!
     389   freds-large
     390   (make-shared-array fred
     391                      (lambda (i j k) (list (+ (+ i 2) 3) (+ (+ j 37) 3)))
     392                      '(-2 0) '(-37 -35) '(45 456)))
    390393  (expect-eq 'foo (array-ref freds-large -2 -37 100))
    391394  (expect-failure (array-ref freds-large -2 -37 1000))
     
    401404  (expect-eq 'h2 (array-ref arr2 -10 -4))
    402405
    403   (expect-array-equal "not strict array copy" '#(1 2) (array-copy '#(1 2)))
    404   (expect-array-equal "shape & array copy" '#(1 2) (array-copy #t '#(1 2)))
     406  (expect-array-equal "Not strict array copy" '#(1 2) (array-copy '#(1 2)))
     407  (expect-array-equal "Shape & array copy" '#(1 2) (array-copy #t '#(1 2)))
    405408)
    406409
     
    409412(define-test array-big-test "Big Array"
    410413  (initial
    411     (define arr (make-array
    412         '(-4 -1) '(0 3) '(0 3) '(0 3) '(0 3) '(0 3) '(0 3) '(0 3) '(0 3) '(0 3) '(0 3) '(0 3))) )
     414    (define arr (make-array '(-4 -1) '(0 3) '(0 3) '(0 3) '(0 3) '(0 3) '(0 3) '(0 3) '(0 3) '(0 3) '(0 3) '(0 3))) )
    413415
    414416  (expect-equal '(-4 -1 0 3 0 3 0 3 0 3 0 3 0 3 0 3 0 3 0 3 0 3 0 3) (array-shape arr))
     
    451453    ; Uses srfi-10 reader
    452454    (expect-array-equal
    453       '#,(array vector ((0 . 4)) (1 2 2 4 13)) (centered-difference '#(0 1 3 5 9 22)))
     455     '#,(array vector ((0 . 4)) (1 2 2 4 13))
     456     (centered-difference '#(0 1 3 5 9 22)))
    454457  )
    455458
     
    506509    (expect-equal arr0 (apply array-join arr0 '(2 1) (array-split/shared arr0 2)))
    507510
    508     (expect-array-equal arr0
    509       (apply array-join arr0 (make-array-shape -3 -1) (array-split/shared arr0 1)))
    510     (expect-array-equal arr0
    511       (apply array-join arr0 (make-array-shape 0 2 45 46) (array-split/shared arr0 2)))
     511    (expect-array-equal
     512     arr0
     513     (apply array-join arr0 (make-array-shape -3 -1) (array-split/shared arr0 1)))
     514
     515    (expect-array-equal
     516     arr0
     517     (apply array-join arr0 (make-array-shape 0 2 45 46) (array-split/shared arr0 2)))
    512518  )
    513519)
     
    528534
    529535    (expect-success
    530       (array-for-each-index
    531         (lambda (idxs0 idxs1)
    532           (assert (and (= 3 (length idxs0)) (= (length idxs0) (length idxs1))))) arr0 arr1))
     536     (array-for-each-index
     537      (lambda (idxs0 idxs1)
     538        (assert (and (= 3 (length idxs0)) (= (length idxs0) (length idxs1)))) )
     539      arr0 arr1))
    533540
    534541    (expect-success
    535       (array-for-each-index (lambda (i j k) (set! idxs-lst (cons (list i j k) idxs-lst))) arr0))
     542     (array-for-each-index
     543      (lambda (i j k)
     544        (set! idxs-lst (cons (list i j k) idxs-lst)) )
     545      arr0))
    536546    (expect-equal '((1 0 2) (1 0 1) (1 0 0) (0 0 2) (0 0 1) (0 0 0)) idxs-lst)
    537547
     
    546556
    547557    (expect-array-equal "array-split & rank-0 bug"
    548       (array '(4) 23 2 82 7)
    549       (array-reverse (array '(4) 7 82 2 23)))
     558     (array '(4) 23 2 82 7)
     559     (array-reverse (array '(4) 7 82 2 23)))
    550560
    551561    ; Note use of #<n>A read-syntax
    552562
    553563    (expect-array-equal '#1A(6 15)
    554       (array-reshape arr0 1
    555         (lambda (tv fv)
    556           (assert (and (= 1 (vector-length tv)) (= 3 (vector-length fv))))
    557           (vector-set! tv 0 (apply + (vector->list fv)))
    558           tv)
    559         arr0))
     564     (array-reshape arr0 1
     565      (lambda (tv fv)
     566        (assert (and (= 1 (vector-length tv)) (= 3 (vector-length fv))))
     567        (vector-set! tv 0 (apply + (vector->list fv)))
     568        tv)
     569      arr0))
    560570
    561571    (expect-array-equal arr3
    562       (array-reshape '#() (make-array-dimensions 2 1 3)
    563         (lambda (tv fv)
    564           (assert (and (= 3 (vector-length tv)) (= 1 (vector-length fv))))
    565           (vector-set! tv 0 #t)
    566           (vector-set! tv 1 #t)
    567           (vector-set! tv 2 (vector-ref fv 0))
    568           tv)
    569         '#1A(6 15)))
     572     (array-reshape '#() (make-array-dimensions 2 1 3)
     573      (lambda (tv fv)
     574        (assert (and (= 3 (vector-length tv)) (= 1 (vector-length fv))))
     575        (vector-set! tv 0 #t)
     576        (vector-set! tv 1 #t)
     577        (vector-set! tv 2 (vector-ref fv 0))
     578        tv)
     579      '#1A(6 15)))
    570580
    571581    (expect-array-equal arr4 (array-index-map! arr0 (lambda idxs idxs)))
     
    577587
    578588    (expect-set! arr5
    579       (array-unfold (A:fixN8b) '(2 1 3)
    580                     (lambda (i s1 s2 s3)
    581                       (values (random s1) (random s2) (random s3)))
    582                     128 128 128))
     589     (array-unfold (A:fixN8b) '(2 1 3)
     590                   (lambda (i s1 s2 s3)
     591                     (values (random s1) (random s2) (random s3)))
     592                   128 128 128))
    583593  )
    584594)
     
    615625
    616626    (expect-array-equal arr0 (array-ec '#() '(2 3) (:range i 6) i))
    617     (expect-equal '((0 0 0) (1 0 1) (2 0 2) (3 1 0) (4 1 1) (5 1 2))
    618       (list-ec (:array v (index i1 i2) arr0) (list v i1 i2)))
     627    (expect-equal
     628     '((0 0 0) (1 0 1) (2 0 2) (3 1 0) (4 1 1) (5 1 2))
     629     (list-ec (:array v (index i1 i2) arr0) (list v i1 i2)))
    619630    (expect-failure
    620       (list-ec (:array v (index i1 i2) 'not-an-array) (list v i1 i2)))
     631     (list-ec (:array v (index i1 i2) 'not-an-array) (list v i1 i2)))
    621632  )
    622633)
Note: See TracChangeset for help on using the changeset viewer.