From 4a7227f22ad05ca7b9b55c473bb00d2ad65c061d Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Thu, 19 Feb 2004 22:39:34 +0000
Subject: [PATCH] .

original commit: bdfee767c2ae8fb7a0b48de7d51be2f0ee1b4a7c
---
 collects/mzlib/cm.ss       | 11 +++++++----
 collects/mzlib/contract.ss |  1 +
 2 files changed, 8 insertions(+), 4 deletions(-)

diff --git a/collects/mzlib/cm.ss b/collects/mzlib/cm.ss
index d6c8728..de50352 100644
--- a/collects/mzlib/cm.ss
+++ b/collects/mzlib/cm.ss
@@ -66,12 +66,14 @@
   (define (touch path)
     (close-output-port (open-output-file path 'append)))
 
-  (define (compilation-failure path zo-name date-path)
+  (define (compilation-failure path zo-name date-path reason)
     (with-handlers ((not-break-exn? void))
       (delete-file zo-name))
     (let ([fail-path (bytes->path
 		      (bytes-append (get-compilation-path path) #".fail"))])
-      (close-output-port (open-output-file fail-path 'truncate/replace)))
+      (let ([p (open-output-file fail-path 'truncate/replace)])
+	(display reason p)
+	(close-output-port p)))
     ((trace) (format "~afailure" (indent))))
 
   (define (compile-zo path)
@@ -86,7 +88,8 @@
           (with-handlers ([exn:get-module-code?
                            (lambda (ex)
                              (compilation-failure
-                              path zo-name (exn:get-module-code-path ex)))])
+                              path zo-name (exn:get-module-code-path ex)
+			      (exn-message ex)))])
             (let* ([param
                     ;; Avoid using cm while loading cm-ctime:
                     (parameterize ([use-compiled-file-kinds 'none])
@@ -103,7 +106,7 @@
                 (make-directory code-dir))
               (let ((out (open-output-file zo-name 'replace)))
                 (with-handlers ((exn:application:type?
-                                 (lambda (ex) (compilation-failure path zo-name #f))))
+                                 (lambda (ex) (compilation-failure path zo-name #f (exn-message ex)))))
                   (dynamic-wind
                     void
                     (lambda () (write code out))
diff --git a/collects/mzlib/contract.ss b/collects/mzlib/contract.ss
index b315d7e..0ac7655 100644
--- a/collects/mzlib/contract.ss
+++ b/collects/mzlib/contract.ss
@@ -2308,6 +2308,7 @@ add struct contracts for immutable structs?
        (let printable? ([x x])
 	 (or (symbol? x)
 	     (string? x)
+	     (bytes? x)
 	     (boolean? x)
 	     (char? x)
 	     (null? x)