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

fix serialization of objects (#516)

Browse Source
This commit is contained in:
Andrew Kent 2017-03-20 20:57:28 -04:00 committed by GitHub
parent c174ba655c
commit bf0761b500
2 changed files with 27 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
typed-racket-lib/typed-racket/env/init-envs.rkt vendored
View File

@ -26,6 +26,7 @@
initialize-type-name-env
initialize-type-env
type->sexp ; for types/printer.rkt
object->sexp ; for testing
make-env-init-codes)
(define-syntax (define-initial-env stx)
@ -339,9 +340,9 @@
(define (object->sexp obj)
(match obj
[(Empty:) `-empty-obj]
[(Path: null (cons 0 arg))
[(Path: (list) (cons 0 arg))
`(-arg-path ,arg)]
[(Path: null (cons depth arg))
[(Path: (list) (cons depth arg))
`(-arg-path ,arg ,depth)]
[(Path: pes i)
`(make-Path (list ,@(map path-elem->sexp pes))

37
typed-racket-test/unit-tests/init-env-tests.rkt
View File

@ -9,50 +9,61 @@
(provide tests)
(gen-test-main)
(define (convert v)
(define (convert-type v)
(syntax->datum (datum->syntax #f (type->sexp v))))
(define (convert-obj v)
(syntax->datum (datum->syntax #f (object->sexp v))))
(define tests
(test-suite "Init Env"
(test-suite "Convert"
(check-equal?
(convert (-> -String -Symbol))
(convert-type (-> -String -Symbol))
'(simple-> (list -String) -Symbol))
(check-equal?
(convert (make-pred-ty -String))
(convert-type (make-pred-ty -String))
'(make-pred-ty (list Univ) -Boolean -String (-arg-path 0)))
(check-equal?
(convert (->acc (list (-lst -String)) -String (list -car)))
(convert-type (->acc (list (-lst -String)) -String (list -car)))
'(->acc (list (-lst -String)) -String (list -car)))
(check-equal?
(convert (-mu x (-lst* Univ (-box x))))
(convert-obj (make-Path '() (cons 0 0)))
'(-arg-path 0))
(check-equal?
(convert-obj (make-Path '() (cons 1 0)))
'(-arg-path 0 1))
(check-equal?
(convert-obj (make-Path (list -car) (cons 0 0)))
'(make-Path (list -car) (cons 0 0)))
(check-equal?
(convert-type (-mu x (-lst* Univ (-box x))))
'(make-Mu 'x (make-Pair Univ (make-Pair (make-Box (make-F 'x)) -Null))))
(check-equal?
(convert -StructTypeTop)
(convert-type -StructTypeTop)
'-StructTypeTop)
(check-equal?
(convert -BoxTop)
(convert-type -BoxTop)
'-BoxTop)
(check-equal?
(convert -ClassTop)
(convert-type -ClassTop)
'-ClassTop)
(check-equal?
(convert -field)
(convert-type -field)
'-field)
(check-equal?
(convert (make-StructType (make-Struct #'foo #f null #f #f #'foo?)))
(convert-type (make-StructType (make-Struct #'foo #f null #f #f #'foo?)))
'(make-StructType
(make-Struct (quote-syntax foo) #f (list) #f #f (quote-syntax foo?))))
(check-equal?
(convert (make-StructTop (make-Struct #'foo #f null #f #f #'foo?)))
(convert-type (make-StructTop (make-Struct #'foo #f null #f #f #'foo?)))
'(make-StructTop
(make-Struct (quote-syntax foo) #f (list) #f #f (quote-syntax foo?))))
(check-equal?
(convert (make-Row null null null null #f))
(convert-type (make-Row null null null null #f))
'(make-Row (list) (list) (list) (list) #f))
(check-equal?
(convert (make-Row (list (list 'foo -String #t))
(convert-type (make-Row (list (list 'foo -String #t))
(list (list 'bar -String))
null null #f))
'(make-Row (list (list 'foo -String #t))