diff --git a/collects/racket/contract/private/misc.rkt b/collects/racket/contract/private/misc.rkt
index c53ee946dc..9d7145c994 100644
--- a/collects/racket/contract/private/misc.rkt
+++ b/collects/racket/contract/private/misc.rkt
@@ -629,75 +629,82 @@
 (define/subexpression-pos-prop (cons/c a b) (cons/c-main-function a b))
 
 (define/subexpression-pos-prop (list/c . args)
-  (let* ([args (coerce-contracts 'list/c args)])
-    (if (andmap flat-contract? args)
-      (flat-list/c args)
-      (higher-order-list/c args))))
+  (define ctc-args (coerce-contracts 'list/c args))
+  (cond
+    [(andmap flat-contract? ctc-args)
+     (flat-list/c ctc-args)]
+    [(andmap chaperone-contract? ctc-args)
+     (chaperone-list/c ctc-args)]
+    [else
+     (higher-order-list/c ctc-args)]))
 
-(struct flat-list/c [args]
-        #:property prop:flat-contract
-        (build-flat-contract-property
-         #:name
-         (lambda (c)
-           (apply build-compound-type-name
-             'list/c (flat-list/c-args c)))
-         #:first-order
-         (lambda (c)
-           (lambda (x)
-             (and (list? x)
-                  (= (length x) (length (flat-list/c-args c)))
-                  (for/and ([arg/c (in-list (flat-list/c-args c))]
-                            [v (in-list x)])
-                    (arg/c v)))))
-         #:projection
-         (lambda (c)
-           (lambda (b)
-             (lambda (x)
-               (unless (list? x)
-                 (raise-blame-error b x "expected a list, got: ~e" x))
-               (let* ([args (flat-list/c-args c)]
-                      [expected (length args)]
-                      [actual (length x)])
-                 (unless (= actual expected)
-                   (raise-blame-error
-                    b x
-                    "expected a list of ~a elements, but got ~a elements in: ~e"
-                    expected actual x))
-                 (for ([arg/c (in-list args)] [v (in-list x)])
-                   (((contract-projection arg/c) b) v))
-                 x))))))
+(define (list/c-name-proc c) 
+  (apply build-compound-type-name
+         'list/c (generic-list/c-args c)))
+(define ((list/c-first-order c) x)
+  (and (list? x)
+       (= (length x) (length (generic-list/c-args c)))
+       (for/and ([arg/c (in-list (generic-list/c-args c))]
+                 [v (in-list x)])
+         (arg/c v))))
 
-(struct higher-order-list/c [args]
-        #:property prop:contract
-        (build-contract-property
-         #:name
-         (lambda (c)
-           (apply build-compound-type-name
-             'list/c (higher-order-list/c-args c)))
-         #:first-order
-         (lambda (c)
-           (lambda (x)
-             (and (list? x)
-                  (= (length x) (length (higher-order-list/c-args c)))
-                  (for/and ([arg/c (in-list (higher-order-list/c-args c))]
-                            [v (in-list x)])
-                    (contract-first-order-passes? arg/c v)))))
-         #:projection
-         (lambda (c)
-           (lambda (b)
-             (lambda (x)
-               (unless (list? x)
-                 (raise-blame-error b x "expected a list, got: ~e" x))
-               (let* ([args (higher-order-list/c-args c)]
-                      [expected (length args)]
-                      [actual (length x)])
-                 (unless (= actual expected)
-                   (raise-blame-error
-                    b x
-                    "expected a list of ~a elements, but got ~a elements in: ~e"
-                    expected actual x))
-                 (for/list ([arg/c (in-list args)] [v (in-list x)])
-                   (((contract-projection arg/c) b) v))))))))
+(struct generic-list/c (args))
+
+(struct flat-list/c generic-list/c ()
+  #:property prop:flat-contract
+  (build-flat-contract-property
+   #:name list/c-name-proc
+   #:first-order list/c-first-order
+   #:projection
+   (lambda (c)
+     (lambda (b)
+       (lambda (x)
+         (unless (list? x)
+           (raise-blame-error b x "expected a list, got: ~e" x))
+         (let* ([args (generic-list/c-args c)]
+                [expected (length args)]
+                [actual (length x)])
+           (unless (= actual expected)
+             (raise-blame-error
+              b x
+              "expected a list of ~a elements, but got ~a elements in: ~e"
+              expected actual x))
+           (for ([arg/c (in-list args)] [v (in-list x)])
+             (((contract-projection arg/c) b) v))
+           x))))))
+
+(define (list/c-chaperone/other-projection c)
+  (define args (map contract-projection (generic-list/c-args c)))
+  (define expected (length args))
+  (λ (b)
+    (define projs (for/list ([arg/c (in-list args)])
+                    (arg/c b)))
+    (λ (x)
+      (unless (list? x)
+        (raise-blame-error b x "expected a list, got: ~e" x))
+      (define actual (length x))
+      (unless (= actual expected)
+        (raise-blame-error
+         b x
+         "expected a list of ~a elements, but got ~a elements in: ~e"
+         expected actual x))
+      (for/list ([item (in-list x)]
+                 [proj (in-list projs)])
+        (proj item)))))
+
+(struct chaperone-list/c generic-list/c ()
+  #:property prop:chaperone-contract
+  (build-chaperone-contract-property
+   #:name list/c-name-proc
+   #:first-order list/c-first-order
+   #:projection list/c-chaperone/other-projection))
+
+(struct higher-order-list/c generic-list/c ()
+  #:property prop:contract
+  (build-contract-property
+   #:name list/c-name-proc
+   #:first-order list/c-first-order
+   #:projection list/c-chaperone/other-projection))
 
 (define/subexpression-pos-prop (syntax/c ctc-in)
   (let ([ctc (coerce-contract 'syntax/c ctc-in)])
diff --git a/collects/tests/racket/contract-test.rktl b/collects/tests/racket/contract-test.rktl
index 394194f99d..84786f443a 100644
--- a/collects/tests/racket/contract-test.rktl
+++ b/collects/tests/racket/contract-test.rktl
@@ -9460,6 +9460,9 @@ so that propagation occurs.
   (ctest #f flat-contract? (set/c (-> integer? integer?)))
   (ctest #t chaperone-contract? (set/c (-> integer? integer?)))
   
+  (ctest #t flat-contract? (list/c integer?))
+  (ctest #t chaperone-contract? (list/c (-> integer? integer?)))
+  
   ;; Make sure that impersonators cannot be used as the element contract in set/c.
   (contract-error-test
    'contract-error-test-set