1 files changed, 96 insertions, 94 deletions
diff --git a/new-luxc/test/test/luxc/analyser/case.lux b/new-luxc/test/test/luxc/analyser/case.lux
index e19ac3a0a..27cc9f6ae 100644
--- a/new-luxc/test/test/luxc/analyser/case.lux
+++ b/new-luxc/test/test/luxc/analyser/case.lux
@@ -129,97 +129,99 @@
 (context: "Pattern-matching."
   ## #seed +9253409297339902486
   ## #seed +3793366152923578600
-  #seed +5004137551292836565
-  [module-name (r;text +5)
-   variant-name (r;text +5)
-   record-name (|> (r;text +5) (r;filter (|>. (T/= variant-name) not)))
-   size (|> r;nat (:: @ map (|>. (n.% +10) (n.max +2))))
-   variant-tags (|> (r;set text;Hash<Text> size (r;text +5)) (:: @ map S;to-list))
-   record-tags (|> (r;set text;Hash<Text> size (r;text +5)) (:: @ map S;to-list))
-   primitivesTC (r;list size gen-primitive)
-   #let [primitivesT (L/map product;left primitivesTC)
-         primitivesC (L/map product;right primitivesTC)
-         variant-tags+ (L/map (|>. [module-name] code;tag) variant-tags)
-         record-tags+ (L/map (|>. [module-name] code;tag) record-tags)
-         variantTC (list;zip2 variant-tags+ primitivesC)]
-   inputC (input variant-tags+ record-tags+ primitivesC)
-   [outputT outputC] gen-primitive
-   [heterogeneousT heterogeneousC] (|> gen-primitive
-                                       (r;filter (|>. product;left (tc;checks? outputT) not)))
-   exhaustive-patterns (exhaustive-branches true variantTC inputC)
-   redundant-patterns (exhaustive-branches false variantTC inputC)
-   redundancy-idx (|> r;nat (:: @ map (n.% (list;size redundant-patterns))))
-   heterogeneous-idx (|> r;nat (:: @ map (n.% (list;size exhaustive-patterns))))
-   #let [exhaustive-branchesC (L/map (branch outputC)
-                                     exhaustive-patterns)
-         non-exhaustive-branchesC (list;take (n.dec (list;size exhaustive-branchesC))
-                                             exhaustive-branchesC)
-         redundant-branchesC (<| (L/map (branch outputC))
-                                 list;concat
-                                 (list (list;take redundancy-idx redundant-patterns)
-                                       (list (maybe;assume (list;nth redundancy-idx redundant-patterns)))
-                                       (list;drop redundancy-idx redundant-patterns)))
-         heterogeneous-branchesC (list;concat (list (list;take heterogeneous-idx exhaustive-branchesC)
-                                                    (list (let [[_pattern _body] (maybe;assume (list;nth heterogeneous-idx exhaustive-branchesC))]
-                                                            [_pattern heterogeneousC]))
-                                                    (list;drop (n.inc heterogeneous-idx) exhaustive-branchesC)))
-         ]]
-  ($_ seq
-      (test "Will reject empty pattern-matching (no branches)."
-            (|> (&;with-scope
-                  (&;with-expected-type outputT
-                    (@;analyse-case analyse inputC (list))))
-                check-failure))
-      (test "Can analyse exhaustive pattern-matching."
-            (|> (@module;with-module +0 module-name
-                  (do Monad<Meta>
-                    [_ (@module;declare-tags variant-tags false
-                                             (#;Named [module-name variant-name]
-                                                      (type;variant primitivesT)))
-                     _ (@module;declare-tags record-tags false
-                                             (#;Named [module-name record-name]
-                                                      (type;tuple primitivesT)))]
-                    (&;with-scope
-                      (&;with-expected-type outputT
-                        (@;analyse-case analyse inputC exhaustive-branchesC)))))
-                check-success))
-      (test "Will reject non-exhaustive pattern-matching."
-            (|> (@module;with-module +0 module-name
-                  (do Monad<Meta>
-                    [_ (@module;declare-tags variant-tags false
-                                             (#;Named [module-name variant-name]
-                                                      (type;variant primitivesT)))
-                     _ (@module;declare-tags record-tags false
-                                             (#;Named [module-name record-name]
-                                                      (type;tuple primitivesT)))]
-                    (&;with-scope
-                      (&;with-expected-type outputT
-                        (@;analyse-case analyse inputC non-exhaustive-branchesC)))))
-                check-failure))
-      (test "Will reject redundant pattern-matching."
-            (|> (@module;with-module +0 module-name
-                  (do Monad<Meta>
-                    [_ (@module;declare-tags variant-tags false
-                                             (#;Named [module-name variant-name]
-                                                      (type;variant primitivesT)))
-                     _ (@module;declare-tags record-tags false
-                                             (#;Named [module-name record-name]
-                                                      (type;tuple primitivesT)))]
-                    (&;with-scope
-                      (&;with-expected-type outputT
-                        (@;analyse-case analyse inputC redundant-branchesC)))))
-                check-failure))
-      (test "Will reject pattern-matching if the bodies of the branches do not all have the same type."
-            (|> (@module;with-module +0 module-name
-                  (do Monad<Meta>
-                    [_ (@module;declare-tags variant-tags false
-                                             (#;Named [module-name variant-name]
-                                                      (type;variant primitivesT)))
-                     _ (@module;declare-tags record-tags false
-                                             (#;Named [module-name record-name]
-                                                      (type;tuple primitivesT)))]
-                    (&;with-scope
-                      (&;with-expected-type outputT
-                        (@;analyse-case analyse inputC heterogeneous-branchesC)))))
-                check-failure))
-      ))
+  (<| (seed +5004137551292836565)
+      ## (times +100)
+      (do @
+        [module-name (r;text +5)
+         variant-name (r;text +5)
+         record-name (|> (r;text +5) (r;filter (|>. (T/= variant-name) not)))
+         size (|> r;nat (:: @ map (|>. (n.% +10) (n.max +2))))
+         variant-tags (|> (r;set text;Hash<Text> size (r;text +5)) (:: @ map S;to-list))
+         record-tags (|> (r;set text;Hash<Text> size (r;text +5)) (:: @ map S;to-list))
+         primitivesTC (r;list size gen-primitive)
+         #let [primitivesT (L/map product;left primitivesTC)
+               primitivesC (L/map product;right primitivesTC)
+               variant-tags+ (L/map (|>. [module-name] code;tag) variant-tags)
+               record-tags+ (L/map (|>. [module-name] code;tag) record-tags)
+               variantTC (list;zip2 variant-tags+ primitivesC)]
+         inputC (input variant-tags+ record-tags+ primitivesC)
+         [outputT outputC] gen-primitive
+         [heterogeneousT heterogeneousC] (|> gen-primitive
+                                             (r;filter (|>. product;left (tc;checks? outputT) not)))
+         exhaustive-patterns (exhaustive-branches true variantTC inputC)
+         redundant-patterns (exhaustive-branches false variantTC inputC)
+         redundancy-idx (|> r;nat (:: @ map (n.% (list;size redundant-patterns))))
+         heterogeneous-idx (|> r;nat (:: @ map (n.% (list;size exhaustive-patterns))))
+         #let [exhaustive-branchesC (L/map (branch outputC)
+                                           exhaustive-patterns)
+               non-exhaustive-branchesC (list;take (n.dec (list;size exhaustive-branchesC))
+                                                   exhaustive-branchesC)
+               redundant-branchesC (<| (L/map (branch outputC))
+                                       list;concat
+                                       (list (list;take redundancy-idx redundant-patterns)
+                                             (list (maybe;assume (list;nth redundancy-idx redundant-patterns)))
+                                             (list;drop redundancy-idx redundant-patterns)))
+               heterogeneous-branchesC (list;concat (list (list;take heterogeneous-idx exhaustive-branchesC)
+                                                          (list (let [[_pattern _body] (maybe;assume (list;nth heterogeneous-idx exhaustive-branchesC))]
+                                                                  [_pattern heterogeneousC]))
+                                                          (list;drop (n.inc heterogeneous-idx) exhaustive-branchesC)))
+               ]]
+        ($_ seq
+            (test "Will reject empty pattern-matching (no branches)."
+                  (|> (&;with-scope
+                        (&;with-expected-type outputT
+                          (@;analyse-case analyse inputC (list))))
+                      check-failure))
+            (test "Can analyse exhaustive pattern-matching."
+                  (|> (@module;with-module +0 module-name
+                        (do Monad<Meta>
+                          [_ (@module;declare-tags variant-tags false
+                                                   (#;Named [module-name variant-name]
+                                                            (type;variant primitivesT)))
+                           _ (@module;declare-tags record-tags false
+                                                   (#;Named [module-name record-name]
+                                                            (type;tuple primitivesT)))]
+                          (&;with-scope
+                            (&;with-expected-type outputT
+                              (@;analyse-case analyse inputC exhaustive-branchesC)))))
+                      check-success))
+            (test "Will reject non-exhaustive pattern-matching."
+                  (|> (@module;with-module +0 module-name
+                        (do Monad<Meta>
+                          [_ (@module;declare-tags variant-tags false
+                                                   (#;Named [module-name variant-name]
+                                                            (type;variant primitivesT)))
+                           _ (@module;declare-tags record-tags false
+                                                   (#;Named [module-name record-name]
+                                                            (type;tuple primitivesT)))]
+                          (&;with-scope
+                            (&;with-expected-type outputT
+                              (@;analyse-case analyse inputC non-exhaustive-branchesC)))))
+                      check-failure))
+            (test "Will reject redundant pattern-matching."
+                  (|> (@module;with-module +0 module-name
+                        (do Monad<Meta>
+                          [_ (@module;declare-tags variant-tags false
+                                                   (#;Named [module-name variant-name]
+                                                            (type;variant primitivesT)))
+                           _ (@module;declare-tags record-tags false
+                                                   (#;Named [module-name record-name]
+                                                            (type;tuple primitivesT)))]
+                          (&;with-scope
+                            (&;with-expected-type outputT
+                              (@;analyse-case analyse inputC redundant-branchesC)))))
+                      check-failure))
+            (test "Will reject pattern-matching if the bodies of the branches do not all have the same type."
+                  (|> (@module;with-module +0 module-name
+                        (do Monad<Meta>
+                          [_ (@module;declare-tags variant-tags false
+                                                   (#;Named [module-name variant-name]
+                                                            (type;variant primitivesT)))
+                           _ (@module;declare-tags record-tags false
+                                                   (#;Named [module-name record-name]
+                                                            (type;tuple primitivesT)))]
+                          (&;with-scope
+                            (&;with-expected-type outputT
+                              (@;analyse-case analyse inputC heterogeneous-branchesC)))))
+                      check-failure))
+            ))))