diff --git a/collects/scheme/private/contract-arrow.ss b/collects/scheme/private/contract-arrow.ss
index fcda331ffa..ed9a29eda4 100644
--- a/collects/scheme/private/contract-arrow.ss
+++ b/collects/scheme/private/contract-arrow.ss
@@ -924,10 +924,11 @@ v4 todo:
                         (cond
                           [(and rng
                                 (not (and first-mark
-                                          (eq? this->d-id first-mark))))
+                                          (eq? this->d-id (car first-mark))
+                                          (andmap eq? raw-orig-args (cdr first-mark)))))
                            (call-with-values
                             (λ ()
-                              (with-continuation-mark ->d-tail-key this->d-id
+                              (with-continuation-mark ->d-tail-key (cons this->d-id raw-orig-args)
                                 (thunk)))
                             (λ orig-results
                               (let* ([range-count (length rng)]
diff --git a/collects/tests/mzscheme/contract-test.ss b/collects/tests/mzscheme/contract-test.ss
index fc83a58021..d262306d9f 100644
--- a/collects/tests/mzscheme/contract-test.ss
+++ b/collects/tests/mzscheme/contract-test.ss
@@ -5243,8 +5243,10 @@ so that propagation occurs.
            (c)))
   
   
-  (ctest 2
-         'tail-arrow-d1
+  ;; this one is not tail recursive, since the contract system
+  ;; cannot tell that the range contract doesn't depend on 'arg'
+  (ctest 8
+         'tail-arrow-d1/changing-args
          (let ([c (counter)])
            (letrec ([f 
                      (contract (->d ([arg any/c]) () (values [_ c] [_ c]))
@@ -5254,8 +5256,22 @@ so that propagation occurs.
              (f 3))
            (c)))
   
-  (ctest 1
-         'tail-arrow-d2
+  (ctest 2
+         'tail-arrow-d1
+         (let ([c (counter)])
+           (letrec ([x 5]
+                    [f 
+                     (contract (->d ([arg any/c]) () (values [_ c] [_ c]))
+                               (λ (_ignored) (if (zero? x) (values x x) (begin (set! x (- x 1)) (f _ignored))))
+                               'pos
+                               'neg)])
+             (f 'ignored))
+           (c)))
+  
+  
+  ;; this one is just like the one two above.
+  (ctest 4
+         'tail-arrow-d2/changing-args
          (let ([c (counter)])
            (letrec ([f 
                      (contract (->d ([arg any/c]) () [rng c])
@@ -5265,6 +5281,18 @@ so that propagation occurs.
              (f 3))
            (c)))
   
+  (ctest 1
+         'tail-arrow-d2
+         (let ([c (counter)])
+           (letrec ([x 3]
+                    [f 
+                     (contract (->d ([arg any/c]) () [rng c])
+                               (λ (ignored) (if (zero? x) x (begin (set! x (- x 1)) (f ignored))))
+                               'pos
+                               'neg)])
+             (f 3))
+           (c)))
+  
   ;; the tail-call optimization cannot handle two different
   ;; contracts on the stack one after the other one, so this
   ;; returns '(4 4) instead of '(1 1) (which would indicate
@@ -5344,6 +5372,18 @@ so that propagation occurs.
            
            (f 3)))
   
+  (test/pos-blame 'free-vars-change-so-cannot-drop-the-check
+                  '(let ()
+                     (define f
+                       (contract (->d ([x number?]) () [_ (</c x)])
+                                 (lambda (x)
+                                   (cond
+                                     [(= x 0) 1]
+                                     [else (f 0)]))
+                                 'pos
+                                 'neg))
+                     (f 10)))
+  
 ;                                                                
 ;                                                                
 ;