Changeset 14334 in project for release/4/digraph/trunk/tests/run.scm


Ignore:
Timestamp:
04/22/09 08:00:51 (11 years ago)
Author:
Ivan Raikov
Message:

Ported digraph library to Chicken 4.

Location:
release/4/digraph
Files:
1 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/4/digraph/trunk/tests/run.scm

    r11562 r14334  
    66;;
    77;;
    8 ;; Copyright 2007 Ivan Raikov and the Okinawa Institute of Science and Technology
     8;; Copyright 2007-2009 Ivan Raikov and the Okinawa Institute of Science and Technology
    99;;
    1010;; This program is free software; you can redistribute it and/or
     
    2929;;
    3030
    31 (require-extension srfi-1)
    32 (require-extension digraph)
    33 (require-extension testbase)
    34 (require-extension testbase-output-compact)
     31(require-library srfi-1 digraph test)
     32(import srfi-1 digraph test)
    3533
    36 (define-expect-unary pair?)
    3734
    3835(define used-by
     
    4744    (cons 'zag_o 'libzigzag_a) (cons 'libzigzag_a 'killerapp)))
    4845
     46(define g (void))
    4947
    50 (define-test digraph-test "digraph test"
    51   (initial
    52    (define g (void))
     48(define node-list
     49  (delete-duplicates
     50   (concatenate (list (map car used-by) (map cdr used-by)))))
    5351
    54    (define node-list
    55      (delete-duplicates
    56       (concatenate (list (map car used-by) (map cdr used-by)))))
     52(define node-ids
     53  (list-tabulate (length node-list) values))
    5754
    58    (define node-ids
    59      (list-tabulate (length node-list) values))
     55(define node-map  (zip node-list node-ids))
    6056
    61    (define node-map  (zip node-list node-ids)) )
    62 
    63   ;; can we make a graph
    64   (expect-set! g (make-digraph 'depgraph "dependency graph"))
     57(test-group "digraph test"
     58  (let ((g (make-digraph 'depgraph "dependency graph")))
    6559
    6660  ;; add the nodes to the graph
    67   (test-eval 'add-nodes
    68              (for-each (lambda (i n) ((g 'add-node!) i n))
    69                        node-ids node-list))
     61    (for-each (lambda (i n) ((g 'add-node!) i n))
     62              node-ids node-list)
    7063
    7164  ;; make sure all nodes got inserted
    72   (test/equal 'nodes-inserted?
     65  (test "add nodes to the graph"
    7366   ((g 'nodes))
    7467   '((14 killerapp)
     
    7972
    8073  ;; add the edges to the graph
    81   (test/collect 'add-edges
    82     (for-each (lambda (e)
    83                 (collect-test (expect-pair (conc "valid edge: " e) e))
    84                 (let* ((ni (car e))
    85                        (nj (cdr e))
    86                        (i (car (alist-ref ni node-map)))
    87                        (j (car (alist-ref nj node-map))))
    88                   (collect-test
    89                     (expect-success "adding edge"
    90                       ((g 'add-edge!) (list i j (format "~A->~A" ni nj))))) ) )
    91               used-by))
     74  (for-each (lambda (e)
     75              (let* ((ni (car e))
     76                     (nj (cdr e))
     77                     (i (car (alist-ref ni node-map)))
     78                     (j (car (alist-ref nj node-map))))
     79                ((g 'add-edge!) (list i j (format "~A->~A" ni nj)))))
     80            used-by)
    9281
    9382   ;; make sure all edges got correctly created
    94    (test/equal 'edges-inserted?
    95                ((g 'edges))
    96                '((13 14 "libzigzag_a->killerapp") (12 13 "zag_o->libzigzag_a")
    97                 (11 12 "zag_cpp->zag_o") (10 13 "zig_o->libzigzag_a")
    98                 (9 10 "zig_cpp->zig_o") (8 13 "libfoobar_a->libzigzag_a")
    99                 (7 8 "bar_o->libfoobar_a") (6 7 "bar_cpp->bar_o")
    100                 (5 8 "foo_o->libfoobar_a") (4 5 "foo_cpp->foo_o")
    101                 (3 4 "zow_h->foo_cpp") (2 11 "boz_h->zag_cpp")
    102                 (2 9 "boz_h->zig_cpp") (2 6 "boz_h->bar_cpp")
    103                 (1 11 "yow_h->zag_cpp") (1 6 "yow_h->bar_cpp")
    104                 (0 1 "dax_h->yow_h") (0 6 "dax_h->bar_cpp") (0 4 "dax_h->foo_cpp")))
     83   (test "add edges to the graph"
     84    ((g 'edges))
     85    '((13 14 "libzigzag_a->killerapp") (12 13 "zag_o->libzigzag_a")
     86      (11 12 "zag_cpp->zag_o") (10 13 "zig_o->libzigzag_a")
     87      (9 10 "zig_cpp->zig_o") (8 13 "libfoobar_a->libzigzag_a")
     88      (7 8 "bar_o->libfoobar_a") (6 7 "bar_cpp->bar_o")
     89      (5 8 "foo_o->libfoobar_a") (4 5 "foo_cpp->foo_o")
     90      (3 4 "zow_h->foo_cpp") (2 11 "boz_h->zag_cpp")
     91      (2 9 "boz_h->zig_cpp") (2 6 "boz_h->bar_cpp")
     92      (1 11 "yow_h->zag_cpp") (1 6 "yow_h->bar_cpp")
     93      (0 1 "dax_h->yow_h") (0 6 "dax_h->bar_cpp") (0 4 "dax_h->foo_cpp")))
    10594
    10695    ;; remove node 0 from graph
    107    (test-eval 'remove-node-0
    108               ((g 'remove-node!) 0))
     96   ((g 'remove-node!) 0)
    10997
    11098   ;; make sure node 0 got removed
    111    (test/equal 'node-0-removed?
    112                ((g 'nodes))
    113                '((14 killerapp) (13 libzigzag_a) (12 zag_o)
    114                 (11 zag_cpp) (10 zig_o) (9 zig_cpp) (8 libfoobar_a)
    115                 (7 bar_o) (6 bar_cpp) (5 foo_o) (4 foo_cpp) (3 zow_h)
    116                 (2 boz_h) (1 yow_h)))
     99   (test "remove node 0"
     100    ((g 'nodes))
     101    '((14 killerapp) (13 libzigzag_a) (12 zag_o)
     102      (11 zag_cpp) (10 zig_o) (9 zig_cpp) (8 libfoobar_a)
     103      (7 bar_o) (6 bar_cpp) (5 foo_o) (4 foo_cpp) (3 zow_h)
     104      (2 boz_h) (1 yow_h)))
    117105
    118106    ;; make sure the edges of node 0 got removed
    119    (test/equal 'node-0-edges-removed?
    120                ((g 'edges))
    121                '((13 14 "libzigzag_a->killerapp") (12 13 "zag_o->libzigzag_a")
    122                 (11 12 "zag_cpp->zag_o") (10 13 "zig_o->libzigzag_a")
    123                 (9 10 "zig_cpp->zig_o") (8 13 "libfoobar_a->libzigzag_a")
    124                 (7 8 "bar_o->libfoobar_a") (6 7 "bar_cpp->bar_o")
    125                 (5 8 "foo_o->libfoobar_a") (4 5 "foo_cpp->foo_o")
    126                 (3 4 "zow_h->foo_cpp") (2 11 "boz_h->zag_cpp")
    127                 (2 9 "boz_h->zig_cpp") (2 6 "boz_h->bar_cpp")
    128                 (1 11 "yow_h->zag_cpp") (1 6 "yow_h->bar_cpp")))
     107   (test "make sure node 0 edges got removed"
     108    ((g 'edges))
     109    '((13 14 "libzigzag_a->killerapp") (12 13 "zag_o->libzigzag_a")
     110      (11 12 "zag_cpp->zag_o") (10 13 "zig_o->libzigzag_a")
     111      (9 10 "zig_cpp->zig_o") (8 13 "libfoobar_a->libzigzag_a")
     112      (7 8 "bar_o->libfoobar_a") (6 7 "bar_cpp->bar_o")
     113      (5 8 "foo_o->libfoobar_a") (4 5 "foo_cpp->foo_o")
     114      (3 4 "zow_h->foo_cpp") (2 11 "boz_h->zag_cpp")
     115      (2 9 "boz_h->zig_cpp") (2 6 "boz_h->bar_cpp")
     116      (1 11 "yow_h->zag_cpp") (1 6 "yow_h->bar_cpp")))
    129117
    130118    ;; remove node 2 from graph
    131    (test-eval 'remove-node-2
    132     ((g 'remove-node!) 2))
     119   ((g 'remove-node!) 2)
    133120
    134     ;; make sure node 2 got removed
    135    (test/equal 'node-0-removed?
    136                ((g 'nodes))
    137                '((14 killerapp) (13 libzigzag_a) (12 zag_o)
    138                 (11 zag_cpp) (10 zig_o) (9 zig_cpp) (8 libfoobar_a)
    139                 (7 bar_o) (6 bar_cpp) (5 foo_o) (4 foo_cpp) (3 zow_h) (1 yow_h)))
     121   ;; make sure node 2 got removed
     122   (test "remove node 2"
     123    ((g 'nodes))
     124    '((14 killerapp) (13 libzigzag_a) (12 zag_o)
     125      (11 zag_cpp) (10 zig_o) (9 zig_cpp) (8 libfoobar_a)
     126      (7 bar_o) (6 bar_cpp) (5 foo_o) (4 foo_cpp) (3 zow_h) (1 yow_h)))
    140127
    141     ;; make sure the edges of node 2 got removed
    142    (test/equal 'node-2-edges-removed?
    143                ((g 'edges))
    144                '((13 14 "libzigzag_a->killerapp") (12 13 "zag_o->libzigzag_a")
    145                  (11 12 "zag_cpp->zag_o") (10 13 "zig_o->libzigzag_a")
    146                  (9 10 "zig_cpp->zig_o") (8 13 "libfoobar_a->libzigzag_a")
    147                  (7 8 "bar_o->libfoobar_a") (6 7 "bar_cpp->bar_o")
    148                  (5 8 "foo_o->libfoobar_a") (4 5 "foo_cpp->foo_o")
    149                  (3 4 "zow_h->foo_cpp") (1 11 "yow_h->zag_cpp")
    150                  (1 6 "yow_h->bar_cpp"))))
    151 
    152 (test::styler-set! digraph-test test::output-style-compact)
    153 (run-test "digraph test")
     128   ;; make sure the edges of node 2 got removed
     129   (test "make sure node 2 edges got removed"
     130    ((g 'edges))
     131    '((13 14 "libzigzag_a->killerapp") (12 13 "zag_o->libzigzag_a")
     132      (11 12 "zag_cpp->zag_o") (10 13 "zig_o->libzigzag_a")
     133      (9 10 "zig_cpp->zig_o") (8 13 "libfoobar_a->libzigzag_a")
     134      (7 8 "bar_o->libfoobar_a") (6 7 "bar_cpp->bar_o")
     135      (5 8 "foo_o->libfoobar_a") (4 5 "foo_cpp->foo_o")
     136      (3 4 "zow_h->foo_cpp") (1 11 "yow_h->zag_cpp")
     137      (1 6 "yow_h->bar_cpp")))
     138  ))
     139 
Note: See TracChangeset for help on using the changeset viewer.