libraries.k (9604B)
1 ;; check.k & test-helpers.k should be loaded 2 ;; 3 ;; Tests of library system. 4 ;; 5 6 ;; N.B. Library registry is a hidden global variable. Library imports 7 ;; work anywhere in environment or continuation hierarchy. 8 ;; 9 ;; ($fresh A1 A2 ..) evaluates A1 A2... in a fresh environment. 10 ;; 11 ($define! $fresh 12 ($vau args #ignore 13 (eval (list* $sequence args) (make-kernel-standard-environment)))) 14 15 ;; XXX $provide-library! $import-library! 16 17 ($check-predicate (operative? $provide-library!)) 18 ($check-predicate (operative? $import-library!)) 19 20 ($check-no-error 21 ($provide-library! (mod-a) (#:export p q) 22 ($define! p 1) 23 ($define! q 2) 24 ($define! r 3))) 25 26 ($check-error mod-a) 27 ($check-error p) 28 ($check-error q) 29 ($check-error r) 30 31 ($check-no-error 32 ($provide-library! (mod-b 1 2 x) (#:export p u (#:rename v w)) 33 ($import-library! (#:only (mod-a) p)) 34 ($define! u 4) 35 ($define! v 5))) 36 37 ($check-error mod-b) 38 ($check-error p) 39 ($check-error u) 40 41 ($check-no-error 42 ($provide-library! (mod-c) (#:export) 43 ($define! w 6))) 44 45 ($check-no-error 46 ($provide-library! (mod-d) (#:export p q) 47 ($define! p 7) 48 ($define! q 2))) 49 50 ($check-error w) 51 52 ($check-no-error ($provide-library! (mod-e) (#:export))) 53 54 ($check-error ($provide-library! (mod-a) (#:export) 1)) 55 ($check-error ($provide-library! () (#:export))) 56 ($check-error ($provide-library! (mod-q) (a) ($define! a 1))) 57 ($check-error ($provide-library! (mod-q) (#:export #:a) ($define! a 1))) 58 ($check-error ($provide-library! (mod-q) (#:export a a) ($define! a 1))) 59 ($check-error ($provide-library! (mod-q) (#:export (a b)) ($define! a 1))) 60 ($check-error ($provide-library! (mod-q) (#:export (#:re-na-me a b)) ($define! a 1))) 61 ($check-error ($provide-library! (mod-q) (#:export (#:rename b a)) ($define! a 1))) 62 ($check-error ($provide-library! (mod-q) (#:export (#:rename a)) ($define! a 1))) 63 ($check-error ($provide-library! (mod-q) (#:export (#:rename a 2)) ($define! a 1))) 64 ($check-error ($provide-library! (mod-q) 1)) 65 ($check-error ($provide-library! (mod-q) 1 (#:export))) 66 ($check-not-predicate ($registered-library? (mod-q))) 67 68 ($check equal? ($fresh ($import-library! (mod-a)) p) 1) 69 ($check equal? ($fresh ($import-library! (mod-a)) q) 2) 70 ($check-error ($fresh ($import-library! (mod-a)) r)) 71 72 ($check equal? ($fresh ($import-library! (#:only (mod-a) p)) p) 1) 73 ($check equal? ($fresh ($import-library! (#:only (mod-a) q)) q) 2) 74 ($check equal? ($fresh ($import-library! (#:only (mod-a) p q)) p) 1) 75 ($check equal? ($fresh ($import-library! (#:only (mod-a) p q)) q) 2) 76 ($check-error ($fresh ($import-library! (#:only (mod-a) p)) q)) 77 ($check-error ($fresh ($import-library! (#:only (mod-a) q)) p)) 78 ($check-error ($fresh ($import-library! (#:only (mod-a) r)))) 79 ($check-error ($fresh ($import-library! (#:only (mod-a) p p)))) 80 ($check-error ($fresh ($import-library! (#:only (mod-a) "p")))) 81 ($check-error ($fresh ($import-library! (#:only (mod-a) #:p)))) 82 ($check-error ($import-library! (#:only (mod-a)))) 83 84 ($check equal? ($fresh ($import-library! (#:except (mod-a) p)) q) 2) 85 ($check equal? ($fresh ($import-library! (#:except (mod-a) q)) p) 1) 86 ($check-error ($fresh ($import-library! (#:except (mod-a) p q)) p)) 87 ($check-error ($fresh ($import-library! (#:except (mod-a) p)) r)) 88 ($check-error ($fresh ($import-library! (#:except (mod-a) r)))) 89 ($check-error ($fresh ($import-library! (#:except (mod-a) p p)))) 90 ($check-error ($fresh ($import-library! (#:except (mod-a) "p")))) 91 ($check-error ($fresh ($import-library! (#:except (mod-a) #:p)))) 92 ($check-error ($import-library! (#:except (mod-a)))) 93 94 ($check equal? ($fresh ($import-library! (#:prefix (mod-a) a-)) a-p) 1) 95 ($check equal? ($fresh ($import-library! (#:prefix (mod-a) a-)) a-q) 2) 96 ($check-error ($fresh ($import-library! (#:prefix (mod-a) a-)) a-r)) 97 ($check-error ($fresh ($import-library! (#:prefix (mod-a) a-)) p)) 98 ($check-error ($fresh ($import-library! (#:prefix (mod-a) a-)) q)) 99 ($check-error ($fresh ($import-library! (#:prefix (mod-a) a- b-)))) 100 ($check-error ($fresh ($import-library! (#:prefix (mod-a) "a")))) 101 ($check-error ($fresh ($import-library! (#:prefix (mod-a) #:a)))) 102 ($check-error ($fresh ($import-library! (#:prefix (mod-a))))) 103 104 ($check equal? ($fresh ($import-library! (#:rename (mod-a) (p pp))) pp) 1) 105 ($check equal? ($fresh ($import-library! (#:rename (mod-a) (p pp))) q) 2) 106 ($check equal? ($fresh ($import-library! (#:rename (mod-a) (p q) (q p))) p) 2) 107 ($check equal? ($fresh ($import-library! (#:rename (mod-a) (p q) (q p))) q) 1) 108 ($check-error ($fresh ($import-library! (#:rename (mod-a) (p pp))) r)) 109 ($check-error ($fresh ($import-library! (#:rename (mod-a) (1 2))))) 110 ($check-error ($fresh ($import-library! (#:rename (mod-a) p)))) 111 ($check-error ($fresh ($import-library! (#:rename (mod-a))))) 112 ($check-error ($fresh ($import-library! (#:rename (mod-a) (p q))) r)) 113 114 ($check equal? ($fresh ($import-library! (#:only (mod-b 1 2 x) u)) u) 4) 115 ($check equal? ($fresh ($import-library! (#:only (mod-b 1 2 x) p)) p) 1) 116 ($check equal? ($fresh ($import-library! (#:only (mod-b 1 2 x) w)) w) 5) 117 ($check-error ($fresh ($import-library! (#:only (mod-b 1 2 x) v)))) 118 119 ($check equal? 120 ($fresh ($import-library! (#:only (mod-b 1 2 x) u) (#:only (mod-a) q)) q) 121 2) 122 123 ($check equal? 124 ($fresh 125 ($import-library! 126 (#:rename (#:rename (#:rename (mod-a) (p p1)) (p1 p2)) (p2 p3))) 127 p3) 128 1) 129 130 ($check equal? 131 ($fresh 132 ($import-library! (#:prefix (#:only (#:rename (mod-a) (q z)) z) p-)) 133 p-z) 134 2) 135 136 ($check equal? 137 ($fresh 138 ($import-library! (#:rename (#:except (mod-a) p) (q r))) 139 r) 140 2) 141 142 ($check-error ($import-library! ((mod-a)))) 143 ($check-error ($import-library! (#:only ((mod-a)) a))) 144 ($check-error ($import-library! (#:prefix bad prefix))) 145 ($check-error ($import-library! (#:replace (mod-a)))) 146 147 ($check-error ($import-library! (mod-a) (mod-d))) 148 ($check-no-error ($fresh ($import-library! (#:only (mod-a) p) (#:only (mod-d) q)))) 149 ($check-no-error ($fresh ($import-library! (#:only (mod-a) q) (#:only (mod-d) q)))) 150 151 ;; XXX library? make-library get-library-export-list get-library-environment 152 153 ($check-predicate 154 (applicative? 155 library? make-library get-library-export-list get-library-environment)) 156 157 ($check-predicate (library?)) 158 ($check-not-predicate (library? ())) 159 ($check-not-predicate (library? "x")) 160 161 ($check-predicate 162 (library? 163 ($get-registered-library (mod-a)) 164 ($get-registered-library (mod-b 1 2 x)) 165 ($get-registered-library (mod-c)))) 166 167 ($check equal? 168 (get-library-export-list ($get-registered-library (mod-a))) 169 ($quote (p q))) 170 ($check equal? 171 (get-library-export-list ($get-registered-library (mod-b 1 2 x))) 172 ($quote (p u w))) 173 ($check equal? 174 (get-library-export-list ($get-registered-library (mod-c))) 175 ()) 176 177 ($check equal? 178 ($let ((env (get-library-environment ($get-registered-library (mod-a))))) 179 (list 180 ($binds? env p) 181 ($binds? env q) 182 ($binds? env r) 183 ($binds? env $lambda))) 184 (list #t #t #f #f)) 185 186 ($check equal? 187 ($let ((m (make-library ()))) 188 (list 189 (library? m) 190 (null? (get-library-export-list m)) 191 (environment? (get-library-environment m)))) 192 (list #t #t #t)) 193 194 ($check equal? 195 ($let ((m (make-library (list (cons ($quote a) 1))))) 196 (list 197 (library? m) 198 (get-library-export-list m) 199 ($remote-eval a (get-library-environment m)))) 200 (list #t (list ($quote a)) 1)) 201 202 ($check-error 203 (make-library 204 (list 205 (list ($quote a) 1) 206 (list ($quote a) 2)))) 207 208 ;; XXX $registered-library? 209 210 ($check-predicate (operative? $registered-library?)) 211 ($check-predicate ($registered-library? (mod-a))) 212 ($check-predicate ($registered-library? (mod-b 1 2 x))) 213 ($check-predicate ($registered-library? (mod-c))) 214 ($check-predicate ($registered-library? (mod-d))) 215 ($check-predicate ($registered-library? (mod-e))) 216 ($check-not-predicate ($registered-library? (mod-f))) 217 ($check-error ($registered-library? "abc")) 218 ($check-error ($registered-library?)) 219 ($check-error ($registered-library? (mod-a) (mod-b))) 220 221 ;; XXX $get-registered-library 222 223 ($check-predicate (operative? $get-registered-library)) 224 ($check-no-error ($get-registered-library (mod-a))) 225 ($check-error ($get-registered-library (mod-f))) 226 ($check-error ($get-registered-library)) 227 ($check-error ($get-registered-library (mod-a) (mod-c))) 228 229 ;; $register-library! 230 231 ($check-predicate (operative? $register-library!)) 232 ($check-no-error 233 ($register-library! 234 (mod-z) (make-library (list (cons ($quote z) #:z))))) 235 ($check equal? 236 ($let ((m ($get-registered-library (mod-z)))) 237 (list 238 (library? m) 239 (get-library-export-list m) 240 ($remote-eval z (get-library-environment m)))) 241 (list #t (list ($quote z)) #:z)) 242 ($check equal? ($fresh ($import-library! (mod-z)) z) #:z) 243 244 ($check-error ($register-library! badname (make-library ()))) 245 ($check-error ($register-library! (mod-q) ())) 246 ($check-not-predicate ($registered-library? (mod-q))) 247 248 ;; XXX $unregister-library! 249 250 ($check-predicate (operative? $unregister-library!)) 251 ($check-no-error ($unregister-library! (mod-z))) 252 ($check-not-predicate ($registered-library? (mod-z))) 253 ($check-predicate ($registered-library? (mod-b 1 2 x))) 254 ($check-no-error ($unregister-library! (mod-b 1 2 x))) 255 ($check-not-predicate ($registered-library? (mod-z))) 256 ($check-not-predicate ($registered-library? (mod-b 1 2 x))) 257 ($check-error ($unregister-library! (mod-nonexistent))) 258 ($check-error ($unregister-library! badname)) 259 260 ;; cleanup - unregister remaining testing libraries 261 262 ($check-no-error ($unregister-library! (mod-a))) 263 ($check-no-error ($unregister-library! (mod-c))) 264 ($check-no-error ($unregister-library! (mod-d))) 265 ($check-no-error ($unregister-library! (mod-e)))