Changeset 7302 in project


Ignore:
Timestamp:
01/08/08 07:45:08 (12 years ago)
Author:
Ivan Raikov
Message:

Bug fixes and improvements to the regression tests.

Location:
mpi/trunk
Files:
5 edited

Legend:

Unmodified
Added
Removed
  • mpi/trunk/collcomm.scm

    r7296 r7302  
    22062206  MPI_counts_displs(len, vrecvlengths, vrecvcounts, vdispls);
    22072207 
    2208   MPI_Allgatherv (vsend, C_32vector_length(sendbuf), MPI_UNSIGNED_SHORT,
    2209                   vrecv, vrecvcounts, vdispls, MPI_UNSIGNED_SHORT,
     2208  MPI_Allgatherv (vsend, C_32vector_length(sendbuf), MPI_UNSIGNED,
     2209                  vrecv, vrecvcounts, vdispls, MPI_UNSIGNED,
    22102210                  Comm_val(comm));
    22112211
  • mpi/trunk/mpi-eggdoc.scm

    r7294 r7302  
    99
    1010     (history
     11      (version "1.1" "Bug fixes and improvements to the regression tests")
    1112      (version "1.0" "Initial release"))
    1213
     
    3132      (p "The Chicken MPI egg provides a Scheme interface to "
    3233         "a large subset of the MPI 1.2 procedures for communication.  "
    33          "It is based on the Ocaml MPI library by Xavier Leroy. "
     34         "It is based on the "
     35         (url "http://pauillac.inria.fr/~xleroy/software.html#ocamlmpi" "Ocaml MPI")
     36         " library by Xavier Leroy. "
    3437         "Below is a list of procedures that are included in this egg, "
    3538         "along with brief descriptions. This egg has been tested with "
     
    4649                     (p "Terminates the MPI execution environment. "))
    4750
    48           (procedure "MPI:wtime:: UNDEFINED -> SECONDS"
     51          (procedure "MPI:wtime:: VOID -> SECONDS"
    4952                     "Returns the number of seconds representing elapsed wall-clock time on the calling process. ")
    5053
     
    7881                        (tt "GROUP") " and a new context. See the procedures in subsection "
    7982                        (i "Handling of communication groups")
    80                         "for information on how to create process group objects. "))
     83                        " for information on how to create process group objects. "))
    8184
    8285          (procedure "MPI:make-cart:: COMM * DIMS * PERIODS * REORDER -> COMM"
     
    290293     (license
    291294      "Copyright Ivan Raikov and the Okinawa Institute of Science and Technology
     295
     296Based on the Ocaml MPI library by Xavier Leroy.
    292297
    293298This program is free software: you can redistribute it and/or modify
  • mpi/trunk/mpi.meta

    r7294 r7302  
    1717 ; A list of eggs mpi depends on.
    1818
    19  (needs eggdoc)
     19 (needs eggdoc testbase)
    2020
    2121 (eggdoc "mpi-eggdoc.scm")
  • mpi/trunk/mpi.setup

    r7294 r7302  
    4040
    4141  ; Assoc list with properties for your extension:
    42   `((version 1.0)
     42  `((version 1.1)
    4343    (documentation "mpi.html")
    4444    ,@(if has-exports? `((exports "mpi.exports")) (list)) ))
  • mpi/trunk/tests/run.scm

    r7294 r7302  
    2323(require-extension posix)
    2424(require-extension srfi-4)
     25(require-extension srfi-13)
     26(require-extension srfi-14)
    2527(require-extension mpi)
    26 
    27 
    28 (define (make-srfi4-vector-map vlen vset! vref)
     28(require-extension testbase)
     29(require-extension testbase-output-compact)
     30
     31(define-expect-unary pair?)
     32
     33(define (land . args)
     34  (if (null? args) #t
     35      (and (car args) (apply land (cdr args)))))
     36
     37(define (lor . args)
     38  (if (null? args) #f
     39      (or (car args) (apply lor (cdr args)))))
     40
     41(define (eval-op op args)
     42  (apply
     43   (cond ((= op MPI:i_max)   max)
     44         ((= op MPI:i_min)   min)
     45         ((= op MPI:i_sum)   +)
     46         ((= op MPI:i_prod)  *)
     47         ((= op MPI:i_land)  land)
     48         ((= op MPI:i_lor)   lor)
     49         ((= op MPI:i_xor)   fxxor)
     50         ((= op MPI:f_max)   max)
     51         ((= op MPI:f_min)   min)
     52         ((= op MPI:f_sum)   +)
     53         ((= op MPI:f_prod)  *)
     54         (else (error 'eval-op "unknown op " op)))
     55   args))
     56
     57
     58(define (blob-range x i j)
     59  (string->blob (string-copy (blob->string x) i j)))
     60
     61(define (make-srfi4-vector-map makev vlen vset! vref)
    2962  (lambda (v f)
    30     (let loop ((v v) (n (- (vlen v) 1)))
     63    (let loop ((v v) (newv (makev (vlen v))) (n (- (vlen v) 1)))
    3164      (if (>= n 0)
    3265          (let ((x (f (vref v n))))
    33             (vset! v n x)
    34             (loop v (- n 1)))
     66            (vset! newv n x)
     67            (loop v newv (- n 1)))
    3568          (begin
    36             v)))))
     69            newv)))))
     70
     71(define (make-srfi4-vector-range makev vlen vset! vref)
     72  (lambda (v i j)
     73    (and (and (positive? j) (or (zero? i) (positive? i)) (< i j) (< (- j i) (vlen v)))
     74         (let loop ((v v) (newv (makev (- j i))) (n 0) (i i))
     75           (if (< i j)
     76               (let ((x (vref v i)))
     77                 (vset! newv n x)
     78                 (loop v newv (+ n 1) (+ i 1)))
     79               newv)))))
    3780         
    3881(define-macro (define-srfi4-map type)
    39   (let ((vlen    (string->symbol (string-append (symbol->string type) "vector-length")))
     82  (let ((makev   (string->symbol (string-append "make-" (symbol->string type) "vector")))
     83        (vlen    (string->symbol (string-append (symbol->string type) "vector-length")))
    4084        (vref    (string->symbol (string-append (symbol->string type) "vector-ref")))
    4185        (vset!   (string->symbol (string-append (symbol->string type) "vector-set!")))
    4286        (name    (string->symbol (string-append (symbol->string type) "vector-map"))))
    43   `(define ,name (make-srfi4-vector-map ,vlen ,vset! ,vref))))
     87  `(define ,name (make-srfi4-vector-map ,makev ,vlen ,vset! ,vref))))
     88
     89(define-macro (define-srfi4-range type)
     90  (let ((makev   (string->symbol (string-append "make-" (symbol->string type) "vector")))
     91        (vlen    (string->symbol (string-append (symbol->string type) "vector-length")))
     92        (vref    (string->symbol (string-append (symbol->string type) "vector-ref")))
     93        (vset!   (string->symbol (string-append (symbol->string type) "vector-set!")))
     94        (name    (string->symbol (string-append (symbol->string type) "vector-range"))))
     95  `(define ,name (make-srfi4-vector-range ,makev ,vlen ,vset! ,vref))))
    4496
    4597(define-srfi4-map u8)
     
    52104(define-srfi4-map f64)
    53105
     106
     107(define-srfi4-range u8)
     108(define-srfi4-range s8)
     109(define-srfi4-range u16)
     110(define-srfi4-range s16)
     111(define-srfi4-range u32)
     112(define-srfi4-range s32)
     113(define-srfi4-range f32)
     114(define-srfi4-range f64)
     115
    54116(MPI:init)
    55117
    56 (define comm-world  (MPI:get-comm-world))
    57 (define size        (MPI:comm-size comm-world))
    58 (define myrank      (MPI:comm-rank comm-world))
    59 
    60 (define (mpi-test)
    61 
    62   ;; Barrier
    63   (MPI:barrier comm-world)
    64 
    65   (if (zero? myrank)
     118
     119(define-test mpi-test "MPI test"
     120  (initial
     121   (define comm-world  (MPI:get-comm-world))
     122   (define size        (MPI:comm-size comm-world))
     123   (define myrank      (MPI:comm-rank comm-world))
     124   (define vsize       3)
     125   (define intdata     (list-tabulate size (lambda (i) (* 10 i))))
     126   (define flodata     (list-tabulate size (lambda (i) (* 0.1 i))))
     127   (define vsdata      (list-tabulate size (lambda (i)
     128                                             (list->string (list-tabulate vsize
     129                                                                          (lambda (j) (integer->char (+ i 97))))))))
     130   (define vvsdata     (list-tabulate size (lambda (i)
     131                                             (list->string (list-tabulate (+ i 1)
     132                                                                          (lambda (j) (integer->char (+ i 97))))))))
     133   (define vintdata    (list-tabulate size (lambda (i) (list-tabulate vsize (lambda (j) (+ (* 10 i) j))))))
     134   (define vflodata    (list-tabulate size (lambda (i) (list-tabulate vsize (lambda (j) (+ i (* 0.1 j)))))))
     135   (define vvintdata   (list-tabulate size (lambda (i) (list-tabulate (+ i 1) (lambda (j) (+ (* 10 i) j))))))
     136   (define vvflodata   (list-tabulate size (lambda (i) (list-tabulate (+ i 1) (lambda (j) (+ i (* 0.1 j)))))))
     137   )
     138
     139  (test/collect 'send-and-receive
     140    (if (zero? myrank)
    66141      (let ((data  "aa"))
    67142        (print myrank ": sending " data)
    68143        (MPI:send (string->blob data) 1 0 comm-world)
    69         (let ((n (MPI:receive MPI:any-source MPI:any-tag comm-world)))
    70           (print myrank ": received " (blob->string n))))
     144        (let ((n (blob->string (MPI:receive MPI:any-source MPI:any-tag comm-world))))
     145          (print myrank ": received " n)
     146          (collect-test
     147           (expect-success (and (= (length (string->list n)) (+ 1 size))
     148                                (every (lambda (x) (char=? x #\a)) (string->list n)))))
     149          ))
    71150      (let* ((n   (blob->string (MPI:receive MPI:any-source MPI:any-tag comm-world)))
    72151             (n1  (string-append n "a")))
    73152        (print myrank ": received " n ", resending " n1)
    74         (MPI:send (string->blob n1) (modulo (+ myrank 1) size) 0 comm-world)))
     153        (MPI:send (string->blob n1) (modulo (+ myrank 1) size) 0 comm-world)
     154        (collect-test
     155           (expect-success (and (= (length (string->list n)) (+ 1 myrank))
     156                                (every (lambda (x) (char=? x #\a)) (string->list n)))))
     157        )))
    75158
    76159  ;; Barrier
    77   (MPI:barrier comm-world)
     160  (test-eval 'barrier (MPI:barrier comm-world))
    78161 
    79   (print "***  Send and receive with tags")
    80   (if (zero? myrank)
    81       (let ((data1  "aa")
    82             (data2  "bb"))
    83         (print myrank ": sending (tag 0) " data1)
    84         (MPI:send (string->blob data1) 1 0 comm-world)
    85         (print myrank ": sending (tag 1) " data2)
    86         (MPI:send (string->blob data2) 1 1 comm-world)
    87         (let-values (((n src tag)  (MPI:receive-with-status MPI:any-source MPI:any-tag comm-world)))
    88           (print myrank ": received " (blob->string n) " (tag " tag ")" " from " src))
    89         (let-values (((n src tag)  (MPI:receive-with-status MPI:any-source MPI:any-tag comm-world)))
    90           (print myrank ": received " (blob->string n) " (tag " tag ")" " from " src)))
    91       (let-values (((n1 src tag1)  (MPI:receive-with-status MPI:any-source 0 comm-world)))
    92         (let* ((n1   (blob->string n1))
    93                (nn1  (string-append n1 "a")))
    94           (print myrank ": received " n1 " (tag " tag1 ")" " from " src
    95                  ", resending " nn1)
    96           (let-values (((n2 src tag2)  (MPI:receive-with-status MPI:any-source MPI:any-tag comm-world)))
    97             (let* ((n2   (blob->string n2))
    98                    (nn2  (string-append n2 "b")))
    99               (print myrank ": received " n2 " (tag " tag2 ")" " from " src
    100                  ", resending " nn2)
    101               (MPI:send (string->blob nn1) (modulo (+ 1 myrank) size) 1 comm-world)
    102               (MPI:send (string->blob nn2) (modulo (+ 1 myrank) size) 0 comm-world))))))
    103 
    104   ;; Barrier
    105   (MPI:barrier comm-world)
    106 
    107   (print "***  Send and receive base types")
    108   (let ((test-send-recv
     162  (test/collect 'send-and-receive-with-tags
     163   (if (zero? myrank)
     164       (let ((data1  "aa")
     165             (data2  "bb"))
     166         (print myrank ": sending (tag 0) " data1)
     167         (MPI:send (string->blob data1) 1 0 comm-world)
     168         (print myrank ": sending (tag 1) " data2)
     169         (MPI:send (string->blob data2) 1 1 comm-world)
     170         (let-values (((n src tag)  (MPI:receive-with-status MPI:any-source MPI:any-tag comm-world)))
     171             (print myrank ": received " (blob->string n) " (tag " tag ")" " from " src)
     172             (if (zero? tag)
     173                 (expect-success (and (= (length (string->list n)) (+ 1 size))
     174                                      (every (lambda (x) (char=? x #\a)) (string->list n))))
     175                 (expect-success (and (= (length (string->list n)) (+ 1 size))
     176                                      (every (lambda (x) (char=? x #\b)) (string->list n))))))
     177         (let-values (((n src tag)  (MPI:receive-with-status MPI:any-source MPI:any-tag comm-world)))
     178             (print myrank ": received " (blob->string n) " (tag " tag ")" " from " src)
     179             (if (zero? tag)
     180                 (expect-success (and (= (length (string->list n)) (+ 1 size))
     181                                      (every (lambda (x) (char=? x #\a)) (string->list n))))
     182                 (expect-success (and (= (length (string->list n)) (+ 1 size))
     183                                      (every (lambda (x) (char=? x #\b)) (string->list n)))))))
     184       (let-values (((n1 src tag1)  (MPI:receive-with-status MPI:any-source 0 comm-world)))
     185           (let* ((n1   (blob->string n1))
     186                  (nn1  (if (zero? tag1) (string-append n1 "a") (string-append n1 "b"))))
     187             (print myrank ": received " n1 " (tag " tag1 ")" " from " src
     188                    ", resending " nn1)
     189             (if (zero? tag1)
     190                 (collect-test
     191                  (expect-success (and (= (length (string->list n1)) (+ 1 myrank))
     192                                       (every (lambda (x) (char=? x #\a)) (string->list n1)))))
     193                 (collect-test
     194                  (expect-success (and (= (length (string->list n1)) (+ 1 myrank))
     195                                       (every (lambda (x) (char=? x #\b)) (string->list n1))))))
     196             (let-values (((n2 src tag2)  (MPI:receive-with-status MPI:any-source MPI:any-tag comm-world)))
     197                         (let* ((n2   (blob->string n2))
     198                                (nn2  (if (zero? tag2) (string-append n2 "a") (string-append n2 "b"))))
     199                           (if (zero? tag2)
     200                               (collect-test
     201                                (expect-success (and (= (length (string->list n2)) (+ 1 myrank))
     202                                                     (every (lambda (x) (char=? x #\a)) (string->list n2)))))
     203                               (collect-test
     204                                (expect-success (and (= (length (string->list n2)) (+ 1 myrank))
     205                                                     (every (lambda (x) (char=? x #\b)) (string->list n2))))))
     206                           (print myrank ": received " n2 " (tag " tag2 ")" " from " src
     207                                  ", resending " nn2)
     208                           (MPI:send (string->blob nn1) (modulo (+ 1 myrank) size) tag1 comm-world)
     209                           (MPI:send (string->blob nn2) (modulo (+ 1 myrank) size) tag2 comm-world)))))))
     210
     211   ;; Barrier
     212   (test-eval (MPI:barrier comm-world))
     213
     214   (test/collect 'send-and-receive-base-types
     215    (let ((test-send-recv
    109216         (lambda (sendfun recvfun transf data)
    110217           (if (zero? myrank)
     
    122229                       (let ((x (recvfun (- i 1) 0 comm-world)))
    123230                         (print myrank ": received " x)
     231                         (collect-test
     232                          (expect-success (any (lambda (y) (equal? x y)) (map transf data))))
    124233                         (loop (- i 1))))))
    125234               (let ((x (recvfun 0 0 comm-world)))
    126235                 (print myrank ": received " x)
     236                 (collect-test
     237                  (expect-success (member x data)))
    127238                 (let ((y (transf x)))
    128                    (print " sending " y)
    129239                   (sendfun y 0 0 comm-world))))
    130240           (MPI:barrier comm-world))))
    131      (test-send-recv MPI:send-fixnum MPI:receive-fixnum (lambda (x) (+ 1 x))
    132                     (list 10 20 30 40 50 60 70 80 90))
    133      (test-send-recv MPI:send-int MPI:receive-int (lambda (x) (+ 1 x))
    134                     (list 10 20 30 40 50 60 70 80 90))
    135      (test-send-recv MPI:send-flonum MPI:receive-flonum (lambda (x) (* 2 x))
    136                      (list 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9))
    137     (let ((len 3)
    138           (intdata (list (list 10 11 12) (list 20 21 22) (list 30 31 34) (list 40 41 42)
    139                          (list 50 51 52) (list 60 61 62) (list 70 71 74) (list 80 81 82)))
    140           (flodata (list (list 1.1 1.2)  (list 2.1 2.2) (list 3.1 3.2) (list 4.1 4.2)
    141                          (list 5.0 5.1 5.2) (list 6.0 6.1 6.2) (list 7.0 7.1 7.4) (list 8.0 8.1 8.2)))
    142           (srfi4-test-send-recv
     241     (test-send-recv MPI:send-fixnum MPI:receive-fixnum (lambda (x) (+ 1 x)) intdata)
     242     (test-send-recv MPI:send-int MPI:receive-int (lambda (x) (+ 1 x)) intdata)
     243     (test-send-recv MPI:send-flonum MPI:receive-flonum (lambda (x) (* 2 x)) flodata)
     244    (let ((srfi4-test-send-recv
    143245           (lambda (len vsend vreceive vmap list->vector)
    144246             (lambda (data)
     
    147249                               (lambda (v) (vmap v (lambda (x) (+ 1 x))))
    148250                               (map list->vector data))))))
    149       ((srfi4-test-send-recv len MPI:send-u8vector MPI:receive-u8vector u8vector-map list->u8vector)
    150        intdata)
    151        ((srfi4-test-send-recv len MPI:send-s8vector MPI:receive-s8vector s8vector-map list->s8vector)
    152         intdata)
    153        ((srfi4-test-send-recv len MPI:send-u16vector MPI:receive-u16vector u16vector-map list->u16vector)
    154         intdata)
    155        ((srfi4-test-send-recv len MPI:send-s16vector MPI:receive-s16vector s16vector-map list->s16vector)
    156         intdata)
    157        ((srfi4-test-send-recv len MPI:send-u32vector MPI:receive-u32vector u32vector-map list->u32vector)
    158         intdata)
    159        ((srfi4-test-send-recv len MPI:send-s32vector MPI:receive-s32vector s32vector-map list->s32vector)
    160         intdata)
    161        ((srfi4-test-send-recv len MPI:send-f32vector MPI:receive-f32vector f32vector-map list->f32vector)
    162         flodata)
    163        ((srfi4-test-send-recv len MPI:send-f64vector MPI:receive-f64vector f64vector-map list->f64vector)
    164         flodata)
    165       ))
    166 
    167   (if (positive? myrank)
    168       (sleep myrank))
    169   (print myrank ": hitting barrier")
    170   (MPI:barrier comm-world)
    171   (if (zero? myrank)
    172       (print "jumped barrier"))
    173 
    174   ;;  Broadcast
    175   (let* ((test-broadcast
    176           (lambda (bcast data)
    177            (if (zero? myrank)
    178                (print myrank ": broadcasting " data))
    179            (let ((res (bcast data 0 comm-world)))
    180              (print myrank ": received " (if (blob? res) (blob->string res) res)))
    181            (MPI:barrier comm-world))))
    182     (test-broadcast MPI:broadcast-bytevector (string->blob "Hello!"))
    183     (test-broadcast MPI:broadcast-int 123456)
    184     (test-broadcast MPI:broadcast-flonum 3.141592654)
    185     (let ((intdata  (list 12 45 78))
    186           (flodata  (list 3.14 2.718 0.578))
    187           (srfi4-test-broadcast
    188            (lambda (bcast list->vector data)
    189              (test-broadcast bcast (list->vector data)))))
    190       (srfi4-test-broadcast MPI:broadcast-s8vector list->s8vector intdata)
    191       (srfi4-test-broadcast MPI:broadcast-u8vector list->u8vector intdata)
    192       (srfi4-test-broadcast MPI:broadcast-s16vector list->s16vector intdata)
    193       (srfi4-test-broadcast MPI:broadcast-u16vector list->u16vector intdata)
    194       (srfi4-test-broadcast MPI:broadcast-s32vector list->s32vector intdata)
    195       (srfi4-test-broadcast MPI:broadcast-u32vector list->u32vector intdata)
    196       (srfi4-test-broadcast MPI:broadcast-f32vector list->f32vector flodata)
    197       (srfi4-test-broadcast MPI:broadcast-f64vector list->f64vector flodata)))
     251      ((srfi4-test-send-recv vsize MPI:send-u8vector MPI:receive-u8vector u8vector-map list->u8vector)
     252       vintdata)
     253       ((srfi4-test-send-recv vsize MPI:send-s8vector MPI:receive-s8vector s8vector-map list->s8vector)
     254        vintdata)
     255       ((srfi4-test-send-recv vsize MPI:send-u16vector MPI:receive-u16vector u16vector-map list->u16vector)
     256        vintdata)
     257       ((srfi4-test-send-recv vsize MPI:send-s16vector MPI:receive-s16vector s16vector-map list->s16vector)
     258        vintdata)
     259       ((srfi4-test-send-recv vsize MPI:send-u32vector MPI:receive-u32vector u32vector-map list->u32vector)
     260        vintdata)
     261       ((srfi4-test-send-recv vsize MPI:send-s32vector MPI:receive-s32vector s32vector-map list->s32vector)
     262        vintdata)
     263       ((srfi4-test-send-recv vsize MPI:send-f32vector MPI:receive-f32vector f32vector-map list->f32vector)
     264        vflodata)
     265       ((srfi4-test-send-recv vsize MPI:send-f64vector MPI:receive-f64vector f64vector-map list->f64vector)
     266        vflodata)
     267      )))
     268
     269    (test-eval 'barrier
     270      (begin
     271        (if (positive? myrank)
     272            (sleep myrank))
     273        (print myrank ": hitting barrier")
     274        (MPI:barrier comm-world)
     275        (if (zero? myrank)
     276            (print "jumped barrier"))))
     277
     278    ;;  Broadcast
     279    (test/collect 'broadcast
     280      (let* ((test-broadcast
     281              (lambda (bcast data)
     282                (if (zero? myrank)
     283                    (print myrank ": broadcasting " data))
     284                (let ((res (bcast data 0 comm-world)))
     285                  (print myrank ": received " (if (blob? res) (blob->string res) res))
     286                  (collect-test
     287                   (expect-success (equal? res data)))
     288                  (MPI:barrier comm-world)))))
     289        (test-broadcast MPI:broadcast-bytevector (string->blob "Hello!"))
     290        (test-broadcast MPI:broadcast-int 123456)
     291        (test-broadcast MPI:broadcast-flonum 3.141592654)
     292        (let ((intdata  (list 12 45 78))
     293              (flodata  (list 3.14 2.718 0.578))
     294              (srfi4-test-broadcast
     295               (lambda (bcast list->vector data)
     296                 (test-broadcast bcast (list->vector data)))))
     297          (srfi4-test-broadcast MPI:broadcast-s8vector  list->s8vector  intdata)
     298          (srfi4-test-broadcast MPI:broadcast-u8vector  list->u8vector  intdata)
     299          (srfi4-test-broadcast MPI:broadcast-s16vector list->s16vector intdata)
     300          (srfi4-test-broadcast MPI:broadcast-u16vector list->u16vector intdata)
     301          (srfi4-test-broadcast MPI:broadcast-s32vector list->s32vector intdata)
     302          (srfi4-test-broadcast MPI:broadcast-u32vector list->u32vector intdata)
     303          (srfi4-test-broadcast MPI:broadcast-f32vector list->f32vector flodata)
     304          (srfi4-test-broadcast MPI:broadcast-f64vector list->f64vector flodata))))
    198305
    199306  ;; Scatter
    200   (let* ((test-scatter
    201          (lambda (scatter data)
    202            (if (zero? myrank)
    203                (print myrank ": scatter " data))
    204            (let ((res (scatter data 3 0 comm-world)))
    205              (print myrank ": received (scatter) " (if (blob? res) (blob->string res) res)))
    206            (MPI:barrier comm-world))))
    207     (test-scatter MPI:scatter-bytevector (string->blob "aaabbbcccdddeeefffggghhh"))
    208     (let ((intdata  (list 10 10 10 20 20 20 30 30 30 40 40 40 50 50 50 60 60 60 70 70 70 80 80 80))
    209           (flodata  (list 1.2 1.2 1.2 2.3 2.3 2.3 3.4 3.4 3.4 4.5 4.5 4.5 5.6 5.6 5.6 6.7 6.7 6.7
    210                           7.8 7.8 7.8 8.9 8.9 8.9 ))
    211           (srfi4-test-scatter
    212            (lambda (scatter list->vector data)
    213              (test-scatter scatter (list->vector data)))))
    214       (srfi4-test-scatter MPI:scatter-s8vector list->s8vector intdata)
    215       (srfi4-test-scatter MPI:scatter-u8vector list->u8vector intdata)
    216       (srfi4-test-scatter MPI:scatter-s16vector list->s16vector intdata)
    217       (srfi4-test-scatter MPI:scatter-u16vector list->u16vector intdata)
    218       (srfi4-test-scatter MPI:scatter-s32vector list->s32vector intdata)
    219       (srfi4-test-scatter MPI:scatter-u32vector list->u32vector intdata)
    220       (srfi4-test-scatter MPI:scatter-f32vector list->f32vector flodata)
    221       (srfi4-test-scatter MPI:scatter-f64vector list->f64vector flodata)))
     307  (test/collect 'scatter
     308   (let* ((test-scatter
     309           (lambda (scatter vrange data)
     310             (if (zero? myrank)
     311                 (print myrank ": scatter " (if (blob? data) (blob->string data) data)))
     312             (let ((res (scatter data 3 0 comm-world)))
     313               (print myrank ": received (scatter) " (if (blob? res) (blob->string res) res))
     314               (collect-test
     315                (expect-success
     316                 (equal? res (vrange data (* myrank vsize) (+ vsize (* myrank vsize)))))))
     317             (MPI:barrier comm-world))))
     318     (test-scatter MPI:scatter-bytevector blob-range (string->blob (string-concatenate vsdata)))
     319     (let ((srfi4-test-scatter
     320            (lambda (scatter vrange list->vector data)
     321              (test-scatter scatter vrange (list->vector (concatenate data))))))
     322        (srfi4-test-scatter MPI:scatter-s8vector  s8vector-range  list->s8vector  vintdata)
     323        (srfi4-test-scatter MPI:scatter-u8vector  u8vector-range  list->u8vector  vintdata)
     324        (srfi4-test-scatter MPI:scatter-s16vector s16vector-range list->s16vector vintdata)
     325        (srfi4-test-scatter MPI:scatter-u16vector u16vector-range list->u16vector vintdata)
     326        (srfi4-test-scatter MPI:scatter-s32vector s32vector-range list->s32vector vintdata)
     327        (srfi4-test-scatter MPI:scatter-u32vector u32vector-range list->u32vector vintdata)
     328        (srfi4-test-scatter MPI:scatter-f32vector f32vector-range list->f32vector vflodata)
     329        (srfi4-test-scatter MPI:scatter-f64vector f64vector-range list->f64vector vflodata))))
    222330     
    223331  ;; Scatterv
    224   (let* ((test-scatterv
    225          (lambda (scatterv data)
    226            (if (zero? myrank)
    227                (print myrank ": scatterv " data))
    228            (let ((res (scatterv data 0 comm-world)))
    229              (print myrank ": received (scatterv) " (if (blob? res) (blob->string res) res)))
    230            (MPI:barrier comm-world))))
    231     (test-scatterv MPI:scatterv-bytevector
    232                    (map string->blob (take (list "a" "bb" "ccc" "dddd" "eeeee"
    233                                                  "ffffff" "ggggggg" "hhhhhhhh")
    234                                            size)))
    235      (let ((intdata  (take (list (list 10) (list 20 20) (list 30 30 30) (list 40 40 40 40) (list 50 50 50 50 50)
    236                                  (list 60 60 60 60 60 60) (list 70 70 70 70 70 70 70)
    237                                  (list 80 80 80 80 80 80 80))
    238                            size))
    239           (flodata  (take (list (list 1.2) (list 2.3 2.3) (list 3.4 3.4 3.4) (list 4.5 4.5 4.5 4.5)
    240                                 (list 5.6 5.6 5.6 5.6 5.6) (list 6.7 6.7 6.7 6.7 6.7 6.7)
    241                                 (list 7.8 7.8 7.8 7.8 7.8 7.8 7.8) (list 8.9 8.9 8.9 8.9 8.9 8.9 8.9 8.9))
    242                           size))
    243           (srfi4-test-scatterv
    244            (lambda (scatterv list->vector data)
    245              (test-scatterv scatterv (map list->vector data)))))
    246        (srfi4-test-scatterv MPI:scatterv-s8vector list->s8vector intdata)
    247        (srfi4-test-scatterv MPI:scatterv-u8vector list->u8vector intdata)
    248        (srfi4-test-scatterv MPI:scatterv-s16vector list->s16vector intdata)
    249        (srfi4-test-scatterv MPI:scatterv-u16vector list->u16vector intdata)
    250        (srfi4-test-scatterv MPI:scatterv-s32vector list->s32vector intdata)
    251        (srfi4-test-scatterv MPI:scatterv-u32vector list->u32vector intdata)
    252        (srfi4-test-scatterv MPI:scatterv-f32vector list->f32vector flodata)
    253        (srfi4-test-scatterv MPI:scatterv-f64vector list->f64vector flodata)))
     332  (test/collect 'scatterv
     333   (let* ((test-scatterv
     334           (lambda (scatterv data)
     335             (if (zero? myrank)
     336                 (print myrank ": scatterv " data))
     337             (let ((res (scatterv data 0 comm-world)))
     338               (print myrank ": received (scatterv) " res)
     339               (collect-test
     340                (expect-success
     341                 (equal? res (list-ref data myrank)))))
     342             (MPI:barrier comm-world))))
     343     (test-scatterv MPI:scatterv-bytevector (map string->blob vvsdata))
     344     (let ((srfi4-test-scatterv
     345            (lambda (scatterv list->vector data)
     346              (test-scatterv scatterv (map list->vector data)))))
     347       (srfi4-test-scatterv MPI:scatterv-s8vector   list->s8vector  vvintdata)
     348       (srfi4-test-scatterv MPI:scatterv-u8vector   list->u8vector  vvintdata)
     349       (srfi4-test-scatterv MPI:scatterv-s16vector  list->s16vector vvintdata)
     350       (srfi4-test-scatterv MPI:scatterv-u16vector  list->u16vector vvintdata)
     351       (srfi4-test-scatterv MPI:scatterv-s32vector  list->s32vector vvintdata)
     352       (srfi4-test-scatterv MPI:scatterv-u32vector  list->u32vector vvintdata)
     353       (srfi4-test-scatterv MPI:scatterv-f32vector  list->f32vector vvflodata)
     354       (srfi4-test-scatterv MPI:scatterv-f64vector  list->f64vector vvflodata))))
    254355
    255356  ;; Gather
    256    (let* ((test-gather    (lambda (gather data)
    257             (print myrank ": gather " (if (blob? data) (blob->string data) data))
    258             (let ((res (gather data 3 0 comm-world)))
    259               (if (zero? myrank)
    260                   (print myrank ": received (gather) " (if (blob? res) (blob->string res) res)))
    261               (MPI:barrier comm-world)))))
    262      (test-gather MPI:gather-bytevector
    263                  (list-ref (map string->blob (list "aaa" "bbb" "ccc" "ddd" "eee" "fff" "ggg" "hhh")) myrank))
    264      (test-gather MPI:gather-s8vector
    265                  (s8vector (* 10 myrank) (+ 1 (* 10 myrank)) (+ 2 (* 10 myrank))))
    266      (test-gather MPI:gather-u8vector
    267                  (u8vector (* 10 myrank) (+ 1 (* 10 myrank)) (+ 2 (* 10 myrank))))
    268      (test-gather MPI:gather-s16vector
    269                  (s16vector (* 10 myrank) (+ 1 (* 10 myrank)) (+ 2 (* 10 myrank))))
    270      (test-gather MPI:gather-u16vector
    271                  (u16vector (* 10 myrank) (+ 1 (* 10 myrank)) (+ 2 (* 10 myrank))))
    272      (test-gather MPI:gather-s32vector
    273                  (s32vector (* 10 myrank) (+ 1 (* 10 myrank)) (+ 2 (* 10 myrank))))
    274      (test-gather MPI:gather-u32vector
    275                  (u32vector (* 10 myrank) (+ 1 (* 10 myrank)) (+ 2 (* 10 myrank))))
    276      (test-gather MPI:gather-f32vector
    277                  (f32vector (* 10 myrank) (+ 0.1 (* 10 myrank)) (+ 0.2 (* 10 myrank))))
    278      (test-gather MPI:gather-f64vector
    279                  (f64vector (* 10 myrank) (+ 0.1 (* 10 myrank)) (+ 0.2 (* 10 myrank)))))
     357  (test/collect 'gather
     358   (let* ((test-gather
     359           (lambda (gather data total)
     360             (print myrank ": gather " (if (blob? data) (blob->string data) data))
     361             (let ((res (gather data 3 0 comm-world)))
     362               (if (zero? myrank)
     363                   (begin
     364                     (print myrank ": received (gather) " (if (blob? res) (blob->string res) res))
     365                     (collect-test (expect-success (equal? res total)))))
     366               (MPI:barrier comm-world)))))
     367     (test-gather MPI:gather-bytevector (string->blob (list-ref vsdata myrank))
     368                  (string->blob (string-concatenate vsdata)))
     369     (test-gather MPI:gather-s8vector   (list->s8vector (list-ref vintdata myrank))
     370                  (list->s8vector (concatenate vintdata)))
     371     (test-gather MPI:gather-u8vector   (list->u8vector (list-ref vintdata myrank))
     372                  (list->u8vector (concatenate vintdata)))
     373     (test-gather MPI:gather-s16vector  (list->s16vector (list-ref vintdata myrank))
     374                  (list->s16vector (concatenate vintdata)))
     375     (test-gather MPI:gather-u16vector  (list->u16vector (list-ref vintdata myrank))
     376                  (list->u16vector (concatenate vintdata)))
     377     (test-gather MPI:gather-s32vector  (list->s32vector (list-ref vintdata myrank))
     378                  (list->s32vector (concatenate vintdata)))
     379     (test-gather MPI:gather-u32vector  (list->u32vector (list-ref vintdata myrank))
     380                  (list->u32vector (concatenate vintdata)))
     381     (test-gather MPI:gather-f32vector  (list->f32vector (list-ref vflodata myrank))
     382                  (list->f32vector (concatenate vflodata)))
     383     (test-gather MPI:gather-f64vector  (list->f64vector (list-ref vflodata myrank))
     384                  (list->f64vector (concatenate vflodata)))))
     385
    280386
    281387  ;; Gatherv
     388  (test/collect 'gatherv
    282389   (let* ((test-gatherv
    283            (lambda (gatherv data)
     390           (lambda (gatherv data total)
    284391             (print myrank ": gatherv " (if (blob? data) (blob->string data) data))
    285392             (let ((res (gatherv data 0 comm-world)))
    286393               (if (zero? myrank)
    287                    (print myrank ": received (gatherv) "
    288                           (map (lambda (x) (if (blob? x) (blob->string x) x)) res)))
     394                   (begin
     395                     (print myrank ": received (gatherv) "
     396                            (map (lambda (x) (if (blob? x) (blob->string x) x)) res))
     397                     (collect-test (expect-success (equal? res total)))))
    289398               (MPI:barrier comm-world)))))
    290      (test-gatherv MPI:gatherv-bytevector
    291                    (list-ref (map string->blob (list "a" "bb" "ccc" "dddd" "eeeee" "ffffff" "ggggggg" "hhhhhhhh"))
    292                             myrank))
    293      (test-gatherv MPI:gatherv-s8vector   
    294                    (list->s8vector  (list-tabulate (+ 1 myrank)  (lambda (i) (+ i (* 10 myrank))))))
    295      (test-gatherv MPI:gatherv-u8vector   
    296                    (list->u8vector  (list-tabulate (+ 1 myrank)  (lambda (i) (+ i (* 10 myrank))))))
    297      (test-gatherv MPI:gatherv-s16vector 
    298                    (list->s16vector (list-tabulate (+ 1 myrank)  (lambda (i) (+ i (* 10 myrank))))))
    299      (test-gatherv MPI:gatherv-u16vector 
    300                    (list->u16vector (list-tabulate (+ 1 myrank)  (lambda (i) (+ i (* 10 myrank))))))
    301      (test-gatherv MPI:gatherv-s32vector 
    302                    (list->s32vector (list-tabulate (+ 1 myrank)  (lambda (i) (+ i (* 10 myrank))))))
    303      (test-gatherv MPI:gatherv-u32vector 
    304                    (list->u32vector (list-tabulate (+ 1 myrank)  (lambda (i) (+ i (* 10 myrank))))))
    305      (test-gatherv MPI:gatherv-f32vector 
    306                    (list->f32vector (list-tabulate (+ 1 myrank)  (lambda (i) (+ (* 0.1 i) (* 10 myrank))))))
    307      (test-gatherv MPI:gatherv-f64vector 
    308                    (list->f64vector (list-tabulate (+ 1 myrank)  (lambda (i) (+ (* 0.1 i) (* 10 myrank)))))))
     399     (test-gatherv MPI:gatherv-bytevector (string->blob (list-ref vvsdata myrank))
     400                   (map string->blob vvsdata))
     401     (test-gatherv MPI:gatherv-s8vector   (list->s8vector (list-ref vvintdata myrank))
     402                   (map list->s8vector vvintdata))
     403     (test-gatherv MPI:gatherv-u8vector   (list->u8vector (list-ref vvintdata myrank))
     404                   (map list->u8vector vvintdata))
     405     (test-gatherv MPI:gatherv-s16vector  (list->s16vector (list-ref vvintdata myrank))
     406                   (map list->s16vector vvintdata))
     407     (test-gatherv MPI:gatherv-u16vector  (list->u16vector (list-ref vvintdata myrank))
     408                   (map list->u16vector vvintdata))
     409     (test-gatherv MPI:gatherv-s32vector  (list->s32vector (list-ref vvintdata myrank))
     410                   (map list->s32vector vvintdata))
     411     (test-gatherv MPI:gatherv-u32vector  (list->u32vector (list-ref vvintdata myrank))
     412                   (map list->u32vector vvintdata))
     413     (test-gatherv MPI:gatherv-f32vector  (list->f32vector (list-ref vvflodata myrank))
     414                   (map list->f32vector vvflodata))
     415     (test-gatherv MPI:gatherv-f64vector  (list->f64vector (list-ref vvflodata myrank))
     416                   (map list->f64vector vvflodata))))
     417
    309418
    310419  ;; Gather to all
    311   (let* ((test-allgather
    312          (lambda (allgather data)
    313            (print myrank ": allgather " data)
    314            (let ((res (allgather data 0 comm-world)))
    315              (print myrank ": received (allgather) "
    316                     (map (lambda (x) (if (blob? x) (blob->string x) x)) res))
    317              (MPI:barrier comm-world)))))
    318     (test-allgather MPI:allgather-bytevector
    319                     (list-ref (map string->blob (list "a" "bb" "ccc" "dddd" "eeeee" "ffffff" "ggggggg" "hhhhhhhh"))
    320                               myrank))
    321     (test-allgather MPI:allgather-s8vector
    322                     (s8vector (* 10 myrank) (+ 1 (* 10 myrank)) (+ 2 (* 10 myrank))))
    323     (test-allgather MPI:allgather-u8vector
    324                     (u8vector (* 10 myrank) (+ 1 (* 10 myrank)) (+ 2 (* 10 myrank))))
    325     (test-allgather MPI:allgather-s16vector
    326                     (s16vector (* 10 myrank) (+ 1 (* 10 myrank)) (+ 2 (* 10 myrank))))
    327     (test-allgather MPI:allgather-u16vector
    328                     (u16vector (* 10 myrank) (+ 1 (* 10 myrank)) (+ 2 (* 10 myrank))))
    329     (test-allgather MPI:allgather-s32vector
    330                     (s32vector (* 10 myrank) (+ 1 (* 10 myrank)) (+ 2 (* 10 myrank))))
    331     (test-allgather MPI:allgather-u32vector
    332                     (u32vector (* 10 myrank) (+ 1 (* 10 myrank)) (+ 2 (* 10 myrank))))
    333     (test-allgather MPI:allgather-f32vector
    334                     (f32vector (* 10 myrank) (+ 0.1 (* 10 myrank)) (+ 0.2 (* 10 myrank))))
    335     (test-allgather MPI:allgather-f64vector
    336                     (f64vector (* 10 myrank) (+ 0.1 (* 10 myrank)) (+ 0.2 (* 10 myrank)))))
     420  (test/collect 'allgather
     421   (let* ((test-allgather
     422           (lambda (allgather data total)
     423             (print myrank ": allgather " data)
     424             (let ((res (allgather data 0 comm-world)))
     425               (print myrank ": received (allgather) "
     426                      (map (lambda (x) (if (blob? x) (blob->string x) x)) res))
     427               (collect-test (expect-success (equal? res total)))
     428               (MPI:barrier comm-world)))))
     429     (test-allgather MPI:allgather-bytevector (string->blob (list-ref vvsdata myrank))
     430                   (map string->blob vvsdata))
     431     (test-allgather MPI:allgather-s8vector   (list->s8vector (list-ref vvintdata myrank))
     432                   (map list->s8vector vvintdata))
     433     (test-allgather MPI:allgather-u8vector   (list->u8vector (list-ref vvintdata myrank))
     434                   (map list->u8vector vvintdata))
     435     (test-allgather MPI:allgather-s16vector  (list->s16vector (list-ref vvintdata myrank))
     436                   (map list->s16vector vvintdata))
     437     (test-allgather MPI:allgather-u16vector  (list->u16vector (list-ref vvintdata myrank))
     438                   (map list->u16vector vvintdata))
     439     (test-allgather MPI:allgather-s32vector  (list->s32vector (list-ref vvintdata myrank))
     440                   (map list->s32vector vvintdata))
     441     (test-allgather MPI:allgather-u32vector  (list->u32vector (list-ref vvintdata myrank))
     442                   (map list->u32vector vvintdata))
     443     (test-allgather MPI:allgather-f32vector  (list->f32vector (list-ref vvflodata myrank))
     444                   (map list->f32vector vvflodata))
     445     (test-allgather MPI:allgather-f64vector  (list->f64vector (list-ref vvflodata myrank))
     446                   (map list->f64vector vvflodata))))
     447
    337448
    338449  ;; Reduce
    339 
    340   (let* ((test-reduce
     450  (test/collect 'mpi-reduce
     451   (let* ((test-reduce
    341452          (lambda (reducefun reduceops data)
    342453            (for-each (lambda (op)
     454                        (print myrank ": reduce")
    343455                        (let ((res (reducefun data op 0 comm-world)))
    344456                          (if (zero? myrank)
    345                               (print myrank ": the result of reduction " op " is " res))))
     457                              (begin
     458                                (print myrank ": the result of reduction " op " is " res)
     459                                (collect-test (expect-success res))
     460                                ))
     461                          (MPI:barrier comm-world)
     462                          ))
    346463                      reduceops)
    347464            (MPI:barrier comm-world))))
    348465    (test-reduce MPI:reduce-int
    349                  (list MPI:i_max MPI:i_min MPI:i_sum MPI:i_prod
    350                        MPI:i_land MPI:i_lor MPI:i_xor)
     466                     (list MPI:i_max MPI:i_min MPI:i_sum MPI:i_prod )
    351467                 (+ 1 myrank))
    352468     (test-reduce MPI:reduce-flonum
    353                  (list MPI:f_max MPI:f_min MPI:f_sum MPI:f_prod )
    354                  (+ 0.1 myrank))
    355      (test-reduce MPI:reduce-s8vector
    356                  (list MPI:i_max MPI:i_min MPI:i_sum MPI:i_prod
    357                        MPI:i_land MPI:i_lor MPI:i_xor)
    358                  (s8vector (* 2 myrank) (+ 1 (* 2 myrank)) (+ 2 (* 2 myrank))))
    359      (test-reduce MPI:reduce-u8vector
    360                  (list MPI:i_max MPI:i_min MPI:i_sum MPI:i_prod
    361                        MPI:i_land MPI:i_lor MPI:i_xor)
    362                  (u8vector (* 2 myrank) (+ 1 (* 2 myrank)) (+ 2 (* 2 myrank))))
    363      (test-reduce MPI:reduce-s16vector
    364                  (list MPI:i_max MPI:i_min MPI:i_sum MPI:i_prod
    365                        MPI:i_land MPI:i_lor MPI:i_xor)
    366                  (s16vector (* 2 myrank) (+ 1 (* 2 myrank)) (+ 2 (* 2 myrank))))
    367      (test-reduce MPI:reduce-u16vector
    368                  (list MPI:i_max MPI:i_min MPI:i_sum MPI:i_prod
    369                        MPI:i_land MPI:i_lor MPI:i_xor)
    370                  (u16vector (* 2 myrank) (+ 1 (* 2 myrank)) (+ 2 (* 2 myrank))))
    371      (test-reduce MPI:reduce-s32vector
    372                  (list MPI:i_max MPI:i_min MPI:i_sum MPI:i_prod
    373                        MPI:i_land MPI:i_lor MPI:i_xor)
    374                  (s32vector (* 2 myrank) (+ 1 (* 2 myrank)) (+ 2 (* 2 myrank))))
    375      (test-reduce MPI:reduce-u32vector
    376                  (list MPI:i_max MPI:i_min MPI:i_sum MPI:i_prod
    377                        MPI:i_land MPI:i_lor MPI:i_xor)
    378                  (u32vector (* 2 myrank) (+ 1 (* 2 myrank)) (+ 2 (* 2 myrank))))
    379      (test-reduce MPI:reduce-f32vector
    380                  (list MPI:f_max MPI:f_min MPI:f_sum MPI:f_prod )
    381                  (f32vector (* 2 myrank) (+ 0.1 (* 2 myrank)) (+ 0.2 (* 2 myrank))))
    382      (test-reduce MPI:reduce-f64vector
    383                  (list MPI:f_max MPI:f_min MPI:f_sum MPI:f_prod )
    384                  (f64vector (* 2 myrank) (+ 0.1 (* 2 myrank)) (+ 0.2 (* 2 myrank)))))
     469                  (list MPI:f_max MPI:f_min MPI:f_sum MPI:f_prod )
     470                  (+ 1 myrank))
     471      (test-reduce MPI:reduce-s8vector
     472                 (list MPI:i_max MPI:i_min MPI:i_sum MPI:i_prod )
     473                 (s8vector (* 2 myrank) (+ 1 (* 2 myrank)) (+ 2 (* 2 myrank))))
     474      (test-reduce MPI:reduce-u8vector
     475                 (list MPI:i_max MPI:i_min MPI:i_sum MPI:i_prod )
     476                 (u8vector (* 2 myrank) (+ 1 (* 2 myrank)) (+ 2 (* 2 myrank))))
     477      (test-reduce MPI:reduce-s16vector
     478                 (list MPI:i_max MPI:i_min MPI:i_sum MPI:i_prod )
     479                 (s16vector (* 2 myrank) (+ 1 (* 2 myrank)) (+ 2 (* 2 myrank))))
     480      (test-reduce MPI:reduce-u16vector
     481                 (list MPI:i_max MPI:i_min MPI:i_sum MPI:i_prod )
     482                 (u16vector (* 2 myrank) (+ 1 (* 2 myrank)) (+ 2 (* 2 myrank))))
     483      (test-reduce MPI:reduce-s32vector
     484                 (list MPI:i_max MPI:i_min MPI:i_sum MPI:i_prod )
     485                 (s32vector (* 2 myrank) (+ 1 (* 2 myrank)) (+ 2 (* 2 myrank))))
     486      (test-reduce MPI:reduce-u32vector
     487                 (list MPI:i_max MPI:i_min MPI:i_sum MPI:i_prod )
     488                 (u32vector (* 2 myrank) (+ 1 (* 2 myrank)) (+ 2 (* 2 myrank))))
     489      (test-reduce MPI:reduce-f32vector
     490                 (list MPI:f_max MPI:f_min MPI:f_sum MPI:f_prod )
     491                 (f32vector (* 2 myrank) (+ 0.1 (* 2 myrank)) (+ 0.2 (* 2 myrank))))
     492      (test-reduce MPI:reduce-f64vector
     493                 (list MPI:f_max MPI:f_min MPI:f_sum MPI:f_prod )
     494                 (f64vector (* 2 myrank) (+ 0.1 (* 2 myrank)) (+ 0.2 (* 2 myrank))))
     495     ))
    385496
    386497  ;; Reduce all
    387   (let* ((test-allreduce
    388           (lambda (allreducefun reduceop data)
     498  (test/collect 'allreduce
     499   (let* ((test-allreduce
     500          (lambda (allreducefun reduceop data)
    389501            (print myrank ": data is " data)
    390502            (let ((res (allreducefun data reduceop comm-world)))
    391503              (MPI:barrier comm-world)
    392504              (print myrank ": the result of reduction " reduceop " is " res)
     505              (collect-test (expect-success res))
    393506              (MPI:barrier comm-world)))))
    394507    (test-allreduce MPI:allreduce-int MPI:i_sum (+ 1 myrank))
     
    409522                    (f32vector (* 2 myrank) (+ 0.1 (* 2 myrank)) (+ 0.2 (* 2 myrank))))
    410523    (test-allreduce MPI:allreduce-f64vector MPI:f_sum 
    411                     (f64vector (* 2 myrank) (+ 0.1 (* 2 myrank)) (+ 0.2 (* 2 myrank)))))
     524                    (f64vector (* 2 myrank) (+ 0.1 (* 2 myrank)) (+ 0.2 (* 2 myrank))))))
    412525   
    413   ;; Scan
    414   (let* ((test-scan
     526   ;; Scan
     527  (test/collect 'scan
     528   (let* ((test-scan
    415529          (lambda (scanfun reduceop data)
    416530            (print myrank ": data is " data)
     
    418532              (MPI:barrier comm-world)
    419533              (print myrank ": the result of scan " reduceop " is " res)
     534              (collect-test (expect-success res))
    420535              (MPI:barrier comm-world)))))
    421536    (test-scan MPI:scan-int MPI:i_sum (+ 1 myrank))
     
    436551               (f32vector (* 2 myrank) (+ 0.1 (* 2 myrank)) (+ 0.2 (* 2 myrank))))
    437552    (test-scan MPI:scan-f64vector MPI:f_sum 
    438                (f64vector (* 2 myrank) (+ 0.1 (* 2 myrank)) (+ 0.2 (* 2 myrank)))))
     553               (f64vector (* 2 myrank) (+ 0.1 (* 2 myrank)) (+ 0.2 (* 2 myrank))))))
    439554
    440555  ;; Comm split
    441   (let ((send-in-comm
     556  (test-eval 'comm-split
     557   (let ((send-in-comm
    442558         (lambda (c init incr)
    443559           (let ((rank-in-c (MPI:comm-rank c))
     
    457573      (if (zero? (modulo myrank 2))
    458574          (send-in-comm c (string->blob "aa") "a")
    459           (send-in-comm c (string->blob "bb") "b"))))
     575          (send-in-comm c (string->blob "bb") "b")))))
    460576
    461577  ;; Cartesian topology
    462   (let ((cart (MPI:make-cart comm-world (u32vector 2 2) (u32vector 0 0) #t))
     578  (test-eval 'cart
     579   (let ((cart (MPI:make-cart comm-world (u32vector 2 2) (u32vector 0 0) #t))
    463580        (test-dims-create
    464581         (lambda (n hints)
     
    476593          (test-dims-create 60 (u32vector 0 4 0))
    477594          (test-dims-create 60 (u32vector 3 0 5))
    478           )))
    479 
    480   (MPI:barrier comm-world)
     595          ))))
     596
     597  (test-eval 'barrier (MPI:barrier comm-world))
    481598
    482599   ;; Wtime
    483   (print myrank ": wtime is "  (MPI:wtime))
     600  (test-eval 'wtime (print myrank ": wtime is "  (MPI:wtime)))
    484601
    485602  )
    486603
    487 
    488 (mpi-test)
    489 
     604(test::styler-set! mpi-test test::output-style-compact)
     605(run-test "mpi test")
     606
     607
Note: See TracChangeset for help on using the changeset viewer.