/usr/share/scheme48-1.9/big/transport-link-cell-check.scm is in scheme48 1.9-5.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 | ; Part of Scheme 48 1.9. See file COPYING for notices and license.
; Authors: Marcus Crestani
(define-test-suite transport-link-cell-tests)
(define max-number-of-tlcs 999)
(define-test-case constructor-predicate transport-link-cell-tests
(check-that
(transport-link-cell? (make-transport-link-cell 'key 'value 'tconc 'next))
(is-true)))
(define-test-case accessors transport-link-cell-tests
(let* ((key (cons 23 42))
(value (cons 65 99))
(tconc 'tconc)
(next 'next)
(tlc (make-transport-link-cell key value tconc next)))
(check (transport-link-cell-key tlc) => key)
(check (transport-link-cell-value tlc) => value)
(check (transport-link-cell-tconc tlc) => tconc)
(check (transport-link-cell-next tlc) => next)))
(define-test-case setters transport-link-cell-tests
(let* ((key (cons 23 42))
(value (cons 65 99))
(tconc 'tconc)
(next 'next)
(tlc (make-transport-link-cell key value tconc next)))
(check (transport-link-cell-key tlc) => key)
(check (transport-link-cell-value tlc) => value)
(check (transport-link-cell-tconc tlc) => tconc)
(check (transport-link-cell-next tlc) => next)
(let ((new-value 'value)
(new-tconc (cons #f #f))
(new-next "I'm next!"))
(set-transport-link-cell-value! tlc new-value)
(set-transport-link-cell-tconc! tlc new-tconc)
(set-transport-link-cell-next! tlc new-next)
(check (transport-link-cell-key tlc) => key)
(check (transport-link-cell-value tlc) => new-value)
(check (transport-link-cell-tconc tlc) => new-tconc)
(check (transport-link-cell-next tlc) => new-next))))
(define-test-case collection transport-link-cell-tests
(do-ec
(:range n 1 max-number-of-tlcs)
(let* ((key (cons 23 42))
(value (cons 65 99))
(tconc (make-tconc-queue))
(next #f)
(tlc (make-transport-link-cell key value tconc next)))
(collect)
(let ((tlc-tconc (transport-link-cell-tconc tlc)))
(if tlc-tconc
(check-that (tconc-queue-empty? tlc-tconc) (is-true))
(begin
(check-that (eq? (tconc-queue-dequeue! tconc) tlc) (is-true))
(check-that (tconc-queue-empty? tconc) (is-true))))))))
(define-test-case collection-one-tconc transport-link-cell-tests
(let ((tconc (make-tconc-queue)))
(do-ec
(:range n 1 max-number-of-tlcs)
(let* ((key (cons 23 42))
(value (cons 65 99))
(next #f)
(tlc (make-transport-link-cell key value tconc next)))
(collect)
(let ((tlc-tconc (transport-link-cell-tconc tlc)))
(if tlc-tconc
(check-that (tconc-queue-empty? tlc-tconc) (is-true))
(begin
(check-that (eq? (tconc-queue-dequeue! tconc) tlc) (is-true))
(check-that (tconc-queue-empty? tconc) (is-true)))))))))
(define-test-case collection-no-tconc transport-link-cell-tests
(let ((key (cons 23 42))
(value (cons 65 99))
(next #f))
(let* ((tconc 23)
(tlc (make-transport-link-cell key value tconc next)))
(collect)
(check (transport-link-cell-tconc tlc) => tconc))
(let* ((tconc (cons 23 42))
(tlc (make-transport-link-cell key value tconc next)))
(collect)
(check (transport-link-cell-tconc tlc) => tconc)
(check (car (transport-link-cell-tconc tlc)) => (car tconc))
(check (cdr (transport-link-cell-tconc tlc)) => (cdr tconc)))
(let* ((tconc (cons (cons 23 42) 65))
(tlc (make-transport-link-cell key value tconc next)))
(collect)
(check (transport-link-cell-tconc tlc) => tconc)
(check (car (transport-link-cell-tconc tlc)) => (car tconc))
(check (car (car (transport-link-cell-tconc tlc))) => (car (car tconc)))
(check (cdr (car (transport-link-cell-tconc tlc))) => (cdr (car tconc)))
(check (cdr (transport-link-cell-tconc tlc)) => (cdr tconc)))
(let* ((tconc (cons 23 (cons 42 65)))
(tlc (make-transport-link-cell key value tconc next)))
(collect)
(check (transport-link-cell-tconc tlc) => tconc)
(check (car (transport-link-cell-tconc tlc)) => (car tconc))
(check (car (cdr (transport-link-cell-tconc tlc))) => (car (cdr tconc)))
(check (cdr (cdr (transport-link-cell-tconc tlc))) => (cdr (cdr tconc)))
(check (car (transport-link-cell-tconc tlc)) => (car tconc)))))
(define-test-case collect-n transport-link-cell-tests
(let* ((tconc (make-tconc-queue))
(tlcs (list-ec
(: n 1 max-number-of-tlcs)
(let* ((key (cons n n))
(value (cons (+ 1000 n) (+ 1000 n)))
(next #f)
(tlc (make-transport-link-cell key value tconc next)))
tlc))))
(collect)
(for-each
(lambda (tlc)
(let ((tlc-tconc (transport-link-cell-tconc tlc)))
(if tlc-tconc
(check-that (tconc-queue? tlc-tconc) (is-true))
(tconc-queue-dequeue! tconc))))
tlcs)
(check-that (tconc-queue-empty? tconc) (is-true))))
(define-test-case collect-n-one-key transport-link-cell-tests
(let* ((tconc (make-tconc-queue))
(key (cons 23 42))
(tlcs (list-ec
(: n 1 max-number-of-tlcs)
(let* ((value (cons (+ 1000 n) (+ 1000 n)))
(next #f)
(tlc (make-transport-link-cell key value tconc next)))
tlc))))
(collect)
(for-each
(lambda (tlc)
(let ((tlc-tconc (transport-link-cell-tconc tlc)))
(if tlc-tconc
(check-that (tconc-queue? tlc-tconc) (is-true))
(tconc-queue-dequeue! tconc))))
tlcs)
(check-that (tconc-queue-empty? tconc) (is-true))))
(define-test-case collect-n-one-unmovable-key transport-link-cell-tests
(let* ((tconc (make-tconc-queue))
(key 23)
(tlcs (list-ec
(: n 1 max-number-of-tlcs)
(let* ((value (cons (+ 1000 n) (+ 1000 n)))
(next #f)
(tlc (make-transport-link-cell key value tconc next)))
tlc))))
(collect)
(for-each
(lambda (tlc)
(let ((tlc-tconc (transport-link-cell-tconc tlc)))
(check-that (tconc-queue-empty? tlc-tconc) (is-true))))
tlcs)
(check-that (tconc-queue-empty? tconc) (is-true))))
|