Fix for pr11535

collects/meta/props

@@ -1960,10 +1960,12 @@ path/s is either such a string or a list of them.
 "collects/tests/units/test-unit-contracts.rktl" drdr:command-line (racket "-f" *)
 "collects/tests/units/test-unit.rktl" drdr:command-line (racket "-f" *)
 "collects/tests/unstable" responsible (jay samth cce ryanc)
+"collects/tests/unstable/automata" responsible (jay)
 "collects/tests/unstable/byte-counting-port.rkt" responsible (jay)
 "collects/tests/unstable/generics.rkt" responsible (jay)
 "collects/tests/unstable/list.rkt" responsible (jay)
 "collects/tests/unstable/srcloc.rktl" responsible (cce) drdr:command-line (racket "-f" *)
+"collects/tests/unstable/temp-c" responsible (jay)
 "collects/tests/utils/gui.rkt" drdr:command-line (gracket-text "-t" *)
 "collects/tests/web-server" responsible (jay)
 "collects/tests/web-server/pr/length.rkt" drdr:command-line #f
@@ -2004,6 +2006,7 @@ path/s is either such a string or a list of them.
 "collects/typed-scheme" responsible (samth stamourv)
 "collects/typed-scheme/optimizer" responsible (stamourv)
 "collects/unstable" responsible (jay samth cce ryanc)
+"collects/unstable/automata" responsible (jay)
 "collects/unstable/byte-counting-port.rkt" responsible (jay)
 "collects/unstable/debug.rkt" responsible (samth)
 "collects/unstable/gui/language-level.rkt" drdr:command-line (gracket-text "-t" *)
@@ -2024,6 +2027,7 @@ path/s is either such a string or a list of them.
 "collects/unstable/scribblings/sequence.scrbl" responsible (samth)
 "collects/unstable/scribblings/utils.rkt" responsible (samth)
 "collects/unstable/sequence.rkt" responsible (samth)
+"collects/unstable/temp-c" responsible (jay)
 "collects/version" responsible (eli)
 "collects/version/tool.rkt" drdr:command-line (gracket-text "-t" *)
 "collects/waterworld/waterworld.rkt" drdr:command-line (mzc *)

collects/tests/typed-scheme/succeed/pr10552.rkt

@@ -0,0 +1,5 @@
+#lang typed-scheme
+
+(: z (All (A) (A -> ((Listof A) A -> (Listof A)))))
+(define (z _) (lambda (x y) (cons y x)))
+(define zz (z cons))

collects/tests/typed-scheme/succeed/pr11532.rkt

@@ -0,0 +1,4 @@
+#lang typed/racket
+(define-type T (All [X Y ...] String))
+(: f (All [A] (T -> Any)))
+(define f void)

collects/tests/typed-scheme/succeed/rackunit.rkt

@@ -2,6 +2,7 @@
 
 (require typed/rackunit)
 (: my-+ : Integer Integer -> Integer)
+
 (define (my-+ a b)
   (if (zero? a)
       b
@@ -13,6 +14,8 @@
       b
       (my-* (sub1 a) (my-+ b b))))
 
+(check-equal? (my-+ 1 1) 2 "Simple addition")
+
 (test-begin
  (check-equal? (my-+ 1 1) 2 "Simple addition")
  (check-equal? (my-* 2 2) 4 "Simple multiplication"))

collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt

