diff --git a/src/tests/normal-tests/compiler.lsp b/src/tests/normal-tests/compiler.lsp
index af6fb895b..913438c0c 100644
--- a/src/tests/normal-tests/compiler.lsp
+++ b/src/tests/normal-tests/compiler.lsp
@@ -2664,3 +2664,65 @@
   (is (typep (cons 1 2) '(cons integer integer)))
   (is (not (typep (cons 1 2) '(cons integer float))))
   (is (typep (list 1 2 3) '(cons integer t))))
+
+;;; These tests are curbed from ANSI-TEST and revealed a regression.
+(deftest cmp.0116.subtypep-cons.ansi-test ()
+  ;; SUBTYPEP.CONS.5
+  (is-subtypep (t t)
+               (and cons (not (cons symbol symbol)))
+               (or (cons (not symbol) *)
+                   (cons * (not symbol))))
+  ;; SUBTYPEP.CONS.12 (test suggested by C.R) - this one is mean!
+  (is-subtypep (nil t)
+               (cons (or integer symbol)
+                     (or integer symbol))
+               (or (cons integer symbol)
+                   (cons symbol integer)))
+  ;; SUBTYPEP.CONS.14 (a -> b, a ==> b)
+  (is-subtypep (t t)
+               (and (or (cons (not symbol)) (cons * integer))
+                    (cons symbol))
+               (cons * integer))
+  ;; SUBTYPEP.CONS.15 (a -> b, not b ==> not a)
+  (is-subtypep (t t)
+               (and (or (cons (not symbol)) (cons * integer))
+                    (cons * (not integer)))
+               (cons (not symbol)))
+  ;; SUBTYPEP.CONS.17
+  (is-subtypep (t t)
+               (and (or (cons symbol (cons * *))
+                        (cons * (cons integer *)))
+                    (or (cons * (cons (not integer)))
+                        (cons * (cons * float)))
+                    (or (cons * (cons * (not float)))
+                        (cons symbol (cons * *))))
+               (cons symbol))
+  ;; SUBTYPEP.CONS.20
+  (is-subtypep (t t)
+               (or (cons (eql a) (eql x))
+                   (cons (eql b) (eql y))
+                   (cons (eql a) (eql y))
+                   (cons (eql b) (eql z))
+                   (cons (eql c) (eql x))
+                   (cons (eql a) (eql z))
+                   (cons (eql b) (eql x))
+                   (cons (eql c) (eql y)))
+               (and (cons (member a b c) (member x y z))
+                    (not (cons (eql c) (eql z)))))
+  ;; SUBTYPEP.CONS.32
+  (let ((t2 '(cons t
+                   (or (not (cons integer            (eql 0)))
+                       (not (cons (or float (eql 0)) cons))))))
+    (is (eql (subtypep 'cons t2)
+             (subtypep `(not ,t2) '(not cons))))
+    ;; These two were derived while testing (not really in ansi-test).
+    (is (not (subtypep 'cons t2)))
+    (is (subtypep t2 'cons)))
+  ;; Despite sharing leafs, some lists may not be EQL. This is the defining
+  ;; specimen of all MEMBER-related regressions.
+  (let ((l1 (list 1 2 3))
+        (l2 (list 1 2 3)))
+    (multiple-value-bind (yes sure)
+        (subtypep `(eql ,l1) `(eql ,l2))
+      (is (and (null yes) sure)
+          "EQL types of freshly consed lists are SUBTYPEP to each other."))))