suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fix -struct to use the right number of arguments to make-Struct.

Browse Source
This commit is contained in:
Eric Dobson 2012-09-01 22:54:02 -07:00 committed by Sam Tobin-Hochstadt
parent 6fe850ce39
commit 12233600c1
3 changed files with 11 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
collects/tests/typed-racket/unit-tests/subtype-tests.rkt
View File

@ -118,13 +118,12 @@
[(-poly (b) ((Un (make-Base 'foo #'dummy values #'values #f)
(-struct #'bar #f
(list (make-fld -Number #'values #f) (make-fld b #'values #f))
#'values))
(list (make-fld -Number #'values #f) (make-fld b #'values #f))))
. -> . (-lst b)))
((Un (make-Base 'foo #'dummy values #'values #f) (-struct #'bar #f (list (make-fld -Number #'values #f) (make-fld (-pair -Number (-v a)) #'values #f)) #'values))
((Un (make-Base 'foo #'dummy values #'values #f) (-struct #'bar #f (list (make-fld -Number #'values #f) (make-fld (-pair -Number (-v a)) #'values #f))))
. -> . (-lst (-pair -Number (-v a))))]
[(-poly (b) ((-struct #'bar #f (list (make-fld -Number #'values #f) (make-fld b #'values #f)) #'values) . -> . (-lst b)))
((-struct #'bar #f (list (make-fld -Number #'values #f) (make-fld (-pair -Number (-v a)) #'values #f)) #'values) . -> . (-lst (-pair -Number (-v a))))]
[(-poly (b) ((-struct #'bar #f (list (make-fld -Number #'values #f) (make-fld b #'values #f))) . -> . (-lst b)))
((-struct #'bar #f (list (make-fld -Number #'values #f) (make-fld (-pair -Number (-v a)) #'values #f))) . -> . (-lst (-pair -Number (-v a))))]
[(-poly (a) (a . -> . (make-Listof a))) ((-v b) . -> . (make-Listof (-v b)))]
[(-poly (a) (a . -> . (make-Listof a))) ((-pair -Number (-v b)) . -> . (make-Listof (-pair -Number (-v b))))]
@ -136,9 +135,9 @@
(FAIL (-> Univ) (null Univ . ->* . Univ))
[(cl->* (-Number . -> . -String) (-Boolean . -> . -String)) ((Un -Boolean -Number) . -> . -String)]
[(-struct #'a #f null #'values) (-struct #'a #f null #'values)]
[(-struct #'a #f (list (make-fld -String #'values #f)) #'values) (-struct #'a #f (list (make-fld -String #'values #f)) #'values)]
[(-struct #'a #f (list (make-fld -String #'values #f)) #'values) (-struct #'a #f (list (make-fld Univ #'values #f)) #'values)]
[(-struct #'a #f null) (-struct #'a #f null)]
[(-struct #'a #f (list (make-fld -String #'values #f))) (-struct #'a #f (list (make-fld -String #'values #f)))]
[(-struct #'a #f (list (make-fld -String #'values #f))) (-struct #'a #f (list (make-fld Univ #'values #f)))]
))
(define-go

5
collects/tests/typed-racket/unit-tests/type-equal-tests.rkt
View File

@ -40,12 +40,11 @@
;; found bug
[FAIL (Un (-mu heap-node
(-struct #'heap-node #f
(map fld* (list (-base 'comparator) -Number (-v a) (Un heap-node (-base 'heap-empty))))
#'values))
(map fld* (list (-base 'comparator) -Number (-v a) (Un heap-node (-base 'heap-empty))))))
(-base 'heap-empty))
(Un (-mu heap-node
(-struct #'heap-node #f
(map fld* (list (-base 'comparator) -Number (-pair -Number -Number) (Un heap-node (-base 'heap-empty)))) #'values))
(map fld* (list (-base 'comparator) -Number (-pair -Number -Number) (Un heap-node (-base 'heap-empty))))))
(-base 'heap-empty))]))
(define-go

4
collects/typed-racket/types/abbrev.rkt
View File

@ -418,8 +418,8 @@
(define (make-arr-dots dom rng dty dbound)
(make-arr* dom rng #:drest (cons dty dbound)))
(define (-struct name parent flds constructor [proc #f] [poly #f] [pred #'dummy] [cert values])
(make-Struct name parent flds proc poly pred cert constructor))
(define (-struct name parent flds [proc #f] [poly #f] [pred #'dummy])
(make-Struct name parent flds proc poly pred))
(define/cond-contract (-filter t i [p null])
(c:->* (Type/c name-ref/c) ((listof PathElem?)) Filter/c)