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

Changes printer to be more consistent.

Browse Source 
Also make printer tests part of the unit tests.
This commit is contained in:
Eric Dobson 2014-03-05 10:05:06 -08:00
parent d2c415f597
commit e34a248451
5 changed files with 26 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/check-below.rkt
View File

@ -18,7 +18,7 @@
(define (print-object o)
(match o
[(Empty:) "no object"]
[(or (NoObject:) (Empty:)) "no object"]
[_ (format "object ~a" o)]))
;; If expected is #f, then just return tr1
@ -101,7 +101,7 @@
(type-mismatch f2 f1 "mismatch in filter")]
[(and (filter-better? f1 f2)
(not (object-better? o1 o2)))
(type-mismatch o2 o1 "mismatch in object")]
(type-mismatch (print-object o2) (print-object o1) "mismatch in object")]
[(and (not (filter-better? f1 f2))
(not (object-better? o1 o2)))
(type-mismatch (format "`~a' and `~a'" f2 (print-object o2))

2
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/printer.rkt
View File

@ -505,7 +505,7 @@
[(Instance: (? Class? cls)) (class->sexp cls #:object? #t)]
[(ClassTop:) 'ClassTop]
[(? Class?) (class->sexp type)]
[(Result: t (FilterSet: (Top:) (Top:)) (Empty:)) (type->sexp t)]
[(Result: t (or (NoFilter:) (FilterSet: (Top:) (Top:))) (or (NoObject:) (Empty:))) (type->sexp t)]
[(Result: t fs (Empty:)) `(,(type->sexp t) : ,(filter->sexp fs))]
[(Result: t fs lo) `(,(type->sexp t) : ,(filter->sexp fs) : ,(object->sexp lo))]
[(MPair: s t) `(MPairof ,(t->s s) ,(t->s t))]

1
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/all-tests.rkt
View File

@ -33,6 +33,7 @@
"special-env-typecheck-tests.rkt"
"contract-tests.rkt"
"interactive-tests.rkt"
"type-printer-tests.rkt"
"class-tests.rkt"
"class-util-tests.rkt"
"check-below-tests.rkt"

21
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/check-below-tests.rkt
View File

@ -1,9 +1,9 @@
#lang racket/base
(require "test-utils.rkt"
rackunit
rackunit racket/list
(types abbrev union tc-result)
(rep filter-rep)
(rep filter-rep object-rep)
(typecheck check-below)
(for-syntax racket/base syntax/parse))
@ -31,6 +31,23 @@
(ret (list -Symbol) (list -top-filter) (list -no-obj))
(ret (list Univ) (list -true-filter) (list -no-obj)))
(test-below #:fail #rx"no object"
(ret (list -Symbol) (list -top-filter) (list -no-obj))
(ret (list Univ) (list -top-filter) (list (make-Path empty #'x))))
(test-below #:fail #rx"no object"
(ret (list -Symbol) (list -top-filter) (list -empty-obj))
(ret (list Univ) (list -top-filter) (list (make-Path empty #'x))))
(test-below #:fail #rx"no object"
(ret (list -Symbol) (list -top-filter) (list -no-obj))
(ret (list Univ) (list -true-filter) (list (make-Path empty #'x))))
(test-below #:fail #rx"no object"
(ret (list -Symbol) (list -top-filter) (list -empty-obj))
(ret (list Univ) (list -true-filter) (list (make-Path empty #'x))))
;; Enable these once check-below is fixed
#;
(test-below #:fail

3
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/type-printer-tests.rkt
View File

@ -71,6 +71,9 @@
(check-prints-as? (-> -Input-Port (make-Values (list (-result -String -true-filter)
(-result -String -true-filter))))
"(-> Input-Port (values (String : (Top | Bot)) (String : (Top | Bot))))")
(check-prints-as? (-> Univ (make-Values (list (-result -String -top-filter -empty-obj)
(-result -String -no-filter -no-obj))))
"(-> Any (values String String))")
;; this case tests that the Number union is printed with its name
;; rather than its expansion (a former bug)
(check-prints-as? (->* '() -Number -Void) "(-> Number * Void)")