[racket-dev] [plt] Push #26634: master branch updated

And though the contract checks pass, this causes other things to fail because apparently existing contracts depended on the behavior of allowing the user to not provide initialization arguments if there was a default value already.  Will revert and then fix differently.  Sorry.

Stevie

On Apr 13, 2013, at 5:31 PM, sstrickl at racket-lang.org wrote:

> sstrickl has updated `master' from 3cb555a6c1 to 27b4df3eb5.
>  http://git.racket-lang.org/plt/3cb555a6c1..27b4df3eb5
> 
> =====[ 2 Commits ]======================================================
> Directory summary:
>  49.5% collects/racket/contract/private/
>   8.4% collects/racket/private/
>   7.3% collects/scribblings/reference/
>  34.5% collects/tests/racket/
> 
> ~~~~~~~~~~
> 
> eb12d76 Stevie Strickland <sstrickl at racket-lang.org> 2013-04-13 17:18
> :
> | Add two spaces before contract error message fields (Reference section 9.2.1).
> :
>  M collects/racket/contract/private/blame.rkt     | 18 +++++++++---------
>  M collects/scribblings/reference/contracts.scrbl |  2 +-
>  M collects/tests/racket/contract-test.rktl       |  4 ++--
> 
> ~~~~~~~~~~
> 
> 27b4df3 Stevie Strickland <sstrickl at racket-lang.org> 2013-04-13 17:20
> :
> | Check that init args mentioned in contracts are provided.
> |
> | Closes PR 13693.
> :
>  M collects/racket/private/class-internal.rkt | 2 ++
>  M collects/tests/racket/contract-test.rktl   | 7 +++++++
> 
> =====[ Overall Diff ]===================================================
> 
> collects/racket/contract/private/blame.rkt
> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
> --- OLD/collects/racket/contract/private/blame.rkt
> +++ NEW/collects/racket/contract/private/blame.rkt
> @@ -153,7 +153,7 @@
>           (define (add-indent s)
>             (if (null? so-far)
>                 s
> -                (string-append "\n " s)))
> +                (string-append "\n  " s)))
>           (define nxt
>             (cond
>               [(eq? 'given: fst) (add-indent
> @@ -190,13 +190,13 @@
>                                    (for/list ([context (in-list context)]
>                                               [n (in-naturals)])
>                                      (format (if (zero? n)
> -                                                 " in: ~a\n"
> -                                                 "     ~a\n")
> +                                                 "  in: ~a\n"
> +                                                 "      ~a\n")
>                                              context)))))
>   (define contract-line (show/write (blame-contract blme) #:alone? #t))
>   (define at-line (if (string=? source-message "")
>                       #f
> -                      (format " at: ~a" source-message)))
> +                      (format "  at: ~a" source-message)))
> 
>   (define self-or-not (if (blame-original? blme)
>                           "broke its contract"
> @@ -215,11 +215,11 @@
>   (define blaming-line
>     (cond
>       [(null? (cdr blame-parties))
> -       (format " blaming: ~a" (convert-blame-singleton (car blame-parties)))]
> +       (format "  blaming: ~a" (convert-blame-singleton (car blame-parties)))]
>       [else
>        (apply
>         string-append 
> -        " blaming multiple parties:"
> +        "  blaming multiple parties:"
>         (for/list ([party (in-list blame-parties)])
>           (format "\n  ~a" (convert-blame-singleton party))))]))
> 
> @@ -228,11 +228,11 @@
>         (let ([from-positive-message 
>                (show/display
>                 (from-info (blame-positive blme)))])
> -          (format " contract from: ~a" from-positive-message))
> +          (format "  contract from: ~a" from-positive-message))
>         (let ([from-negative-message 
>                (show/display
>                 (from-info (blame-negative blme)))])
> -          (format " contract from: ~a" from-negative-message))))
> +          (format "  contract from: ~a" from-negative-message))))
> 
>   (combine-lines
>    start-of-message
> @@ -241,7 +241,7 @@
>    (if context-lines
>        contract-line
>        (string-append
> -        " in:" 
> +        "  in:"
>         (substring contract-line 5 (string-length contract-line))))
>    from-line
>    blaming-line
> 
> collects/racket/private/class-internal.rkt
> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
> --- OLD/collects/racket/private/class-internal.rkt
> +++ NEW/collects/racket/private/class-internal.rkt
> @@ -3196,6 +3196,8 @@ An example
>                        [handled-args null])
>               (cond
>                 [(null? init-args)
> +                 (unless (null? inits/c)
> +                   (raise-blame-error bswap #f "initialization argument not provided\n  init-arg: ~a" (car (car inits/c))))
>                  (reverse handled-args)]
>                 [(null? inits/c)
>                  (append (reverse handled-args) init-args)]
> 
> collects/scribblings/reference/contracts.scrbl
> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
> --- OLD/collects/scribblings/reference/contracts.scrbl
> +++ NEW/collects/scribblings/reference/contracts.scrbl
> @@ -1819,7 +1819,7 @@ the @racket[b] argument has been swapped or not (see @racket[blame-swap]).
> 
> If @racket[fmt] contains the symbols @racket['given:] or @racket['expected:],
> they are replaced like @racket['given:] and @racket['expected:] are, but
> -the replacements are prefixed with the string @racket["\n "] to conform
> +the replacements are prefixed with the string @racket["\n  "] to conform
> to the error message guidelines in @secref["err-msg-conventions"].
> 
> }
> 
> collects/tests/racket/contract-test.rktl
> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
> --- OLD/collects/tests/racket/contract-test.rktl
> +++ NEW/collects/tests/racket/contract-test.rktl
> @@ -8032,6 +8032,13 @@
>            [d%/c/c (contract (class/c (init [a number?])) d%/c 'pos 'neg)])
>       (new d%/c/c [a #t] [a "foo"])))
> 
> +  ;; Check that we catch not providing init args metioned in the contract
> +  (test/neg-blame
> +   'class/c-higher-order-init-9
> +   '(let* ([c% (class object% (super-new) (init [a 3]))]
> +           [c%/c (contract (class/c (init [a integer?])) c% 'pos 'neg)])
> +      (new c%/c)))
> +
>   (test/spec-passed
>    'class/c-higher-order-init-field-1
>    '(let ([c% (contract (class/c (init-field [f (-> number? number?)]))
> @@ -13699,8 +13706,8 @@ so that propagation occurs.
>   (let* ([blame-pos (contract-eval '(make-blame (srcloc #f #f #f #f #f) #f (λ () 'integer?) 'positive 'negative #t))]
>          [blame-neg (contract-eval `(blame-swap ,blame-pos))])
>     (ctest "something ~a" blame-fmt->-string ,blame-neg "something ~a")
> -    (ctest "promised: ~s\n produced: ~e" blame-fmt->-string ,blame-pos '(expected: "~s" given: "~e"))
> -    (ctest "expected: ~s\n given: ~e" blame-fmt->-string ,blame-neg '(expected: "~s" given: "~e"))
> +    (ctest "promised: ~s\n  produced: ~e" blame-fmt->-string ,blame-pos '(expected: "~s" given: "~e"))
> +    (ctest "expected: ~s\n  given: ~e" blame-fmt->-string ,blame-neg '(expected: "~s" given: "~e"))
>     (ctest "promised ~s produced ~e" blame-fmt->-string ,blame-pos '(expected "~s" given "~e"))
>     (ctest "expected ~s given ~e" blame-fmt->-string ,blame-neg '(expected "~s" given "~e")))
>