From cac9e050271d244a906e4589897e2ff46ec14b2d Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Wed, 28 Apr 2010 21:08:45 -0400 Subject: [PATCH 1/5] add .DS_Store to ignores --- .gitignore | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/.gitignore b/.gitignore index ce6902a12e..b331c565d3 100644 --- a/.gitignore +++ b/.gitignore @@ -10,7 +10,8 @@ # a common convenient place to set the PLTADDON directory to /add-on/ -# common backups, autosaves, and lock files +# common backups, autosaves, lock files, OS meta-files *~ \#* .#* +.DS_Store From 039036a92b8ec9dbc49450c8cf04944682246836 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 28 Apr 2010 20:22:44 -0600 Subject: [PATCH 2/5] fix props for teachpack .ss unrenaming --- collects/meta/props | 60 ++++++++++++++++++++++----------------------- 1 file changed, 30 insertions(+), 30 deletions(-) diff --git a/collects/meta/props b/collects/meta/props index 5665bf6c51..81ef9b41ea 100644 --- a/collects/meta/props +++ b/collects/meta/props @@ -1223,36 +1223,36 @@ path/s is either such a string or a list of them. "collects/teachpack/2htdp/scribblings/image-toc.rkt" responsible (robby) "collects/teachpack/2htdp/scribblings/image-util.rkt" responsible (robby) "collects/teachpack/2htdp/scribblings/image.scrbl" responsible (robby) -"collects/teachpack/2htdp/universe.rkt" drdr:command-line "mred-text -t ~s" -"collects/teachpack/balls.rkt" drdr:command-line "mzc ~s" -"collects/teachpack/deinprogramm/image.rkt" drdr:command-line "mred-text -t ~s" -"collects/teachpack/deinprogramm/line3d.rkt" drdr:command-line "mred-text -t ~s" -"collects/teachpack/deinprogramm/sound.rkt" drdr:command-line "mred-text -t ~s" -"collects/teachpack/deinprogramm/turtle.rkt" drdr:command-line "mred-text -t ~s" -"collects/teachpack/deinprogramm/universe.rkt" drdr:command-line "mred-text -qt ~s" -"collects/teachpack/deinprogramm/world.rkt" drdr:command-line "mred-text -t ~s" -"collects/teachpack/door.rkt" drdr:command-line "mred-text -t ~s" -"collects/teachpack/htdp/arrow-gui.rkt" drdr:command-line "mred-text -t ~s" -"collects/teachpack/htdp/arrow.rkt" drdr:command-line "mred-text -t ~s" -"collects/teachpack/htdp/convert.rkt" drdr:command-line "mred-text -t ~s" -"collects/teachpack/htdp/draw.rkt" drdr:command-line "mred-text -t ~s" -"collects/teachpack/htdp/elevator.rkt" drdr:command-line "mred-text -t ~s" -"collects/teachpack/htdp/graphing.rkt" drdr:command-line "mzc ~s" -"collects/teachpack/htdp/guess-gui.rkt" drdr:command-line "mred-text -t ~s" -"collects/teachpack/htdp/guess.rkt" drdr:command-line "mred-text -t ~s" -"collects/teachpack/htdp/gui.rkt" drdr:command-line "mred-text -t ~s" -"collects/teachpack/htdp/hangman.rkt" drdr:command-line "mred-text -t ~s" -"collects/teachpack/htdp/image.rkt" drdr:command-line "mred-text -t ~s" -"collects/teachpack/htdp/lkup-gui.rkt" drdr:command-line "mred-text -t ~s" -"collects/teachpack/htdp/master.rkt" drdr:command-line "mred-text -t ~s" -"collects/teachpack/htdp/matrix.rkt" drdr:command-line "mred-text -t ~s" -"collects/teachpack/htdp/show-queen.rkt" drdr:command-line "mred-text -t ~s" -"collects/teachpack/htdp/world.rkt" drdr:command-line "mred-text -t ~s" -"collects/teachpack/nuworld.rkt" drdr:command-line "mred-text -t ~s" -"collects/teachpack/server.rkt" drdr:command-line "mred-text -t ~s" -"collects/teachpack/turtles.rkt" drdr:command-line "mred-text -t ~s" -"collects/teachpack/value-turtles.rkt" drdr:command-line "mred-text -t ~s" -"collects/teachpack/world.rkt" drdr:command-line "mred-text -t ~s" +"collects/teachpack/2htdp/universe.ss" drdr:command-line "mred-text -t ~s" +"collects/teachpack/balls.ss" drdr:command-line "mzc ~s" +"collects/teachpack/deinprogramm/image.ss" drdr:command-line "mred-text -t ~s" +"collects/teachpack/deinprogramm/line3d.ss" drdr:command-line "mred-text -t ~s" +"collects/teachpack/deinprogramm/sound.ss" drdr:command-line "mred-text -t ~s" +"collects/teachpack/deinprogramm/turtle.ss" drdr:command-line "mred-text -t ~s" +"collects/teachpack/deinprogramm/universe.ss" drdr:command-line "mred-text -qt ~s" +"collects/teachpack/deinprogramm/world.ss" drdr:command-line "mred-text -t ~s" +"collects/teachpack/door.ss" drdr:command-line "mred-text -t ~s" +"collects/teachpack/htdp/arrow-gui.ss" drdr:command-line "mred-text -t ~s" +"collects/teachpack/htdp/arrow.ss" drdr:command-line "mred-text -t ~s" +"collects/teachpack/htdp/convert.ss" drdr:command-line "mred-text -t ~s" +"collects/teachpack/htdp/draw.ss" drdr:command-line "mred-text -t ~s" +"collects/teachpack/htdp/elevator.ss" drdr:command-line "mred-text -t ~s" +"collects/teachpack/htdp/graphing.ss" drdr:command-line "mzc ~s" +"collects/teachpack/htdp/guess-gui.ss" drdr:command-line "mred-text -t ~s" +"collects/teachpack/htdp/guess.ss" drdr:command-line "mred-text -t ~s" +"collects/teachpack/htdp/gui.ss" drdr:command-line "mred-text -t ~s" +"collects/teachpack/htdp/hangman.ss" drdr:command-line "mred-text -t ~s" +"collects/teachpack/htdp/image.ss" drdr:command-line "mred-text -t ~s" +"collects/teachpack/htdp/lkup-gui.ss" drdr:command-line "mred-text -t ~s" +"collects/teachpack/htdp/master.ss" drdr:command-line "mred-text -t ~s" +"collects/teachpack/htdp/matrix.ss" drdr:command-line "mred-text -t ~s" +"collects/teachpack/htdp/show-queen.ss" drdr:command-line "mred-text -t ~s" +"collects/teachpack/htdp/world.ss" drdr:command-line "mred-text -t ~s" +"collects/teachpack/nuworld.ss" drdr:command-line "mred-text -t ~s" +"collects/teachpack/server.ss" drdr:command-line "mred-text -t ~s" +"collects/teachpack/turtles.ss" drdr:command-line "mred-text -t ~s" +"collects/teachpack/value-turtles.ss" drdr:command-line "mred-text -t ~s" +"collects/teachpack/world.ss" drdr:command-line "mred-text -t ~s" "collects/test-box-recovery/tool.rkt" drdr:command-line "mred-text -t ~s" "collects/test-engine" responsible (kathyg) "collects/test-engine/scheme-gui.rkt" drdr:command-line "mred-text -t ~s" From 7d0a83b983917408cc10fbeb9ca66ae78f17c96e Mon Sep 17 00:00:00 2001 From: Casey Klein Date: Thu, 29 Apr 2010 06:42:53 -0500 Subject: [PATCH 3/5] Updates tests for quasiquote printing and .rkt extension --- collects/redex/tests/tl-test.rkt | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/collects/redex/tests/tl-test.rkt b/collects/redex/tests/tl-test.rkt index 3fc208f7dd..a9d31f92c8 100644 --- a/collects/redex/tests/tl-test.rkt +++ b/collects/redex/tests/tl-test.rkt @@ -646,13 +646,13 @@ (parameterize ([current-output-port sp] [current-traced-metafunctions 'all]) (term (f 1))) - (test (get-output-string sp) ">(f 1)\n<0\n")) + (test (get-output-string sp) ">`(f 1)\n<0\n")) (let ([sp (open-output-string)]) (parameterize ([current-output-port sp] [current-traced-metafunctions '(f)]) (term (f 1))) - (test (get-output-string sp) ">(f 1)\n<0\n"))) + (test (get-output-string sp) ">`(f 1)\n<0\n"))) (let () (define-language var-lang [(x y z w) variable]) @@ -1753,7 +1753,7 @@ [c (make-coverage T)]) (parameterize ([relation-coverage (list c)]) (apply-reduction-relation T (term q)) - (test (and (regexp-match #px"tl-test.ss:\\d+:\\d+" (caar (covered-cases c))) #t) + (test (and (regexp-match #px"tl-test.(?:.+):\\d+:\\d+" (caar (covered-cases c))) #t) #t)))) (let* ([R (reduction-relation @@ -1772,7 +1772,7 @@ second (curry regexp-match #px".*:(\\d+):\\d+"))]) (< (line-no (car c)) (line-no (car d)))))] - [src-ok? (curry regexp-match? #px"tl-test.ss:\\d+:\\d+")] + [src-ok? (curry regexp-match? #px"tl-test.(?:.+):\\d+:\\d+")] [sorted-counts (λ (cc) (map cdr (sort (covered-cases cc) <)))]) (define-metafunction empty-language [(f 1) 1] @@ -1851,7 +1851,7 @@ (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")) + #rx"FAILED tl-test.(?:.+):[0-9.]+\nexpected: 3\n actual: 2\n1 test failed \\(out of 1 total\\).\n")) (let () (define red-share (reduction-relation @@ -1870,7 +1870,7 @@ (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")) + #rx"FAILED tl-test.(?:.+):[0-9.]+\nfound a cycle in the reduction graph\n1 test failed \\(out of 1 total\\).\n")) (let () (define-metafunction empty-language [(f any) ((any))]) @@ -1913,7 +1913,7 @@ (test (capture-output (test--> R #:equiv mod2=? 7 1 0) (test-results)) "One test passed.\n") (test (capture-output (test--> R #:equiv mod2=? 7 1) (test-results)) - #rx"FAILED tl-test.ss:[0-9.]+\nexpected: 1\n actual: 8\n actual: 7\n1 test failed \\(out of 1 total\\).\n")) + #rx"FAILED tl-test.(?:.+):[0-9.]+\nexpected: 1\n actual: 8\n actual: 7\n1 test failed \\(out of 1 total\\).\n")) (let-syntax ([test-bad-equiv-arg (λ (stx) From 2dfe132862832e01971afe33eeaac41b9a1b7a19 Mon Sep 17 00:00:00 2001 From: Casey Klein Date: Thu, 29 Apr 2010 06:58:45 -0500 Subject: [PATCH 4/5] Fixes (hopefully) the bad merge I accidentally made --- collects/meta/props | 60 ++++++++++++++++++++++----------------------- 1 file changed, 30 insertions(+), 30 deletions(-) diff --git a/collects/meta/props b/collects/meta/props index 81ef9b41ea..5665bf6c51 100644 --- a/collects/meta/props +++ b/collects/meta/props @@ -1223,36 +1223,36 @@ path/s is either such a string or a list of them. "collects/teachpack/2htdp/scribblings/image-toc.rkt" responsible (robby) "collects/teachpack/2htdp/scribblings/image-util.rkt" responsible (robby) "collects/teachpack/2htdp/scribblings/image.scrbl" responsible (robby) -"collects/teachpack/2htdp/universe.ss" drdr:command-line "mred-text -t ~s" -"collects/teachpack/balls.ss" drdr:command-line "mzc ~s" -"collects/teachpack/deinprogramm/image.ss" drdr:command-line "mred-text -t ~s" -"collects/teachpack/deinprogramm/line3d.ss" drdr:command-line "mred-text -t ~s" -"collects/teachpack/deinprogramm/sound.ss" drdr:command-line "mred-text -t ~s" -"collects/teachpack/deinprogramm/turtle.ss" drdr:command-line "mred-text -t ~s" -"collects/teachpack/deinprogramm/universe.ss" drdr:command-line "mred-text -qt ~s" -"collects/teachpack/deinprogramm/world.ss" drdr:command-line "mred-text -t ~s" -"collects/teachpack/door.ss" drdr:command-line "mred-text -t ~s" -"collects/teachpack/htdp/arrow-gui.ss" drdr:command-line "mred-text -t ~s" -"collects/teachpack/htdp/arrow.ss" drdr:command-line "mred-text -t ~s" -"collects/teachpack/htdp/convert.ss" drdr:command-line "mred-text -t ~s" -"collects/teachpack/htdp/draw.ss" drdr:command-line "mred-text -t ~s" -"collects/teachpack/htdp/elevator.ss" drdr:command-line "mred-text -t ~s" -"collects/teachpack/htdp/graphing.ss" drdr:command-line "mzc ~s" -"collects/teachpack/htdp/guess-gui.ss" drdr:command-line "mred-text -t ~s" -"collects/teachpack/htdp/guess.ss" drdr:command-line "mred-text -t ~s" -"collects/teachpack/htdp/gui.ss" drdr:command-line "mred-text -t ~s" -"collects/teachpack/htdp/hangman.ss" drdr:command-line "mred-text -t ~s" -"collects/teachpack/htdp/image.ss" drdr:command-line "mred-text -t ~s" -"collects/teachpack/htdp/lkup-gui.ss" drdr:command-line "mred-text -t ~s" -"collects/teachpack/htdp/master.ss" drdr:command-line "mred-text -t ~s" -"collects/teachpack/htdp/matrix.ss" drdr:command-line "mred-text -t ~s" -"collects/teachpack/htdp/show-queen.ss" drdr:command-line "mred-text -t ~s" -"collects/teachpack/htdp/world.ss" drdr:command-line "mred-text -t ~s" -"collects/teachpack/nuworld.ss" drdr:command-line "mred-text -t ~s" -"collects/teachpack/server.ss" drdr:command-line "mred-text -t ~s" -"collects/teachpack/turtles.ss" drdr:command-line "mred-text -t ~s" -"collects/teachpack/value-turtles.ss" drdr:command-line "mred-text -t ~s" -"collects/teachpack/world.ss" drdr:command-line "mred-text -t ~s" +"collects/teachpack/2htdp/universe.rkt" drdr:command-line "mred-text -t ~s" +"collects/teachpack/balls.rkt" drdr:command-line "mzc ~s" +"collects/teachpack/deinprogramm/image.rkt" drdr:command-line "mred-text -t ~s" +"collects/teachpack/deinprogramm/line3d.rkt" drdr:command-line "mred-text -t ~s" +"collects/teachpack/deinprogramm/sound.rkt" drdr:command-line "mred-text -t ~s" +"collects/teachpack/deinprogramm/turtle.rkt" drdr:command-line "mred-text -t ~s" +"collects/teachpack/deinprogramm/universe.rkt" drdr:command-line "mred-text -qt ~s" +"collects/teachpack/deinprogramm/world.rkt" drdr:command-line "mred-text -t ~s" +"collects/teachpack/door.rkt" drdr:command-line "mred-text -t ~s" +"collects/teachpack/htdp/arrow-gui.rkt" drdr:command-line "mred-text -t ~s" +"collects/teachpack/htdp/arrow.rkt" drdr:command-line "mred-text -t ~s" +"collects/teachpack/htdp/convert.rkt" drdr:command-line "mred-text -t ~s" +"collects/teachpack/htdp/draw.rkt" drdr:command-line "mred-text -t ~s" +"collects/teachpack/htdp/elevator.rkt" drdr:command-line "mred-text -t ~s" +"collects/teachpack/htdp/graphing.rkt" drdr:command-line "mzc ~s" +"collects/teachpack/htdp/guess-gui.rkt" drdr:command-line "mred-text -t ~s" +"collects/teachpack/htdp/guess.rkt" drdr:command-line "mred-text -t ~s" +"collects/teachpack/htdp/gui.rkt" drdr:command-line "mred-text -t ~s" +"collects/teachpack/htdp/hangman.rkt" drdr:command-line "mred-text -t ~s" +"collects/teachpack/htdp/image.rkt" drdr:command-line "mred-text -t ~s" +"collects/teachpack/htdp/lkup-gui.rkt" drdr:command-line "mred-text -t ~s" +"collects/teachpack/htdp/master.rkt" drdr:command-line "mred-text -t ~s" +"collects/teachpack/htdp/matrix.rkt" drdr:command-line "mred-text -t ~s" +"collects/teachpack/htdp/show-queen.rkt" drdr:command-line "mred-text -t ~s" +"collects/teachpack/htdp/world.rkt" drdr:command-line "mred-text -t ~s" +"collects/teachpack/nuworld.rkt" drdr:command-line "mred-text -t ~s" +"collects/teachpack/server.rkt" drdr:command-line "mred-text -t ~s" +"collects/teachpack/turtles.rkt" drdr:command-line "mred-text -t ~s" +"collects/teachpack/value-turtles.rkt" drdr:command-line "mred-text -t ~s" +"collects/teachpack/world.rkt" drdr:command-line "mred-text -t ~s" "collects/test-box-recovery/tool.rkt" drdr:command-line "mred-text -t ~s" "collects/test-engine" responsible (kathyg) "collects/test-engine/scheme-gui.rkt" drdr:command-line "mred-text -t ~s" From 484be3cf024312f03e1f66550208692a6aad6c0d Mon Sep 17 00:00:00 2001 From: Stevie Strickland Date: Thu, 29 Apr 2010 12:01:53 -0400 Subject: [PATCH 5/5] Add new argument to apply-contract/make-blame for the "user" blame label. The new blame label gives us the location of the "use" of the value. This blame label describes the location where we actually did the contract wrapping, which may differ from the negative blame label. --- collects/racket/contract/private/base.rkt | 8 ++++---- collects/racket/contract/private/blame.rkt | 11 ++++++++--- collects/racket/contract/private/legacy.rkt | 6 ++++-- 3 files changed, 16 insertions(+), 9 deletions(-) diff --git a/collects/racket/contract/private/base.rkt b/collects/racket/contract/private/base.rkt index 293b66f0a1..14f71a3b04 100644 --- a/collects/racket/contract/private/base.rkt +++ b/collects/racket/contract/private/base.rkt @@ -27,21 +27,21 @@ improve method arity mismatch contract violation error messages? (syntax-case stx () [(_ c v pos neg name loc) (syntax/loc stx - (apply-contract c v pos neg name loc))] + (apply-contract c v pos neg name loc (current-contract-region)))] [(_ c v pos neg) (syntax/loc stx - (apply-contract c v pos neg #f (build-source-location #f)))] + (apply-contract c v pos neg #f (build-source-location #f) (current-contract-region)))] [(_ c v pos neg src) (raise-syntax-error 'contract (string-append "please update contract application to new protocol " "(either 4 or 6 arguments)"))])) -(define (apply-contract c v pos neg name loc) +(define (apply-contract c v pos neg name loc usr) (let* ([c (coerce-contract 'contract c)]) (check-source-location! 'contract loc) (((contract-projection c) - (make-blame loc name (contract-name c) pos neg #t)) + (make-blame loc name (contract-name c) pos neg usr #t)) v))) (define-syntax (recursive-contract stx) diff --git a/collects/racket/contract/private/blame.rkt b/collects/racket/contract/private/blame.rkt index a0311aa122..5e6f106965 100644 --- a/collects/racket/contract/private/blame.rkt +++ b/collects/racket/contract/private/blame.rkt @@ -34,7 +34,7 @@ (hash/recur (blame-original? b)))) (define-struct blame - [source value contract positive negative original?] + [source value contract positive negative user original?] #:property prop:equal+hash (list blame=? blame-hash blame-hash)) @@ -64,12 +64,17 @@ [contract-message (show/write (blame-contract b))] [value-message (if (blame-value b) (format " on ~a" (show/display (blame-value b))) - "")]) - (format "~a~a broke the contract ~a~a; ~a" + "")] + [user-message (if (or (blame-original? b) + (equal? (blame-positive b) (blame-user b))) + "" + (format " given to ~a" (show/display (blame-user b))))]) + (format "~a~a broke the contract ~a~a~a; ~a" source-message positive-message contract-message value-message + user-message custom-message))) (define ((show f) v) diff --git a/collects/racket/contract/private/legacy.rkt b/collects/racket/contract/private/legacy.rkt index 5b80fbbe46..d912b62e41 100644 --- a/collects/racket/contract/private/legacy.rkt +++ b/collects/racket/contract/private/legacy.rkt @@ -21,7 +21,8 @@ name (unpack-blame pos) "<>" - #t) + #t + name) x fmt args)) @@ -58,7 +59,8 @@ name (unpack-blame (if original? pos neg)) (unpack-blame (if original? neg pos)) - original?))))) + original? + name))))) (define (legacy-property name) (define-values [ prop pred get ]