From 42b3b8820b44e10f59286dd093638d5265bd9af1 Mon Sep 17 00:00:00 2001 From: Carl Eastlund Date: Sun, 17 Jan 2010 05:18:37 +0000 Subject: [PATCH] Added simplification of collects paths to blame error printing. svn: r17690 --- collects/scheme/contract/private/blame.ss | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/collects/scheme/contract/private/blame.ss b/collects/scheme/contract/private/blame.ss index 9896bfaa3e..5a54fae44f 100644 --- a/collects/scheme/contract/private/blame.ss +++ b/collects/scheme/contract/private/blame.ss @@ -1,6 +1,6 @@ #lang scheme/base -(require unstable/srcloc scheme/pretty) +(require unstable/srcloc scheme/pretty "helpers.ss") (provide blame? make-blame @@ -44,7 +44,12 @@ b))) (define (default-blame-format b x custom-message) - (let* ([source-message (source-location->prefix (blame-source b))] + (let* ([source-message + (let* ([loc (blame-source b)]) + (source-location->prefix + (struct-copy + srcloc loc + [source (source->name (srcloc-source loc))])))] [guilty-message (show (blame-guilty b))] [contract-message (show (blame-contract b))] [value-message (if (blame-value b)