adjusted the syntax for ->i so that #:rest is not ambiguous anymore (added extra parens, deviating from ->d a little bit) and updated the test suite
This commit is contained in:
parent
7352d86f1f
commit
64a1ddcda9
|
@ -1,4 +1,14 @@
|
||||||
#lang racket/base
|
#lang racket/base
|
||||||
|
(require syntax/private/boundmap
|
||||||
|
(for-template racket/base
|
||||||
|
"guts.rkt"))
|
||||||
|
;; the private version of the library
|
||||||
|
;; (the one without contracts)
|
||||||
|
;; has these old, wrong names in it.
|
||||||
|
(define make-free-identifier-mapping make-module-identifier-mapping)
|
||||||
|
(define free-identifier-mapping-get module-identifier-mapping-get)
|
||||||
|
(define free-identifier-mapping-put! module-identifier-mapping-put!)
|
||||||
|
|
||||||
#|
|
#|
|
||||||
|
|
||||||
The ->i contract first parses its input into an istx struct
|
The ->i contract first parses its input into an istx struct
|
||||||
|
@ -7,47 +17,162 @@ and then operates on it to generate the expanded form
|
||||||
|#
|
|#
|
||||||
|
|
||||||
;; doms : (listof arg?)
|
;; doms : (listof arg?)
|
||||||
;; pre : (or/c stx[expr] #f)
|
|
||||||
;; rngs : (listof res?)
|
|
||||||
;; rest : (or/c #f rst?)
|
;; rest : (or/c #f rst?)
|
||||||
|
;; pre : (or/c stx[expr] #f)
|
||||||
|
;; rngs : (or/c #f (listof res?))
|
||||||
;; post : (or/c stx[expr] #f)
|
;; post : (or/c stx[expr] #f)
|
||||||
(define-struct istx (doms pre rngs rest post))
|
(struct istx (args rst pre ress post))
|
||||||
|
|
||||||
;; var : identifier?
|
|
||||||
;; vars : (or/c #f (listof identifier?))
|
|
||||||
;; ctc : syntax[expr]
|
|
||||||
(define-struct res (var vars ctc))
|
|
||||||
|
|
||||||
;; kwd : (or/c #f syntax[kwd])
|
;; kwd : (or/c #f syntax[kwd])
|
||||||
;; var : identifier?
|
;; var : identifier?
|
||||||
;; vars : (or/c #f (listof identifier?))
|
;; vars : (or/c #f (listof identifier?))
|
||||||
;; optional? : boolean?
|
;; optional? : boolean?
|
||||||
;; ctc : syntax[expr]
|
;; ctc : syntax[expr]
|
||||||
(define-struct arg (kwd var vars optional? ctc))
|
(struct arg (kwd var vars optional? ctc))
|
||||||
|
|
||||||
;; var : identifier?
|
;; var : identifier?
|
||||||
;; vars : (or/c #f (listof identifier?))
|
;; vars : (or/c #f (listof identifier?))
|
||||||
;; ctc : syntax[expr]
|
;; ctc : syntax[expr]
|
||||||
(define-struct rst (var vars ctc))
|
(struct res (var vars ctc))
|
||||||
|
|
||||||
|
;; var : identifier?
|
||||||
|
;; vars : (or/c #f (listof identifier?))
|
||||||
|
;; ctc : syntax[expr]
|
||||||
|
(struct rst (var vars ctc))
|
||||||
|
|
||||||
(define (parse-->i stx)
|
(define (parse-->i stx)
|
||||||
(let-values ([(raw-mandatory-doms raw-optional-doms id/rest-id pre-cond range post-cond)
|
(let-values ([(raw-mandatory-doms raw-optional-doms
|
||||||
|
id/rest-id pre-cond range post-cond)
|
||||||
(pull-out-pieces stx)])
|
(pull-out-pieces stx)])
|
||||||
(make-istx (append (map parse-dom raw-mandatory-doms)
|
(let ([candidate
|
||||||
(map parse-dom raw-optional-doms))
|
(istx (append (parse-doms stx #f raw-mandatory-doms)
|
||||||
|
(parse-doms stx #t raw-optional-doms))
|
||||||
|
id/rest-id
|
||||||
pre-cond
|
pre-cond
|
||||||
range
|
(parse-range stx range)
|
||||||
rest
|
post-cond)])
|
||||||
post)))
|
(ensure-wf-names stx candidate)
|
||||||
|
;(ensure-no-cycles stx candidate)
|
||||||
|
candidate)))
|
||||||
|
|
||||||
|
(define (ensure-wf-names stx istx)
|
||||||
|
(let ([km (make-hash)]
|
||||||
|
[nm (make-free-identifier-mapping)])
|
||||||
|
|
||||||
|
(define (no-var-dups var)
|
||||||
|
(cond
|
||||||
|
[(free-identifier-mapping-get nm var (λ () #f))
|
||||||
|
=>
|
||||||
|
(λ (other)
|
||||||
|
(raise-syntax-error #f "duplicate dependent variables"
|
||||||
|
stx other (list var)))]
|
||||||
|
[else
|
||||||
|
(free-identifier-mapping-put! nm var var)]))
|
||||||
|
|
||||||
|
(define (no-kwd-dups kwd-stx)
|
||||||
|
(let ([kwd (syntax-e kwd-stx)])
|
||||||
|
(cond
|
||||||
|
[(hash-ref km kwd #f)
|
||||||
|
=>
|
||||||
|
(λ (that)
|
||||||
|
(raise-syntax-error #f "duplicate keywords"
|
||||||
|
stx that (list kwd-stx)))]
|
||||||
|
[else
|
||||||
|
(hash-set! km kwd kwd-stx)])))
|
||||||
|
|
||||||
|
(for ([dom (in-list (istx-args istx))])
|
||||||
|
(when (arg-kwd dom)
|
||||||
|
(no-kwd-dups (arg-kwd dom)))
|
||||||
|
(no-var-dups (arg-var dom)))
|
||||||
|
|
||||||
|
(when (istx-ress istx)
|
||||||
|
(let ([any-_? #f]
|
||||||
|
[all-_? #t])
|
||||||
|
(for ([rng (in-list (istx-ress istx))])
|
||||||
|
(cond
|
||||||
|
[(free-identifier=? #'_ (res-var rng))
|
||||||
|
(set! any-_? #t)]
|
||||||
|
[else
|
||||||
|
(set! all-_? #f)
|
||||||
|
(no-var-dups (res-var rng))]))
|
||||||
|
(when any-_?
|
||||||
|
(unless all-_?
|
||||||
|
(raise-syntax-error #f "either all of the dependent range variables must be _ or none of them"
|
||||||
|
stx (map res-var (istx-ress istx)))))))
|
||||||
|
|
||||||
|
(when (istx-rst istx)
|
||||||
|
(no-var-dups (rst-var (istx-rst istx))))))
|
||||||
|
|
||||||
|
(define (parse-doms stx optional? doms)
|
||||||
|
(let loop ([doms doms])
|
||||||
|
(syntax-case doms ()
|
||||||
|
[(kwd [id ctc-expr] . rest)
|
||||||
|
(keyword? (syntax-e #'kwd))
|
||||||
|
(begin
|
||||||
|
(check-id stx #'id)
|
||||||
|
(cons (arg #'kwd #'id #f optional? #'ctc-expr)
|
||||||
|
(loop #'rest)))]
|
||||||
|
[(kwd [id (id2 ...) ctc-expr] . rest)
|
||||||
|
(keyword? (syntax-e #'kwd))
|
||||||
|
(begin
|
||||||
|
(check-id stx #'id)
|
||||||
|
(for-each (λ (x) (check-id stx x)) (syntax->list #'(id2 ...)))
|
||||||
|
(cons (arg #'kwd #'id (syntax->list #'(id2 ...)) optional? #'ctc-expr)
|
||||||
|
(loop #'rest)))]
|
||||||
|
[([id ctc-expr] . rest)
|
||||||
|
(begin
|
||||||
|
(check-id stx #'id)
|
||||||
|
(cons (arg #f #'id #f optional? #'ctc-expr)
|
||||||
|
(loop #'rest)))]
|
||||||
|
[([id (id2 ...) ctc-expr] . rest)
|
||||||
|
(begin
|
||||||
|
(check-id stx #'id)
|
||||||
|
(for-each (λ (x) (check-id stx x)) (syntax->list #'(id2 ...)))
|
||||||
|
(cons (arg #f #'id (syntax->list #'(id2 ...)) optional? #'ctc-expr)
|
||||||
|
(loop #'rest)))]
|
||||||
|
[() '()]
|
||||||
|
[(a . rest)
|
||||||
|
(raise-syntax-error #f "expected an argument specification" stx #'a)])))
|
||||||
|
|
||||||
|
(define (parse-range stx range)
|
||||||
|
(syntax-case range (any values) #;(λ (x y) (eq? (syntax-e x) (syntax-e y)))
|
||||||
|
[(values ctc-pr ...)
|
||||||
|
(map (λ (x) (syntax-case x ()
|
||||||
|
[[id ctc]
|
||||||
|
(begin
|
||||||
|
(check-id stx #'id)
|
||||||
|
(res #'id #f #'ctc))]
|
||||||
|
[[id (id2 ...) ctc]
|
||||||
|
(begin
|
||||||
|
(check-id stx #'id)
|
||||||
|
(for-each (λ (x) (check-id stx x)) (syntax->list #'(id2 ...)))
|
||||||
|
(res #'id (syntax->list #'(id2 ...)) #'ctc))]
|
||||||
|
[x (raise-syntax-error #f "expected binding pair" stx #'x)]))
|
||||||
|
(syntax->list #'(ctc-pr ...)))]
|
||||||
|
[any #f]
|
||||||
|
[[id ctc]
|
||||||
|
(begin
|
||||||
|
(check-id stx #'id)
|
||||||
|
(list (res #'id #f #'ctc)))]
|
||||||
|
[[id (id2 ...) ctc]
|
||||||
|
(begin
|
||||||
|
(check-id stx #'id)
|
||||||
|
(for-each (λ (x) (check-id stx x)) (syntax->list #'(id2 ...)))
|
||||||
|
(list (res #'id (syntax->list #'(id2 ...)) #'ctc)))]
|
||||||
|
[x (raise-syntax-error #f "expected the range portion" stx #'x)]))
|
||||||
|
|
||||||
|
(define (check-id stx id)
|
||||||
|
(unless (identifier? id)
|
||||||
|
(raise-syntax-error #f "expected an identifier" stx id)))
|
||||||
|
|
||||||
;; pull-out-pieces : stx -> (values raw-mandatory-doms raw-optional-doms id/rest-id pre-cond range post-cond)
|
;; pull-out-pieces : stx -> (values raw-mandatory-doms raw-optional-doms id/rest-id pre-cond range post-cond)
|
||||||
(define (pull-out-pieces stx)
|
(define (pull-out-pieces stx)
|
||||||
(let*-values ([(raw-mandatory-doms leftover)
|
(let*-values ([(raw-mandatory-doms leftover)
|
||||||
(syntax-case stx ()
|
(syntax-case stx ()
|
||||||
[((raw-mandatory-doms ...) . leftover)
|
[(_ (raw-mandatory-doms ...) . leftover)
|
||||||
(values (syntax->list #'(raw-mandatory-doms ...))
|
(values (syntax->list #'(raw-mandatory-doms ...))
|
||||||
#'leftover)]
|
#'leftover)]
|
||||||
[(a . leftover)
|
[(_ a . leftover)
|
||||||
(raise-syntax-error #f "expected a sequence of mandatory domain elements" stx #'a)]
|
(raise-syntax-error #f "expected a sequence of mandatory domain elements" stx #'a)]
|
||||||
[_
|
[_
|
||||||
(raise-syntax-error #f "expected a sequence of mandatory domain elements" stx)])]
|
(raise-syntax-error #f "expected a sequence of mandatory domain elements" stx)])]
|
||||||
|
@ -65,21 +190,30 @@ and then operates on it to generate the expanded form
|
||||||
[_ (values '() leftover)])]
|
[_ (values '() leftover)])]
|
||||||
[(id/rest-id leftover)
|
[(id/rest-id leftover)
|
||||||
(syntax-case leftover ()
|
(syntax-case leftover ()
|
||||||
[(#:rest id rest-expr . leftover)
|
[(#:rest [id rest-expr] . leftover)
|
||||||
(and (identifier? #'id)
|
|
||||||
(not (keyword? (syntax-e #'rest-expr))))
|
|
||||||
(values #'(id rest-expr) #'leftover)]
|
|
||||||
[(#:rest id (id2 ...) rest-expr . leftover)
|
|
||||||
(and (identifier? #'id)
|
|
||||||
(andmap identifier? (syntax->list #'(id2 ...)))
|
|
||||||
(not (keyword? (syntax-e #'rest-expr))))
|
|
||||||
(values #'(id rest-expr) #'leftover)]
|
|
||||||
[(#:rest id rest-expr . leftover)
|
|
||||||
(begin
|
(begin
|
||||||
(unless (identifier? #'id)
|
(check-id stx #'id)
|
||||||
(raise-syntax-error #f "expected an identifier" stx #'id))
|
(values (rst #'id #f #'rest-expr)
|
||||||
(when (keyword? (syntax-e #'rest-expr))
|
#'leftover))]
|
||||||
(raise-syntax-error #f "expected an expression, not a keyword" stx #'rest-expr)))]
|
[(#:rest [id (id2 ...) rest-expr] . leftover)
|
||||||
|
(begin
|
||||||
|
(check-id stx #'id)
|
||||||
|
(for-each (λ (x) (check-id stx x))
|
||||||
|
(syntax->list #'(id2 ...)))
|
||||||
|
(values (rst #'id
|
||||||
|
(syntax->list #'(id2 ...))
|
||||||
|
#'rest-expr)
|
||||||
|
#'leftover))]
|
||||||
|
[(#:rest other . leftover)
|
||||||
|
(raise-syntax-error #f "expected an id+ctc"
|
||||||
|
stx
|
||||||
|
#'other)]
|
||||||
|
[(x)
|
||||||
|
(eq? (syntax-e #'x) '#:rest)
|
||||||
|
(raise-syntax-error
|
||||||
|
#f
|
||||||
|
"expected something to follow #:rest"
|
||||||
|
stx #'x)]
|
||||||
[_ (values #f leftover)])]
|
[_ (values #f leftover)])]
|
||||||
[(pre-cond leftover)
|
[(pre-cond leftover)
|
||||||
(syntax-case leftover ()
|
(syntax-case leftover ()
|
||||||
|
@ -89,8 +223,8 @@ and then operates on it to generate the expanded form
|
||||||
[(range leftover)
|
[(range leftover)
|
||||||
(syntax-case leftover ()
|
(syntax-case leftover ()
|
||||||
[(range . leftover) (values #'range #'leftover)]
|
[(range . leftover) (values #'range #'leftover)]
|
||||||
[_
|
[()
|
||||||
(raise-syntax-error #f "expected a range expression, but found nothing" stx)])]
|
(raise-syntax-error #f "expected a range expression, but found nothing" stx leftover)])]
|
||||||
[(post-cond leftover)
|
[(post-cond leftover)
|
||||||
(syntax-case leftover ()
|
(syntax-case leftover ()
|
||||||
[(#:post-cond post-cond . leftover)
|
[(#:post-cond post-cond . leftover)
|
||||||
|
@ -106,6 +240,12 @@ and then operates on it to generate the expanded form
|
||||||
[_
|
[_
|
||||||
(raise-syntax-error #f "bad syntax" stx)])))
|
(raise-syntax-error #f "bad syntax" stx)])))
|
||||||
|
|
||||||
|
;(define (ensure-no-cycles istx)
|
||||||
|
; (let (;; cm : id -o> {'pending, 'no-cycle}
|
||||||
|
; [cm (make-free-identifier-map)])
|
||||||
|
; (for ([dom (in-list (istx-args istx))])
|
||||||
|
; (let loop ([id (
|
||||||
|
|
||||||
(provide
|
(provide
|
||||||
parse-->i
|
parse-->i
|
||||||
(struct-out istx)
|
(struct-out istx)
|
||||||
|
|
|
@ -3,13 +3,15 @@
|
||||||
(require "guts.rkt"
|
(require "guts.rkt"
|
||||||
"arrow.rkt"
|
"arrow.rkt"
|
||||||
"opt.rkt"
|
"opt.rkt"
|
||||||
racket/stxparam)
|
racket/stxparam
|
||||||
(require (for-syntax racket/base)
|
|
||||||
(for-syntax "opt-guts.rkt")
|
(for-syntax racket/base
|
||||||
(for-syntax "helpers.rkt")
|
syntax/stx
|
||||||
(for-syntax syntax/stx)
|
syntax/name
|
||||||
(for-syntax syntax/name)
|
"arr-i-parse.rkt"
|
||||||
(for-syntax "arr-util.rkt"))
|
"opt-guts.rkt"
|
||||||
|
"helpers.rkt"
|
||||||
|
"arr-util.rkt"))
|
||||||
|
|
||||||
(provide ->i)
|
(provide ->i)
|
||||||
|
|
||||||
|
@ -34,21 +36,17 @@
|
||||||
[_ (values '() leftover)])]
|
[_ (values '() leftover)])]
|
||||||
[(id/rest-id leftover)
|
[(id/rest-id leftover)
|
||||||
(syntax-case leftover ()
|
(syntax-case leftover ()
|
||||||
[(#:rest id rest-expr . leftover)
|
[(#:rest [id rest-expr] . leftover)
|
||||||
(and (identifier? #'id)
|
(and (identifier? #'id)
|
||||||
(not (keyword? (syntax-e #'rest-expr))))
|
(not (keyword? (syntax-e #'rest-expr))))
|
||||||
(values #'(id rest-expr) #'leftover)]
|
(values #'(id rest-expr) #'leftover)]
|
||||||
[(#:rest id (id2 ...) rest-expr . leftover)
|
[(#:rest [id (id2 ...) rest-expr] . leftover)
|
||||||
(and (identifier? #'id)
|
(and (identifier? #'id)
|
||||||
(andmap identifier? (syntax->list #'(id2 ...)))
|
(andmap identifier? (syntax->list #'(id2 ...)))
|
||||||
(not (keyword? (syntax-e #'rest-expr))))
|
(not (keyword? (syntax-e #'rest-expr))))
|
||||||
(values #'(id rest-expr) #'leftover)]
|
(values #'(id rest-expr) #'leftover)]
|
||||||
[(#:rest id rest-expr . leftover)
|
[(#:rest something . leftover)
|
||||||
(begin
|
(raise-syntax-error #f "expected id+ctc" stx #'something)]
|
||||||
(unless (identifier? #'id)
|
|
||||||
(raise-syntax-error #f "expected an identifier" stx #'id))
|
|
||||||
(when (keyword? (syntax-e #'rest-expr))
|
|
||||||
(raise-syntax-error #f "expected an expression, not a keyword" stx #'rest-expr)))]
|
|
||||||
[_ (values #f leftover)])]
|
[_ (values #f leftover)])]
|
||||||
[(pre-cond leftover)
|
[(pre-cond leftover)
|
||||||
(syntax-case leftover ()
|
(syntax-case leftover ()
|
||||||
|
@ -145,6 +143,8 @@
|
||||||
(values pre post)))
|
(values pre post)))
|
||||||
|
|
||||||
(define-syntax (->i stx)
|
(define-syntax (->i stx)
|
||||||
|
(parse-->i stx)
|
||||||
|
(printf "finished ->i parsing\n")
|
||||||
(syntax-case stx ()
|
(syntax-case stx ()
|
||||||
[(_ (raw-mandatory-doms ...)
|
[(_ (raw-mandatory-doms ...)
|
||||||
.
|
.
|
||||||
|
|
|
@ -1,6 +1,12 @@
|
||||||
#lang racket/base
|
#lang racket/base
|
||||||
(require racket/contract)
|
(require racket/contract)
|
||||||
|
|
||||||
|
(let ([c integer?])
|
||||||
|
(->i ((arg any/c)) () (values (_ (arg) c) (x (arg) c) (_ (arg) c))))
|
||||||
|
; => all or none _s
|
||||||
|
|
||||||
|
|
||||||
|
#;
|
||||||
(->i (#:kwd1 [x number?]
|
(->i (#:kwd1 [x number?]
|
||||||
#:kwd2 [y number?])
|
#:kwd2 [y number?])
|
||||||
#:rest [x any/c]
|
#:rest [x any/c]
|
||||||
|
@ -56,4 +62,9 @@ test cases:
|
||||||
[x number?])
|
[x number?])
|
||||||
;=> duplicate identifier 'x'
|
;=> duplicate identifier 'x'
|
||||||
|
|
||||||
|
(let ([c integer?])
|
||||||
|
(->i ((arg any/c)) () (values (_ (arg) c) (x (arg) c) (_ (arg) c))))
|
||||||
|
; => all or none _s
|
||||||
|
|
||||||
|
|
||||||
|#
|
|#
|
||||||
|
|
|
@ -516,7 +516,7 @@ symbols, and that return a symbol.
|
||||||
(code:line keyword id+ctc)]
|
(code:line keyword id+ctc)]
|
||||||
[optional-dependent-dom id+ctc
|
[optional-dependent-dom id+ctc
|
||||||
(code:line keyword id+ctc)]
|
(code:line keyword id+ctc)]
|
||||||
[dependent-rest (code:line) (code:line #:rest id rest-expr)]
|
[dependent-rest (code:line) (code:line #:rest id+ctc)]
|
||||||
[pre-condition (code:line) (code:line #:pre-cond boolean-expr)]
|
[pre-condition (code:line) (code:line #:pre-cond boolean-expr)]
|
||||||
[dependent-range any
|
[dependent-range any
|
||||||
id+ctc
|
id+ctc
|
||||||
|
|
|
@ -185,8 +185,8 @@
|
||||||
(test/no-error '(->i ([x integer?]) ([y integer?]) any))
|
(test/no-error '(->i ([x integer?]) ([y integer?]) any))
|
||||||
(test/no-error '(->i ([x integer?]) ([y integer?]) (values [a number?] [b boolean?])))
|
(test/no-error '(->i ([x integer?]) ([y integer?]) (values [a number?] [b boolean?])))
|
||||||
(test/no-error '(->i ([x integer?] #:z [z integer?]) ([y integer?] #:w [w integer?]) (range boolean?)))
|
(test/no-error '(->i ([x integer?] #:z [z integer?]) ([y integer?] #:w [w integer?]) (range boolean?)))
|
||||||
(test/no-error '(->i ([x integer?] #:z [z integer?]) ([y integer?] #:w [w integer?]) #:rest rest any/c (range boolean?)))
|
(test/no-error '(->i ([x integer?] #:z [z integer?]) ([y integer?] #:w [w integer?]) #:rest [rest any/c] (range boolean?)))
|
||||||
(test/no-error '(->i ([x integer?] #:z [z integer?]) #:rest rest any/c (range boolean?)))
|
(test/no-error '(->i ([x integer?] #:z [z integer?]) #:rest [rest any/c] (range boolean?)))
|
||||||
|
|
||||||
(test/no-error '(unconstrained-domain-> number?))
|
(test/no-error '(unconstrained-domain-> number?))
|
||||||
(test/no-error '(unconstrained-domain-> (flat-contract number?)))
|
(test/no-error '(unconstrained-domain-> (flat-contract number?)))
|
||||||
|
@ -1803,51 +1803,51 @@
|
||||||
|
|
||||||
(test/spec-passed
|
(test/spec-passed
|
||||||
'->i11
|
'->i11
|
||||||
'((contract (->i () () #:rest rest any/c [r number?]) (lambda x 1) 'pos 'neg)))
|
'((contract (->i () () #:rest [rest any/c] [r number?]) (lambda x 1) 'pos 'neg)))
|
||||||
|
|
||||||
(test/spec-passed
|
(test/spec-passed
|
||||||
'->i12
|
'->i12
|
||||||
'((contract (->i ([x number?]) () #:rest rest any/c [r number?]) (lambda (x . y) (+ x 1)) 'pos 'neg) 1))
|
'((contract (->i ([x number?]) () #:rest [rest any/c] [r number?]) (lambda (x . y) (+ x 1)) 'pos 'neg) 1))
|
||||||
|
|
||||||
(test/pos-blame
|
(test/pos-blame
|
||||||
'->i13
|
'->i13
|
||||||
'((contract (->i () () #:rest rest any/c [r number?]) 1 'pos 'neg)))
|
'((contract (->i () () #:rest [rest any/c] [r number?]) 1 'pos 'neg)))
|
||||||
|
|
||||||
(test/pos-blame
|
(test/pos-blame
|
||||||
'->i14
|
'->i14
|
||||||
'((contract (->i () () #:rest rest any/c [r number?]) (lambda (x) x) 'pos 'neg)))
|
'((contract (->i () () #:rest [rest any/c] [r number?]) (lambda (x) x) 'pos 'neg)))
|
||||||
|
|
||||||
(test/neg-blame
|
(test/neg-blame
|
||||||
'->i15
|
'->i15
|
||||||
'((contract (->i ([x number?]) () #:rest rest any/c any) (lambda (x . y) (+ x 1)) 'pos 'neg) #f))
|
'((contract (->i ([x number?]) () #:rest [rest any/c] any) (lambda (x . y) (+ x 1)) 'pos 'neg) #f))
|
||||||
|
|
||||||
(test/pos-blame
|
(test/pos-blame
|
||||||
'->i16
|
'->i16
|
||||||
'((contract (->i ([x number?]) () #:rest rest any/c [r (x) (<=/c x)]) (lambda (x . y) (+ x 1)) 'pos 'neg) 1))
|
'((contract (->i ([x number?]) () #:rest [rest any/c] [r (x) (<=/c x)]) (lambda (x . y) (+ x 1)) 'pos 'neg) 1))
|
||||||
|
|
||||||
(test/spec-passed
|
(test/spec-passed
|
||||||
'->i17
|
'->i17
|
||||||
'((contract (->i ([x number?] [y (x) (<=/c x)]) () #:rest rest any/c [r (x) (<=/c x)]) (lambda (x y . z) (- x 1)) 'pos 'neg) 1 0))
|
'((contract (->i ([x number?] [y (x) (<=/c x)]) () #:rest [rest any/c] [r (x) (<=/c x)]) (lambda (x y . z) (- x 1)) 'pos 'neg) 1 0))
|
||||||
|
|
||||||
(test/neg-blame
|
(test/neg-blame
|
||||||
'->i18
|
'->i18
|
||||||
'((contract (->i ([x number?] [y (x) (<=/c x)]) () #:rest rest any/c [r (x) (<=/c x)]) (lambda (x y . z) (+ x 1)) 'pos 'neg) 1 2))
|
'((contract (->i ([x number?] [y (x) (<=/c x)]) () #:rest [rest any/c] [r (x) (<=/c x)]) (lambda (x y . z) (+ x 1)) 'pos 'neg) 1 2))
|
||||||
|
|
||||||
(test/spec-passed
|
(test/spec-passed
|
||||||
'->i19
|
'->i19
|
||||||
'((contract (->i ([y (x) (<=/c x)] [x number?]) () #:rest rest any/c [r (x) (<=/c x)]) (lambda (y x . z) (- x 1)) 'pos 'neg) 1 2))
|
'((contract (->i ([y (x) (<=/c x)] [x number?]) () #:rest [rest any/c] [r (x) (<=/c x)]) (lambda (y x . z) (- x 1)) 'pos 'neg) 1 2))
|
||||||
|
|
||||||
(test/neg-blame
|
(test/neg-blame
|
||||||
'->i20
|
'->i20
|
||||||
'((contract (->i ([y (x) (<=/c x)] [x number?]) () #:rest rest any/c [r (x) (<=/c x)]) (lambda (y x . z) (+ x 1)) 'pos 'neg) 1 0))
|
'((contract (->i ([y (x) (<=/c x)] [x number?]) () #:rest [rest any/c] [r (x) (<=/c x)]) (lambda (y x . z) (+ x 1)) 'pos 'neg) 1 0))
|
||||||
|
|
||||||
(test/spec-passed
|
(test/spec-passed
|
||||||
'->i21
|
'->i21
|
||||||
'((contract (->i () () #:rest rst (listof number?) [r any/c]) (lambda w 1) 'pos 'neg) 1))
|
'((contract (->i () () #:rest [rst (listof number?)] [r any/c]) (lambda w 1) 'pos 'neg) 1))
|
||||||
|
|
||||||
(test/neg-blame
|
(test/neg-blame
|
||||||
'->i22
|
'->i22
|
||||||
'((contract (->i () () #:rest rst (listof number?) [r any/c]) (lambda w 1) 'pos 'neg) #f))
|
'((contract (->i () () #:rest [rst (listof number?)] [r any/c]) (lambda w 1) 'pos 'neg) #f))
|
||||||
|
|
||||||
(test/spec-passed
|
(test/spec-passed
|
||||||
'->i-any1
|
'->i-any1
|
||||||
|
@ -1887,47 +1887,47 @@
|
||||||
|
|
||||||
(test/spec-passed
|
(test/spec-passed
|
||||||
'->i-any10
|
'->i-any10
|
||||||
'((contract (->i () () #:rest rest any/c any) (lambda x 1) 'pos 'neg)))
|
'((contract (->i () () #:rest [rest any/c] any) (lambda x 1) 'pos 'neg)))
|
||||||
|
|
||||||
(test/spec-passed
|
(test/spec-passed
|
||||||
'->i-any11
|
'->i-any11
|
||||||
'((contract (->i ([x number?]) () #:rest rest any/c any) (lambda (x . y) (+ x 1)) 'pos 'neg) 1))
|
'((contract (->i ([x number?]) () #:rest [rest any/c] any) (lambda (x . y) (+ x 1)) 'pos 'neg) 1))
|
||||||
|
|
||||||
(test/pos-blame
|
(test/pos-blame
|
||||||
'->i-any12
|
'->i-any12
|
||||||
'((contract (->i () () #:rest rest any/c any) 1 'pos 'neg)))
|
'((contract (->i () () #:rest [rest any/c] any) 1 'pos 'neg)))
|
||||||
|
|
||||||
(test/pos-blame
|
(test/pos-blame
|
||||||
'->i-any13
|
'->i-any13
|
||||||
'((contract (->i () () #:rest rest any/c any) (lambda (x) x) 'pos 'neg)))
|
'((contract (->i () () #:rest [rest any/c] any) (lambda (x) x) 'pos 'neg)))
|
||||||
|
|
||||||
(test/neg-blame
|
(test/neg-blame
|
||||||
'->i-any14
|
'->i-any14
|
||||||
'((contract (->i ([x number?]) () #:rest rest any/c any) (lambda (x . y) (+ x 1)) 'pos 'neg) #f))
|
'((contract (->i ([x number?]) () #:rest [rest any/c] any) (lambda (x . y) (+ x 1)) 'pos 'neg) #f))
|
||||||
|
|
||||||
(test/spec-passed
|
(test/spec-passed
|
||||||
'->i-any15
|
'->i-any15
|
||||||
'((contract (->i ([x number?] [y (x) (<=/c x)]) () #:rest rest any/c any) (lambda (x y . z) (- x 1)) 'pos 'neg) 1 0))
|
'((contract (->i ([x number?] [y (x) (<=/c x)]) () #:rest [rest any/c] any) (lambda (x y . z) (- x 1)) 'pos 'neg) 1 0))
|
||||||
|
|
||||||
(test/neg-blame
|
(test/neg-blame
|
||||||
'->i-any16
|
'->i-any16
|
||||||
'((contract (->i ([x number?] [y (x) (<=/c x)]) () #:rest rest any/c any) (lambda (x y . z) (+ x 1)) 'pos 'neg) 1 2))
|
'((contract (->i ([x number?] [y (x) (<=/c x)]) () #:rest [rest any/c] any) (lambda (x y . z) (+ x 1)) 'pos 'neg) 1 2))
|
||||||
|
|
||||||
(test/spec-passed
|
(test/spec-passed
|
||||||
'->i-any17
|
'->i-any17
|
||||||
'((contract (->i ([y (x) (<=/c x)] [x number?]) () #:rest rest any/c any) (lambda (y x . z) (- x 1)) 'pos 'neg) 1 2))
|
'((contract (->i ([y (x) (<=/c x)] [x number?]) () #:rest [rest any/c] any) (lambda (y x . z) (- x 1)) 'pos 'neg) 1 2))
|
||||||
|
|
||||||
(test/neg-blame
|
(test/neg-blame
|
||||||
'->i-any18
|
'->i-any18
|
||||||
'((contract (->i ([y (x) (<=/c x)] [x number?]) () #:rest rest any/c any) (lambda (y x . z) (+ x 1)) 'pos 'neg) 1 0))
|
'((contract (->i ([y (x) (<=/c x)] [x number?]) () #:rest [rest any/c] any) (lambda (y x . z) (+ x 1)) 'pos 'neg) 1 0))
|
||||||
|
|
||||||
(test/spec-passed
|
(test/spec-passed
|
||||||
'->i-any19
|
'->i-any19
|
||||||
'((contract (->i () () #:rest rst (listof number?) any) (lambda w 1) 'pos 'neg) 1))
|
'((contract (->i () () #:rest [rst (listof number?)] any) (lambda w 1) 'pos 'neg) 1))
|
||||||
|
|
||||||
(test/neg-blame
|
(test/neg-blame
|
||||||
'->i-any20
|
'->i-any20
|
||||||
'((contract (->i () () #:rest rst (listof number?) any) (lambda w 1) 'pos 'neg) #f))
|
'((contract (->i () () #:rest [rst (listof number?)] any) (lambda w 1) 'pos 'neg) #f))
|
||||||
|
|
||||||
(test/spec-passed
|
(test/spec-passed
|
||||||
'->i-values1
|
'->i-values1
|
||||||
|
@ -1988,11 +1988,11 @@
|
||||||
|
|
||||||
(test/spec-passed
|
(test/spec-passed
|
||||||
'->i-values11
|
'->i-values11
|
||||||
'((contract (->i () () #:rest rest any/c (values [z boolean?] [w number?])) (lambda x (values #f 1)) 'pos 'neg)))
|
'((contract (->i () () #:rest [rest any/c] (values [z boolean?] [w number?])) (lambda x (values #f 1)) 'pos 'neg)))
|
||||||
|
|
||||||
(test/spec-passed
|
(test/spec-passed
|
||||||
'->i-values12
|
'->i-values12
|
||||||
'((contract (->i ([x number?]) () #:rest rest any/c (values [z boolean?] [w number?]))
|
'((contract (->i ([x number?]) () #:rest [rest any/c] (values [z boolean?] [w number?]))
|
||||||
(lambda (x . y) (values #f (+ x 1)))
|
(lambda (x . y) (values #f (+ x 1)))
|
||||||
'pos
|
'pos
|
||||||
'neg)
|
'neg)
|
||||||
|
@ -2000,55 +2000,55 @@
|
||||||
|
|
||||||
(test/pos-blame
|
(test/pos-blame
|
||||||
'->i-values13
|
'->i-values13
|
||||||
'((contract (->i () () #:rest rest any/c (values [z boolean?] [w number?])) 1 'pos 'neg)))
|
'((contract (->i () () #:rest [rest any/c] (values [z boolean?] [w number?])) 1 'pos 'neg)))
|
||||||
|
|
||||||
(test/pos-blame
|
(test/pos-blame
|
||||||
'->i-values14
|
'->i-values14
|
||||||
'((contract (->i () () #:rest rest any/c (values [z boolean?] [w number?])) (lambda (x) x) 'pos 'neg)))
|
'((contract (->i () () #:rest [rest any/c] (values [z boolean?] [w number?])) (lambda (x) x) 'pos 'neg)))
|
||||||
|
|
||||||
(test/neg-blame
|
(test/neg-blame
|
||||||
'->i-values15
|
'->i-values15
|
||||||
'((contract (->i ([x number?]) () #:rest rest any/c (values [z boolean?] [w (x) (<=/c x)]))
|
'((contract (->i ([x number?]) () #:rest [rest any/c] (values [z boolean?] [w (x) (<=/c x)]))
|
||||||
(lambda (x . y) (+ x 1)) 'pos 'neg)
|
(lambda (x . y) (+ x 1)) 'pos 'neg)
|
||||||
#f))
|
#f))
|
||||||
|
|
||||||
(test/pos-blame
|
(test/pos-blame
|
||||||
'->i-values16
|
'->i-values16
|
||||||
'((contract (->i ([x number?]) () #:rest rest any/c (values [z boolean?] [w (x) (<=/c x)]))
|
'((contract (->i ([x number?]) () #:rest [rest any/c] (values [z boolean?] [w (x) (<=/c x)]))
|
||||||
(lambda (x . y) (values #f (+ x 1))) 'pos 'neg)
|
(lambda (x . y) (values #f (+ x 1))) 'pos 'neg)
|
||||||
1))
|
1))
|
||||||
|
|
||||||
(test/spec-passed
|
(test/spec-passed
|
||||||
'->i-values17
|
'->i-values17
|
||||||
'((contract (->i ([x number?] [y (x) (<=/c x)]) () #:rest rest any/c (values [z boolean?] [w (x) (<=/c x)]))
|
'((contract (->i ([x number?] [y (x) (<=/c x)]) () #:rest [rest any/c] (values [z boolean?] [w (x) (<=/c x)]))
|
||||||
(lambda (x y . z) (values #f (- x 1))) 'pos 'neg)
|
(lambda (x y . z) (values #f (- x 1))) 'pos 'neg)
|
||||||
1 0))
|
1 0))
|
||||||
|
|
||||||
(test/neg-blame
|
(test/neg-blame
|
||||||
'->i-values18
|
'->i-values18
|
||||||
'((contract (->i ([x number?] [y (x) (<=/c x)]) () #:rest rest any/c (values [z boolean?] [w (x) (<=/c x)]))
|
'((contract (->i ([x number?] [y (x) (<=/c x)]) () #:rest [rest any/c] (values [z boolean?] [w (x) (<=/c x)]))
|
||||||
(lambda (x y . z) (values #f (+ x 1))) 'pos 'neg)
|
(lambda (x y . z) (values #f (+ x 1))) 'pos 'neg)
|
||||||
1 2))
|
1 2))
|
||||||
|
|
||||||
(test/spec-passed
|
(test/spec-passed
|
||||||
'->i-values19
|
'->i-values19
|
||||||
'((contract (->i ([y (x) (<=/c x)] [x number?]) () #:rest rest any/c (values [z boolean?] [w (x) (<=/c x)]))
|
'((contract (->i ([y (x) (<=/c x)] [x number?]) () #:rest [rest any/c] (values [z boolean?] [w (x) (<=/c x)]))
|
||||||
(lambda (y x . z) (values #f (- x 1))) 'pos 'neg)
|
(lambda (y x . z) (values #f (- x 1))) 'pos 'neg)
|
||||||
1 2))
|
1 2))
|
||||||
|
|
||||||
(test/neg-blame
|
(test/neg-blame
|
||||||
'->i-values20
|
'->i-values20
|
||||||
'((contract (->i ([y (x) (<=/c x)] [x number?]) () #:rest rest any/c (values [z boolean?] [w (x) (<=/c x)]))
|
'((contract (->i ([y (x) (<=/c x)] [x number?]) () #:rest [rest any/c] (values [z boolean?] [w (x) (<=/c x)]))
|
||||||
(lambda (y x . z) (values #f (+ x 1))) 'pos 'neg)
|
(lambda (y x . z) (values #f (+ x 1))) 'pos 'neg)
|
||||||
1 0))
|
1 0))
|
||||||
|
|
||||||
(test/spec-passed
|
(test/spec-passed
|
||||||
'->i-values21
|
'->i-values21
|
||||||
'((contract (->i () () #:rest rst (listof number?) (values [z boolean?] [w any/c])) (lambda w (values #f 1)) 'pos 'neg) 1))
|
'((contract (->i () () #:rest [rst (listof number?)] (values [z boolean?] [w any/c])) (lambda w (values #f 1)) 'pos 'neg) 1))
|
||||||
|
|
||||||
(test/neg-blame
|
(test/neg-blame
|
||||||
'->i-values22
|
'->i-values22
|
||||||
'((contract (->i () () #:rest rst (listof number?) (values [z boolean?] [w any/c])) (lambda w (values #f 1)) 'pos 'neg) #f))
|
'((contract (->i () () #:rest [rst (listof number?)] (values [z boolean?] [w any/c])) (lambda w (values #f 1)) 'pos 'neg) #f))
|
||||||
|
|
||||||
(test/spec-passed
|
(test/spec-passed
|
||||||
'->i-values23
|
'->i-values23
|
||||||
|
@ -2101,7 +2101,7 @@
|
||||||
|
|
||||||
(test/spec-passed/result
|
(test/spec-passed/result
|
||||||
'->i26
|
'->i26
|
||||||
'((contract (->i ((i number?) (j (i) (and/c number? (>=/c i)))) () #:rest rest-args any/c [r number?])
|
'((contract (->i ((i number?) (j (i) (and/c number? (>=/c i)))) () #:rest [rest-args any/c] [r number?])
|
||||||
(λ (i j . z) 1)
|
(λ (i j . z) 1)
|
||||||
'pos
|
'pos
|
||||||
'neg)
|
'neg)
|
||||||
|
@ -2111,7 +2111,7 @@
|
||||||
|
|
||||||
(test/spec-passed/result
|
(test/spec-passed/result
|
||||||
'->i27
|
'->i27
|
||||||
'((contract (->i ((i number?) (j (i) (and/c number? (>=/c i)))) () #:rest rest-args any/c any)
|
'((contract (->i ((i number?) (j (i) (and/c number? (>=/c i)))) () #:rest [rest-args any/c] any)
|
||||||
(λ (i j . z) 1)
|
(λ (i j . z) 1)
|
||||||
'pos
|
'pos
|
||||||
'neg)
|
'neg)
|
||||||
|
@ -2123,7 +2123,7 @@
|
||||||
'->i28
|
'->i28
|
||||||
'(call-with-values
|
'(call-with-values
|
||||||
(λ ()
|
(λ ()
|
||||||
((contract (->i ((i number?) (j (i) (and/c number? (>=/c i)))) () #:rest rest-args any/c (values [x number?] [y number?]))
|
((contract (->i ((i number?) (j (i) (and/c number? (>=/c i)))) () #:rest [rest-args any/c] (values [x number?] [y number?]))
|
||||||
(λ (i j . z) (values 1 2))
|
(λ (i j . z) (values 1 2))
|
||||||
'pos
|
'pos
|
||||||
'neg)
|
'neg)
|
||||||
|
@ -2134,7 +2134,7 @@
|
||||||
|
|
||||||
(test/neg-blame
|
(test/neg-blame
|
||||||
'->i30
|
'->i30
|
||||||
'((contract (->i ([x number?]) () #:rest rst number? any)
|
'((contract (->i ([x number?]) () #:rest [rst number?] any)
|
||||||
(λ (x . rst) (values 4 5))
|
(λ (x . rst) (values 4 5))
|
||||||
'pos
|
'pos
|
||||||
'neg)
|
'neg)
|
||||||
|
@ -2238,7 +2238,7 @@
|
||||||
|
|
||||||
(test/pos-blame
|
(test/pos-blame
|
||||||
'->i-pp-r1
|
'->i-pp-r1
|
||||||
'((contract (->i ([x number?]) () #:rest rst any/c #:pre-cond (= x 1) [result number?] #:post-cond (= x 2))
|
'((contract (->i ([x number?]) () #:rest [rst any/c] #:pre-cond (= x 1) [result number?] #:post-cond (= x 2))
|
||||||
(λ (x . rst) x)
|
(λ (x . rst) x)
|
||||||
'pos
|
'pos
|
||||||
'neg)
|
'neg)
|
||||||
|
@ -2246,7 +2246,7 @@
|
||||||
|
|
||||||
(test/neg-blame
|
(test/neg-blame
|
||||||
'->i-pp-r2
|
'->i-pp-r2
|
||||||
'((contract (->i ([x number?]) () #:rest rst any/c #:pre-cond (= x 1) [result number?] #:post-cond (= x 2))
|
'((contract (->i ([x number?]) () #:rest [rst any/c] #:pre-cond (= x 1) [result number?] #:post-cond (= x 2))
|
||||||
(λ (x . rst) x)
|
(λ (x . rst) x)
|
||||||
'pos
|
'pos
|
||||||
'neg)
|
'neg)
|
||||||
|
@ -2254,7 +2254,7 @@
|
||||||
|
|
||||||
(test/pos-blame
|
(test/pos-blame
|
||||||
'->i-pp-r3
|
'->i-pp-r3
|
||||||
'((contract (->i ([x number?]) () #:rest rst any/c #:pre-cond (= x 1) [result number?] #:post-cond (= result 2))
|
'((contract (->i ([x number?]) () #:rest [rst any/c] #:pre-cond (= x 1) [result number?] #:post-cond (= result 2))
|
||||||
(λ (x . rst) x)
|
(λ (x . rst) x)
|
||||||
'pos
|
'pos
|
||||||
'neg)
|
'neg)
|
||||||
|
@ -2262,7 +2262,7 @@
|
||||||
|
|
||||||
(test/spec-passed
|
(test/spec-passed
|
||||||
'->i-pp-r3.5
|
'->i-pp-r3.5
|
||||||
'((contract (->i ([x number?]) () #:rest rst any/c #:pre-cond (= x 1) [result number?] #:post-cond (= result 2))
|
'((contract (->i ([x number?]) () #:rest [rst any/c] #:pre-cond (= x 1) [result number?] #:post-cond (= result 2))
|
||||||
(λ (x . rst) 2)
|
(λ (x . rst) 2)
|
||||||
'pos
|
'pos
|
||||||
'neg)
|
'neg)
|
||||||
|
@ -2270,7 +2270,7 @@
|
||||||
|
|
||||||
(test/neg-blame
|
(test/neg-blame
|
||||||
'->i-pp-r4
|
'->i-pp-r4
|
||||||
'((contract (->i ([x number?]) () #:rest rst any/c #:pre-cond (= x 1) any)
|
'((contract (->i ([x number?]) () #:rest [rst any/c] #:pre-cond (= x 1) any)
|
||||||
(λ (x . rst) x)
|
(λ (x . rst) x)
|
||||||
'pos
|
'pos
|
||||||
'neg)
|
'neg)
|
||||||
|
@ -2278,7 +2278,7 @@
|
||||||
|
|
||||||
(test/neg-blame
|
(test/neg-blame
|
||||||
'->i-pp-r5
|
'->i-pp-r5
|
||||||
'((contract (->i ([x number?]) () #:rest rst any/c #:pre-cond (= x 1) (values [z number?] [y number?]) #:post-cond (= x y z 3))
|
'((contract (->i ([x number?]) () #:rest [rst any/c] #:pre-cond (= x 1) (values [z number?] [y number?]) #:post-cond (= x y z 3))
|
||||||
(λ (x . rst) (values 4 5))
|
(λ (x . rst) (values 4 5))
|
||||||
'pos
|
'pos
|
||||||
'neg)
|
'neg)
|
||||||
|
@ -2286,7 +2286,7 @@
|
||||||
|
|
||||||
(test/pos-blame
|
(test/pos-blame
|
||||||
'->i-pp-r6
|
'->i-pp-r6
|
||||||
'((contract (->i ([x number?]) () #:rest rst any/c #:pre-cond (= x 1) (values [z number?] [y number?]) #:post-cond (= z x y 3))
|
'((contract (->i ([x number?]) () #:rest [rst any/c] #:pre-cond (= x 1) (values [z number?] [y number?]) #:post-cond (= z x y 3))
|
||||||
(λ (x . rst) (values 4 5))
|
(λ (x . rst) (values 4 5))
|
||||||
'pos
|
'pos
|
||||||
'neg)
|
'neg)
|
||||||
|
@ -2313,7 +2313,7 @@
|
||||||
|
|
||||||
(test/spec-passed
|
(test/spec-passed
|
||||||
'->i-optopt2
|
'->i-optopt2
|
||||||
'((contract (->i ([x number?]) #:rest rst any/c any)
|
'((contract (->i ([x number?]) #:rest [rst any/c] any)
|
||||||
(λ (x . y) x)
|
(λ (x . y) x)
|
||||||
'pos 'neg)
|
'pos 'neg)
|
||||||
1))
|
1))
|
||||||
|
@ -2327,21 +2327,21 @@
|
||||||
|
|
||||||
(test/spec-passed
|
(test/spec-passed
|
||||||
'->i-optopt4
|
'->i-optopt4
|
||||||
'((contract (->i ([x number?]) #:rest rst any/c #:pre-cond #t any)
|
'((contract (->i ([x number?]) #:rest [rst any/c] #:pre-cond #t any)
|
||||||
(λ (x . y) x)
|
(λ (x . y) x)
|
||||||
'pos 'neg)
|
'pos 'neg)
|
||||||
1))
|
1))
|
||||||
|
|
||||||
(test/spec-passed
|
(test/spec-passed
|
||||||
'->i-optopt5
|
'->i-optopt5
|
||||||
'((contract (->i ([x number?]) #:rest rst any/c #:pre-cond #t [res any/c] #:post-cond #t)
|
'((contract (->i ([x number?]) #:rest [rst any/c] #:pre-cond #t [res any/c] #:post-cond #t)
|
||||||
(λ (x . y) x)
|
(λ (x . y) x)
|
||||||
'pos 'neg)
|
'pos 'neg)
|
||||||
1))
|
1))
|
||||||
|
|
||||||
(test/spec-passed
|
(test/spec-passed
|
||||||
'->i-optopt6
|
'->i-optopt6
|
||||||
'((contract (->i ([x number?]) #:rest rst any/c [res any/c] #:post-cond #t)
|
'((contract (->i ([x number?]) #:rest [rst any/c] [res any/c] #:post-cond #t)
|
||||||
(λ (x . y) x)
|
(λ (x . y) x)
|
||||||
'pos 'neg)
|
'pos 'neg)
|
||||||
1))
|
1))
|
||||||
|
@ -2368,7 +2368,7 @@
|
||||||
|
|
||||||
(test/spec-passed
|
(test/spec-passed
|
||||||
'->i-binding1
|
'->i-binding1
|
||||||
'((contract (->i ([x number?]) () #:rest rest any/c [range any/c] #:post-cond (equal? rest '(2 3 4)))
|
'((contract (->i ([x number?]) () #:rest [rest any/c] [range any/c] #:post-cond (equal? rest '(2 3 4)))
|
||||||
(λ (x . y) y)
|
(λ (x . y) y)
|
||||||
'pos
|
'pos
|
||||||
'neg)
|
'neg)
|
||||||
|
@ -2376,7 +2376,7 @@
|
||||||
|
|
||||||
(test/spec-passed
|
(test/spec-passed
|
||||||
'->i-binding2
|
'->i-binding2
|
||||||
'((contract (->i ([x number?]) () #:rest rest any/c [range any/c] #:post-cond (equal? x 1))
|
'((contract (->i ([x number?]) () #:rest [rest any/c] [range any/c] #:post-cond (equal? x 1))
|
||||||
(λ (x . y) y)
|
(λ (x . y) y)
|
||||||
'pos
|
'pos
|
||||||
'neg)
|
'neg)
|
||||||
|
@ -2389,7 +2389,7 @@
|
||||||
[r 'r])
|
[r 'r])
|
||||||
((contract (->i ([x number?] [y number?] #:z [z number?] #:w [w number?])
|
((contract (->i ([x number?] [y number?] #:z [z number?] #:w [w number?])
|
||||||
([a number?] [b number?] #:c [c number?] #:d [d number?])
|
([a number?] [b number?] #:c [c number?] #:d [d number?])
|
||||||
#:rest rest any/c
|
#:rest [rest any/c]
|
||||||
#:pre-cond (equal? (list x y z w a b c d rest p q r)
|
#:pre-cond (equal? (list x y z w a b c d rest p q r)
|
||||||
(list 1 2 3 4 5 6 7 8 '(z) 'p 'q 'r))
|
(list 1 2 3 4 5 6 7 8 '(z) 'p 'q 'r))
|
||||||
(values [p number?] [q number?] [r number?]))
|
(values [p number?] [q number?] [r number?]))
|
||||||
|
@ -2403,7 +2403,7 @@
|
||||||
'->i-binding4
|
'->i-binding4
|
||||||
'((contract (->i ([x number?] [y number?] #:z [z number?] #:w [w number?])
|
'((contract (->i ([x number?] [y number?] #:z [z number?] #:w [w number?])
|
||||||
([a number?] [b number?] #:c [c number?] #:d [d number?])
|
([a number?] [b number?] #:c [c number?] #:d [d number?])
|
||||||
#:rest rest any/c
|
#:rest [rest any/c]
|
||||||
(values [p number?] [q number?] [r number?])
|
(values [p number?] [q number?] [r number?])
|
||||||
#:post-cond (equal? (list x y z w a b c d rest p q r)
|
#:post-cond (equal? (list x y z w a b c d rest p q r)
|
||||||
(list 1 2 3 4 5 6 7 8 '(z) 11 12 13)))
|
(list 1 2 3 4 5 6 7 8 '(z) 11 12 13)))
|
||||||
|
@ -2420,7 +2420,7 @@
|
||||||
[r 'r])
|
[r 'r])
|
||||||
((contract (->i ([x number?] [y number?] #:z [z number?] #:w [w number?])
|
((contract (->i ([x number?] [y number?] #:z [z number?] #:w [w number?])
|
||||||
([a number?] [b number?] #:c [c number?] #:d [d number?])
|
([a number?] [b number?] #:c [c number?] #:d [d number?])
|
||||||
#:rest rest any/c
|
#:rest [rest any/c]
|
||||||
#:pre-cond (equal? (list x y z w a b c d rest p q r)
|
#:pre-cond (equal? (list x y z w a b c d rest p q r)
|
||||||
(list 1 2 3 4
|
(list 1 2 3 4
|
||||||
the-unsupplied-arg the-unsupplied-arg the-unsupplied-arg the-unsupplied-arg
|
the-unsupplied-arg the-unsupplied-arg the-unsupplied-arg the-unsupplied-arg
|
||||||
|
@ -2436,7 +2436,7 @@
|
||||||
'->i-binding6
|
'->i-binding6
|
||||||
'((contract (->i ([x number?] [y number?] #:z [z number?] #:w [w number?])
|
'((contract (->i ([x number?] [y number?] #:z [z number?] #:w [w number?])
|
||||||
([a number?] [b number?] #:c [c number?] #:d [d number?])
|
([a number?] [b number?] #:c [c number?] #:d [d number?])
|
||||||
#:rest rest any/c
|
#:rest [rest any/c]
|
||||||
(values [p number?] [q number?] [r number?])
|
(values [p number?] [q number?] [r number?])
|
||||||
#:post-cond (equal? (list x y z w a b c d rest p q r)
|
#:post-cond (equal? (list x y z w a b c d rest p q r)
|
||||||
(list 1 2 3 4
|
(list 1 2 3 4
|
||||||
|
@ -2453,7 +2453,7 @@
|
||||||
'->i-binding7
|
'->i-binding7
|
||||||
'((contract (->i ()
|
'((contract (->i ()
|
||||||
([a number?])
|
([a number?])
|
||||||
#:rest rest any/c
|
#:rest [rest any/c]
|
||||||
[_ any/c]
|
[_ any/c]
|
||||||
#:post-cond (equal? (list a rest) (list the-unsupplied-arg '())))
|
#:post-cond (equal? (list a rest) (list the-unsupplied-arg '())))
|
||||||
(λ ([a 1] . rest) 1)
|
(λ ([a 1] . rest) 1)
|
||||||
|
@ -2497,7 +2497,7 @@
|
||||||
|
|
||||||
(test/spec-passed/result
|
(test/spec-passed/result
|
||||||
'->i-underscore4
|
'->i-underscore4
|
||||||
'((contract (->i ([str any/c]) () #:rest rest (listof any/c) [_ any/c])
|
'((contract (->i ([str any/c]) () #:rest [rest (listof any/c)] [_ any/c])
|
||||||
(λ (x . y) (cons x y))
|
(λ (x . y) (cons x y))
|
||||||
'pos 'neg)
|
'pos 'neg)
|
||||||
1 2 3)
|
1 2 3)
|
||||||
|
@ -2505,7 +2505,7 @@
|
||||||
|
|
||||||
(test/spec-passed/result
|
(test/spec-passed/result
|
||||||
'->i-underscore5
|
'->i-underscore5
|
||||||
'((contract (->i ([str any/c]) () #:rest rest (listof any/c) [_ any/c])
|
'((contract (->i ([str any/c]) () #:rest [rest (listof any/c)] [_ any/c])
|
||||||
(λ (x . y) (cons x y))
|
(λ (x . y) (cons x y))
|
||||||
'pos 'neg)
|
'pos 'neg)
|
||||||
1 2 3 4 5)
|
1 2 3 4 5)
|
||||||
|
@ -4876,7 +4876,7 @@
|
||||||
|
|
||||||
(test/spec-passed
|
(test/spec-passed
|
||||||
'object-contract-->i3
|
'object-contract-->i3
|
||||||
'(send (contract (object-contract (m (->i () () #:rest rst (listof number?) [range any/c])))
|
'(send (contract (object-contract (m (->i () () #:rest [rst (listof number?)] [range any/c])))
|
||||||
(new (class object% (define/public m (lambda w 1)) (super-new)))
|
(new (class object% (define/public m (lambda w 1)) (super-new)))
|
||||||
'pos
|
'pos
|
||||||
'neg)
|
'neg)
|
||||||
|
@ -4885,7 +4885,7 @@
|
||||||
|
|
||||||
(test/neg-blame
|
(test/neg-blame
|
||||||
'object-contract-->i4
|
'object-contract-->i4
|
||||||
'(send (contract (object-contract (m (->i () () #:rest rst (listof number?) [range any/c])))
|
'(send (contract (object-contract (m (->i () () #:rest [rst (listof number?)] [range any/c])))
|
||||||
(new (class object% (define/public m (lambda w 1)) (super-new)))
|
(new (class object% (define/public m (lambda w 1)) (super-new)))
|
||||||
'pos
|
'pos
|
||||||
'neg)
|
'neg)
|
||||||
|
@ -4942,7 +4942,7 @@
|
||||||
'object-contract-->i/this-3
|
'object-contract-->i/this-3
|
||||||
'(send (contract (object-contract (m (->i ([x (and/c integer? (lambda (x) (= x (get-field f this))))])
|
'(send (contract (object-contract (m (->i ([x (and/c integer? (lambda (x) (= x (get-field f this))))])
|
||||||
()
|
()
|
||||||
#:rest rest-var any/c
|
#:rest [rest-var any/c]
|
||||||
any)))
|
any)))
|
||||||
(new (class object% (field [f 1]) (define/public m (lambda (x . rest) 1)) (super-new)))
|
(new (class object% (field [f 1]) (define/public m (lambda (x . rest) 1)) (super-new)))
|
||||||
'pos
|
'pos
|
||||||
|
@ -4954,7 +4954,7 @@
|
||||||
'object-contract-->i/this-4
|
'object-contract-->i/this-4
|
||||||
'(send (contract (object-contract (m (->i ([x (and/c integer? (lambda (x) (= x (get-field f this))))])
|
'(send (contract (object-contract (m (->i ([x (and/c integer? (lambda (x) (= x (get-field f this))))])
|
||||||
()
|
()
|
||||||
#:rest rest-var any/c
|
#:rest [rest-var any/c]
|
||||||
any)))
|
any)))
|
||||||
(new (class object% (field [f 1]) (define/public m (lambda (x . rest) 1)) (super-new)))
|
(new (class object% (field [f 1]) (define/public m (lambda (x . rest) 1)) (super-new)))
|
||||||
'pos
|
'pos
|
||||||
|
@ -5005,7 +5005,7 @@
|
||||||
|
|
||||||
(test/spec-passed
|
(test/spec-passed
|
||||||
'object-contract-->i-pp3
|
'object-contract-->i-pp3
|
||||||
'(send (contract (object-contract (m (->i () () #:rest rst (listof number?) #:pre-cond #t [unused any/c] #:post-cond #t)))
|
'(send (contract (object-contract (m (->i () () #:rest [rst (listof number?)] #:pre-cond #t [unused any/c] #:post-cond #t)))
|
||||||
(new (class object% (define/public m (lambda w 1)) (super-new)))
|
(new (class object% (define/public m (lambda w 1)) (super-new)))
|
||||||
'pos
|
'pos
|
||||||
'neg)
|
'neg)
|
||||||
|
@ -5014,7 +5014,7 @@
|
||||||
|
|
||||||
(test/neg-blame
|
(test/neg-blame
|
||||||
'object-contract-->i-pp4
|
'object-contract-->i-pp4
|
||||||
'(send (contract (object-contract (m (->i () () #:rest rst (listof number?) #:pre-cond #t [unused any/c] #:post-cond #t)))
|
'(send (contract (object-contract (m (->i () () #:rest [rst (listof number?)] #:pre-cond #t [unused any/c] #:post-cond #t)))
|
||||||
(new (class object% (define/public m (lambda w 1)) (super-new)))
|
(new (class object% (define/public m (lambda w 1)) (super-new)))
|
||||||
'pos
|
'pos
|
||||||
'neg)
|
'neg)
|
||||||
|
@ -5082,7 +5082,7 @@
|
||||||
(test/neg-blame
|
(test/neg-blame
|
||||||
'object-contract-->i-pp/this-4
|
'object-contract-->i-pp/this-4
|
||||||
'(send (contract (object-contract (m (->i () ()
|
'(send (contract (object-contract (m (->i () ()
|
||||||
#:rest rest-id any/c
|
#:rest [rest-id any/c]
|
||||||
#:pre-cond (= 1 (get-field f this))
|
#:pre-cond (= 1 (get-field f this))
|
||||||
[result-x any/c]
|
[result-x any/c]
|
||||||
#:post-cond (= 2 (get-field f this)))))
|
#:post-cond (= 2 (get-field f this)))))
|
||||||
|
@ -5094,7 +5094,7 @@
|
||||||
(test/pos-blame
|
(test/pos-blame
|
||||||
'object-contract-->i-pp/this-5
|
'object-contract-->i-pp/this-5
|
||||||
'(send (contract (object-contract (m (->i () ()
|
'(send (contract (object-contract (m (->i () ()
|
||||||
#:rest rest-id any/c
|
#:rest [rest-id any/c]
|
||||||
#:pre-cond (= 1 (get-field f this))
|
#:pre-cond (= 1 (get-field f this))
|
||||||
[result-x any/c]
|
[result-x any/c]
|
||||||
#:post-cond (= 2 (get-field f this)))))
|
#:post-cond (= 2 (get-field f this)))))
|
||||||
|
@ -5106,7 +5106,7 @@
|
||||||
(test/spec-passed
|
(test/spec-passed
|
||||||
'object-contract-->i-pp/this-6
|
'object-contract-->i-pp/this-6
|
||||||
'(send (contract (object-contract (m (->i () ()
|
'(send (contract (object-contract (m (->i () ()
|
||||||
#:rest rest-id any/c
|
#:rest [rest-id any/c]
|
||||||
#:pre-cond (= 1 (get-field f this))
|
#:pre-cond (= 1 (get-field f this))
|
||||||
[result-x any/c]
|
[result-x any/c]
|
||||||
#:post-cond (= 2 (get-field f this)))))
|
#:post-cond (= 2 (get-field f this)))))
|
||||||
|
@ -8529,8 +8529,8 @@ so that propagation occurs.
|
||||||
(test-name '(object-contract (m (->i ((x ...)) () (y ...)))) (object-contract (m (->i ((x number?)) () [result number?]))))
|
(test-name '(object-contract (m (->i ((x ...)) () (y ...)))) (object-contract (m (->i ((x number?)) () [result number?]))))
|
||||||
(test-name '(object-contract (m (->i ((x ...) (y ...) (z ...)) () [w ...])))
|
(test-name '(object-contract (m (->i ((x ...) (y ...) (z ...)) () [w ...])))
|
||||||
(object-contract (m (->i ((x number?) (y boolean?) (z pair?)) () [result number?]))))
|
(object-contract (m (->i ((x number?) (y boolean?) (z pair?)) () [result number?]))))
|
||||||
(test-name '(object-contract (m (->i ((x ...) (y ...) (z ...)) () #:rest w ... [x0 ...])))
|
(test-name '(object-contract (m (->i ((x ...) (y ...) (z ...)) () #:rest [w ...] [x0 ...])))
|
||||||
(object-contract (m (->i ((x number?) (y boolean?) (z pair?)) () #:rest rest-x any/c [result number?]))))
|
(object-contract (m (->i ((x number?) (y boolean?) (z pair?)) () #:rest [rest-x any/c] [result number?]))))
|
||||||
|#
|
|#
|
||||||
|
|
||||||
(test-name '(promise/c any/c) (promise/c any/c))
|
(test-name '(promise/c any/c) (promise/c any/c))
|
||||||
|
|
Loading…
Reference in New Issue
Block a user