diff --git a/collects/redex/private/reduction-semantics.ss b/collects/redex/private/reduction-semantics.ss
index c9ffa0356c..e31b86a443 100644
--- a/collects/redex/private/reduction-semantics.ss
+++ b/collects/redex/private/reduction-semantics.ss
@@ -1730,18 +1730,19 @@
 
 (define (apply-reduction-relation*/cycle? reductions exp)
   (let ([answers (make-hash)]
-        [cycle? #f]
-        [cycles (make-hash)])
-    (let loop ([exp exp])
+        [cycle? #f])
+    (let loop ([exp exp]
+               [path (make-immutable-hash '())])
       (cond
-        [(hash-ref cycles exp #f)
+        [(hash-ref path exp #f)
          (set! cycle? #t)]
         [else
-         (hash-set! cycles exp #t)
          (let ([nexts (apply-reduction-relation reductions exp)])
            (cond
              [(null? nexts) (hash-set! answers exp #t)]
-             [else (for-each loop nexts)]))]))
+             [else (for-each 
+                    (λ (next) (loop next (hash-set path exp #t)))
+                    nexts)]))]))
     (values (sort (hash-map answers (λ (x y) x))
                   string<=?
                   #:key (λ (x) (format "~s" x)))
@@ -1849,9 +1850,13 @@
     [(= tests 0)
      (printf "No tests run.\n")]
     [(= test-failures 0)
-     (if (= tests 1)
-         (printf "One test passed.\n")
-         (printf "All ~a tests passed.\n" tests))]
+     (cond
+       [(= tests 1)
+        (printf "One test passed.\n")]
+       [(= tests 2)
+        (printf "Both tests passed.\n")]
+       [else
+        (printf "All ~a tests passed.\n" tests)])]
     [else
      (printf "~a test~a failed (out of ~a total).\n"
              test-failures
diff --git a/collects/redex/private/tl-test.ss b/collects/redex/private/tl-test.ss
index 1846e4be8d..99ec2b0503 100644
--- a/collects/redex/private/tl-test.ss
+++ b/collects/redex/private/tl-test.ss
@@ -1393,4 +1393,57 @@
       (test (sort (covered-cases c) <)
             '(("shortcut" . 1) ("side-condition" . 2) ("unnamed" . 1)))))
   
+  
+;                                                                       
+;                                                                       
+;                                                                       
+;                                                                       
+;                                                 ;;;                   
+;   ;;                ;;           ;             ;; ;;                  
+;   ;;                ;;            ;            ;; ;;                  
+;  ;;;;;  ;;;    ;;; ;;;;;           ;;           ;;;      ;;;;   ;;;;  
+;   ;;   ;; ;;  ;; ;  ;;  ;;;;;;;;     ;;        ;;;      ;; ;   ;;  ;; 
+;   ;;   ;;;;;  ;;;   ;;              ;;;       ;;  ;  ;; ;;     ;;  ;; 
+;   ;;   ;;       ;;  ;;            ;;;         ;;  ;;;;  ;;     ;;  ;; 
+;   ;;   ;;  ;  ; ;;  ;;           ;;           ;;   ;;   ;; ;   ;;  ;; 
+;   ;;;;  ;;;   ;;;   ;;;;         ;             ;;;;; ;;  ;;;;   ;;;;  
+;                                                                       
+;                                                                       
+;                                                                       
+
+  
+  (define-syntax-rule 
+    (capture-output arg1 args ...)
+    (let ([p (open-output-string)])
+      (parameterize ([current-output-port p]
+                     [current-error-port p])
+        arg1 args ...)
+      (get-output-string p)))
+  
+  (let ()
+    (define red (reduction-relation empty-language (--> 1 2)))
+    (test (capture-output (test--> red 1 2) (test-results))
+          "One test passed.\n")
+    (test (capture-output (test--> red 2 3) (test-results))
+          #rx"FAILED tl-test.ss:[0-9.]+\nexpected: 3\n  actual: 2\n1 test failed \\(out of 1 total\\).\n"))
+    
+  (let ()
+    (define red-share (reduction-relation 
+                       empty-language
+                       (--> a b)
+                       (--> a c)
+                       (--> c d)
+                       (--> b d)))
+    (test (capture-output (test--> red-share (term a) (term d)) (test-results))
+          "One test passed.\n"))
+  
+  (let ()
+    (define red-cycle (reduction-relation 
+                       empty-language
+                       (--> a a)))
+    (test (capture-output (test--> red-cycle #:cycles-ok (term a)) (test-results))
+          "One test passed.\n")
+    (test (capture-output (test--> red-cycle (term a)) (test-results))
+          #rx"FAILED tl-test.ss:[0-9.]+\nfound a cycle in the reduction graph\n1 test failed \\(out of 1 total\\).\n"))
+  
   (print-tests-passed 'tl-test.ss))
diff --git a/collects/scheme/private/contract.ss b/collects/scheme/private/contract.ss
index db02530008..52688c3f6e 100644
--- a/collects/scheme/private/contract.ss
+++ b/collects/scheme/private/contract.ss
@@ -132,7 +132,8 @@ improve method arity mismatch contract violation error messages?
   
   (define (build-struct-names name field-infos)
     (let ([name-str (symbol->string (syntax-e name))])
-      (list* (datum->syntax 
+      (list* name
+             (datum->syntax 
               name
               (string->symbol
                (string-append "struct:" name-str)))
@@ -284,7 +285,7 @@ improve method arity mismatch contract violation error messages?
        (let* ([field-infos (map check-field fields (syntax->list #'(ctc ...)))]
               [sinfo (check-kwds (syntax->list #'(kwds ...)) field-infos)]
               [names (build-struct-names #'name field-infos)]
-              [pred (caddr names)]
+              [pred (cadddr names)]
               [ctcs (build-contracts stx pred field-infos)])
          (let-values ([(non-auto-fields auto-fields)
                        (let loop ([fields field-infos]
@@ -306,7 +307,7 @@ improve method arity mismatch contract violation error messages?
                                                          (field-info-stx (car fields)))))))])
            (with-syntax ([ctc-bindings
                           (let ([val-bindings (if (s-info-def-vals? sinfo)
-                                                  (map list (cdr names) ctcs)
+                                                  (cons (cadr names) (map list (cddr names) ctcs))
                                                   null)])
                             (if (s-info-def-stxs? sinfo)
                                 (cons (car names) val-bindings)
diff --git a/collects/scribblings/reference/custom-ports.scrbl b/collects/scribblings/reference/custom-ports.scrbl
index 6f5bde0888..606dbc74b6 100644
--- a/collects/scribblings/reference/custom-ports.scrbl
+++ b/collects/scribblings/reference/custom-ports.scrbl
@@ -892,7 +892,7 @@ procedures.
     result is the number of bytes written.
 
     If @scheme[get-write-evt] is @scheme[#f], then
-    @scheme[port-writes-atomic?] will produce @scheme[#f] with applied
+    @scheme[port-writes-atomic?] will produce @scheme[#f] when applied
     to the port, and the port will not be a valid argument to
     procedures such as @scheme[write-bytes-avail-evt].