@@ -190,6 +190,8 @@
         [tc-e/t '(2 3 4) (-lst* -PosByte -PosByte -PosByte)]
         [tc-e/t '(2 3 #t) (-lst* -PosByte -PosByte (-val #t))]
         [tc-e/t #(2 3 #t) (make-HeterogenousVector (list -Integer -Integer (-val #t)))]
+        [tc-e (vector 2 "3" #t) (make-HeterogenousVector (list -Integer -String (-val #t)))]
+        [tc-e (vector-immutable 2 "3" #t) (make-HeterogenousVector (list -Integer -String (-val #t)))]
         [tc-e/t '(#t #f) (-lst* (-val #t) (-val #f))]
         [tc-e/t (plambda: (a) ([l : (Listof a)]) (car l))
                 (make-Poly '(a) (t:-> (make-Listof (-v a)) (-v a)))]

collects/tests/unstable/automata/dfa-test.rkt

@@ -0,0 +1,23 @@
+#lang racket/base
+(require unstable/automata/dfa
+         unstable/automata/machine
+         tests/eli-tester)
+
+(define M
+  (dfa s1 (s1 s3)
+       [s1 ([0 s2]
+            [1 s1])]
+       [s2 ([0 s1]
+            [1 s2])]
+       [s3 ([0 s3]
+            [1 s4])]
+       [s4 ([0 s4]
+            [1 s3])]))
+
+(test
+ (machine-accepts? M (list 1 0 1 0 1))
+ (machine-accepts? M (list 0 1 0 1 0)) => #f
+ (machine-accepts? M (list 1 0 1 1 0 1))
+ (machine-accepts? M (list 0 1 0 0 1 0))
+ (machine-accepts? M (list))
+ (machine-accepts? M (list 1 0)) => #f)

collects/tests/unstable/automata/explain.rkt

@@ -0,0 +1,11 @@
+#lang racket
+(require unstable/automata/re
+         unstable/automata/re-ext
+         unstable/automata/machine
+         unstable/match
+         tests/eli-tester)
+
+(define r (re (seq 1 2 3)))
+(define r0 (r 1))
+(machine-accepting? (r0 1))
+(machine-explain r0)

collects/tests/unstable/automata/nfa-ep-test.rkt

@@ -0,0 +1,25 @@
+#lang racket/base
+(require unstable/automata/nfa-ep
+         unstable/automata/machine
+         tests/eli-tester)
+
+(define M
+  (nfa/ep (s0) (s1 s3)
+       [s0 ([epsilon (s1)]
+            [epsilon (s3)])]
+       [s1 ([0 (s2)]
+            [1 (s1)])]
+       [s2 ([0 (s1)]
+            [1 (s2)])]
+       [s3 ([0 (s3)]
+            [1 (s4)])]
+       [s4 ([0 (s4)]
+            [1 (s3)])]))
+
+(test
+ (machine-accepts? M (list 1 0 1 0 1))
+ (machine-accepts? M (list 0 1 0 1 0))
+ (machine-accepts? M (list 1 0 1 1 0 1))
+ (machine-accepts? M (list 0 1 0 0 1 0))
+ (machine-accepts? M (list))
+ (machine-accepts? M (list 1 0)) => #f)

collects/tests/unstable/automata/nfa-star-test.rkt

@@ -0,0 +1,26 @@
+#lang racket/base
+(require unstable/automata/nfa-star
+         unstable/automata/machine
+         tests/eli-tester)
+
+(define M
+  (nfa*
+   (s0)
+   ([s1 ([0 (s2)]
+         [1 (s1)])]
+    [s3 ([0 (s3)]
+         [1 (s4)])])
+   ([s0 ([epsilon (s1)]
+         [epsilon (s3)])]
+    [s2 ([0 (s1)]
+         [1 (s2)])]
+    [s4 ([0 (s4)]
+         [1 (s3)])])))
+
+(test
+ (machine-accepts? M (list 1 0 1 0 1))
+ (machine-accepts? M (list 0 1 0 1 0))
+ (machine-accepts? M (list 1 0 1 1 0 1))
+ (machine-accepts? M (list 0 1 0 0 1 0))
+ (machine-accepts? M (list))
+ (machine-accepts? M (list 1 0)) => #f)

collects/tests/unstable/automata/nfa-test.rkt

@@ -0,0 +1,23 @@
+#lang racket/base
+(require unstable/automata/nfa
+         unstable/automata/machine
+         tests/eli-tester)
+
+(define M
+  (nfa (s1 s3) (s1 s3)
+       [s1 ([0 (s2)]
+            [1 (s1)])]
+       [s2 ([0 (s1)]
+            [1 (s2)])]
+       [s3 ([0 (s3)]
+            [1 (s4)])]
+       [s4 ([0 (s4)]
+            [1 (s3)])]))
+
+(test
+ (machine-accepts? M (list 1 0 1 0 1))
+ (machine-accepts? M (list 0 1 0 1 0))
+ (machine-accepts? M (list 1 0 1 1 0 1))
+ (machine-accepts? M (list 0 1 0 0 1 0))
+ (machine-accepts? M (list))
+ (machine-accepts? M (list 1 0)) => #f)

collects/tests/unstable/automata/re-test.rkt

@@ -0,0 +1,155 @@
+#lang racket
+(require unstable/automata/machine
+         unstable/automata/re
+         unstable/automata/re-ext
+         unstable/match
+         tests/eli-tester)
+
+(define-syntax-rule (test-re* R (succ ...) (fail ...))
+  (let ()
+    (define r (re R))
+    (test #:failure-prefix (format "~s" 'R)
+          (test
+           (machine-accepts? r succ) ...
+           (not (machine-accepts? r fail)) ...))))
+(define-syntax-rule (test-re R (succ ...) (fail ...))
+  (test (test-re* R (succ ...) (fail ...))
+        (test-re* (complement R) (fail ...) (succ ...))))
+
+(test
+ (test-re epsilon
+          [(list)]
+          [(list 0)])
+
+ (test-re nullset
+          []
+          [(list) (list 1)])
+
+ (test-re "A"
+          [(list "A")]
+          [(list)
+           (list "B")])
+
+ (test-re (complement "A")
+          [(list)
+           (list "B")
+           (list "A" "A")]
+          [(list "A")])
+
+ (test-re (union 0 1)
+          [(list 1)
+           (list 0)]
+          [(list)
+           (list 0 1)
+           (list 0 1 1)])
+
+ (test-re (seq 0 1)
+          [(list 0 1)]
+          [(list)
+           (list 0)
+           (list 0 1 1)])
+
+ (test-re (star 0)
+          [(list)
+           (list 0)
+           (list 0 0)]
+          [(list 1)])
+
+ (test-re (opt "A")
+          [(list)
+           (list "A")]
+          [(list "B")])
+
+ (test-re (plus "A")
+          [(list "A")
+           (list "A" "A")]
+          [(list)])
+
+ (test-re (rep "A" 3)
+          [(list "A" "A" "A")]
+          [(list)
+           (list "A")
+           (list "A" "A")])
+
+ (test-re (difference (? even?) 2)
+          [(list 4)
+           (list 6)]
+          [(list 3)
+           (list 2)])
+
+ (test-re (intersection (? even?) 2)
+          [(list 2)]
+          [(list 1)
+           (list 4)])
+
+ (test-re (complement (seq "A" (opt "B")))
+          [(list "A" "B" "C")]
+          [(list "A")
+           (list "A" "B")])
+
+ (test-re (seq epsilon 1)
+          [(list 1)]
+          [(list 0)
+           (list)])
+
+ (test-re (seq 1 epsilon)
+          [(list 1)]
+          [(list 0)
+           (list)])
+
+ (test-re (seq epsilon
+               (union (seq (star 1) (star (seq 0 (star 1) 0 (star 1))))
+                      (seq (star 0) (star (seq 1 (star 0) 1 (star 0)))))
+               epsilon)
+          [(list 1 0 1 0 1)
+           (list 0 1 0 1 0)
+           (list 1 0 1 1 0 1)
+           (list 0 1 0 0 1 0)
+           (list)]
+          [(list 1 0)])
+
+ (test-re (star (complement 1))
+          [(list 0 2 3 4)
+           (list)
+           (list 2)
+           ; This is correct, because the complement machine
+           ; could accept '(234 5 9 1), which is not '(1)
+           ; Then the star kicks in and it accepts '(9 0)
+           (list 234 5 9 1 9 0)
+           (list 1 0)
+           (list 0 1)]
+          [(list 1)])
+
+ (test-re (dseq x (== x))
+          [(list 0 0)
+           (list 1 1)]
+          [(list)
+           (list 1)
+           (list 1 0)])
+
+ (test-re (seq 1 (seq 2 3))
+          [(list 1 2 3)]
+          [(list 1)
+           (list 1 2)])
+
+ (test-re (rec x
+            (union #f
+                   (seq 1 ,x)))
+          [(list #f)
+           (list 1 #f)
+           (list 1 1 #f)
+           (list 1 1 1 #f)]
+          [(list 1)
+           (list 2)
+           (list 1 1 2)])
+
+ (test-re (seq/close 1 2 3)
+          [(list)
+           (list 1)
+           (list 1 2)
+           (list 1 2 3)]
+          [(list 2)
+           (list 1 3)
+           (list 2 3)
+           (list 1 2 3 4)])
+ )