From 255e3cbe2e6900820d5b0e29053973f1629b136b Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 6 Jun 2012 12:25:14 +0800 Subject: [PATCH] another *SL error-rewriting fix Arity errors no include supplied arguments, but strip them away for *SL messages. --- collects/lang/private/rewrite-error-message.rkt | 6 ++++-- collects/tests/htdp-lang/beg-bega.rktl | 1 + 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/collects/lang/private/rewrite-error-message.rkt b/collects/lang/private/rewrite-error-message.rkt index e2e6d8c193..1cda5e5d87 100644 --- a/collects/lang/private/rewrite-error-message.rkt +++ b/collects/lang/private/rewrite-error-message.rkt @@ -115,11 +115,11 @@ (lambda (all one two) (format "expects a ~a" two))) (list #rx"expects type (<([^>]+)>)" (lambda (all one two) (format "expects a ~a" two))) - (list #px"application: wrong number of arguments.*\n procedure: ([^\n]*)\n expected[^:]*: at least (\\d+)\n given[^:]*: (\\d+)" + (list #px"application: wrong number of arguments.*\n procedure: ([^\n]*)\n expected[^:]*: at least (\\d+)\n given[^:]*: (\\d+)(?:\n arguments:(?:\n [^\n]*)*)?" (lambda (all one two three) (argcount-error-message one two three #t))) (list #px"application: wrong number of arguments.*\n procedure: ([^\n]*)\n expected[^:]*: (\\d+)\n given[^:]*: (\\d+)(?:\n arguments:(?:\n [^\n]*)*)?" (lambda (all one two three) (argcount-error-message one two three))) - (list #px"contract violation\n expected: (.*?)\n given: ([^\n]*)(?:\n argument position: ([^\n]*))?(?:\n other arguments:.*)?" + (list #px"contract violation\n expected: (.*?)\n given: ([^\n]*)(?:\n argument position: ([^\n]*))?" (lambda (all ctc given pos) (contract-error-message ctc given pos))) (list #rx"^procedure " (lambda (all) "")) @@ -127,6 +127,8 @@ (lambda (all) ", given ")) (list #rx"; other arguments were:.*" (lambda (all) "")) + (list #px"(?:\n other arguments:(?:\n [^\n]*)*)" + (lambda (all) "")) (list #rx"expects a (struct:)" (lambda (all one) "expects a ")) (list #rx"list or cyclic list" diff --git a/collects/tests/htdp-lang/beg-bega.rktl b/collects/tests/htdp-lang/beg-bega.rktl index a3610e8dfe..5fb1cd41d5 100644 --- a/collects/tests/htdp-lang/beg-bega.rktl +++ b/collects/tests/htdp-lang/beg-bega.rktl @@ -1,5 +1,6 @@ (htdp-err/rt-test (/) "/: expects at least 2 arguments, but found none") +(htdp-err/rt-test (+ 1) #rx"^[+]: expects at least 2 arguments, but found only 1$") (htdp-syntax-test #'(local [(define x 5)] x) "local: this function is not defined") (htdp-syntax-test #'(recur name ([x 18]) x) "recur: this function is not defined")