~ chicken-core (chicken-5) /tests/scrutiny-tests-3.scm

 1;;;; scrutiny-tests-3.scm - scrutinizer-tests, compiled in block mode and executed
 2
 3
 4;;; ensure implicit global type-declarations are "smashed" (i.e. have
 5;;; their component types invalidated, due to possible mutation)
 6
 7(define vec (make-vector 10 #f))
 8(vector-set! vec 0 99)
 9(assert
10 (compiler-typecase vec
11   ((vector-of boolean) #f)
12   (vector #t)))
13
14
15;;; reduce OR-types in alternative branch of conditional with predicate
16
17(define something)
18
19(let ((x (the (or string number) something)))
20  (if (number? x)
21      (compiler-typecase x
22	(number 1))
23      (compiler-typecase x
24	(string 2))))
25
26(let ((x (the (or string number) something)))
27  (if (fixnum? x)
28      (compiler-typecase x
29	(fixnum 1))
30      (compiler-typecase x
31	((or string number) 2))))
32
33(let ((x (the (forall ((a string) (b number)) (or a b)) something)))
34  (if (number? x)
35      (compiler-typecase x
36	(number 3))
37      (compiler-typecase x
38	(string 4))))
39
40
41;;; #1399 incorrect return type after merge with noreturn procedure
42
43(let ((x (the (->) something))
44      (y (the (-> noreturn) something)))
45  (compiler-typecase (if something x y)
46    ((->) (error "#1399 regression test failure"))
47    (else 'ok)))