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

Moved tests to separate files (part 2).

Browse Source
This commit is contained in:
Georges Dupéron 2016-03-23 17:00:00 +01:00
parent 4daa2bb86a
commit e6ff012973
16 changed files with 384 additions and 389 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
graph-lib/graph/__DEBUG_graph5.rkt
View File

@ -12,7 +12,7 @@
#|
(module mm typed/racket
(require ;(submod "graph.lp2.rkt" test)
(require ;(submod "graph-test.rkt" test)
"graph.lp2.rkt"
"../type-expander/type-expander.lp2.rkt")

2
graph-lib/graph/adt-test.rkt
View File

@ -1,7 +1,7 @@
#lang typed/racket
(module test typed/racket
(require (submod "graph.lp2.rkt" test))
(require (submod "graph-test.rkt" test))
(require "adt.lp2.rkt")
(require "../lib/low.rkt")
(require "../type-expander/type-expander.lp2.rkt")

55
graph-lib/graph/cond-abort-test.rkt Normal file
View File

@ -0,0 +1,55 @@
#lang typed/racket
(module test typed/racket
(require typed/rackunit)
(require "cond-abort.rkt")
;; Type Checker: Incomplete case coverage in: (cond-abort)
;(cond-abort)
(check-equal? (cond-abort [else 1]) 1)
(check-equal? (cond-abort [#f 0] [else 1]) 1)
(check-equal? (cond-abort [#t 2]) 2)
(check-equal? (cond-abort [#f 0] [#t 2]) 2)
(check-equal? (cond-abort [#t 'continue]
[#f (typecheck-fail #'"We should never get here")]
[#t 3])
3)
(check-equal?
(cond-abort
[#t 'continue]
[#t (let ([ret (cond-abort
[#t 'continue]
[#f (typecheck-fail #'"We should never get here")]
[#t 'break]
[#t (typecheck-fail #'"We should never get here")]
[#t 'continue]
[#t (typecheck-fail #'"We should never get here")])])
(ann ret 'continue))]
[#t 4])
4)
(check-equal?
(ann (let ([f (λ ([x : Integer])
(cond-abort
[#t (if (< x 3) 'continue x)]
[#f (typecheck-fail #'"We should never get here")]
[#t 4]
[else (typecheck-fail #'"We should never get here")]))])
(list (f 2) (f 7)))
(Listof Positive-Integer))
'(4 7))
(check-equal?
(match-abort '(1 2 3)
[(cons a b)
(match-abort b
[(list x y z) 'one]
[(cons x y) 'break]
[_ (typecheck-fail #'"We should never get here")])]
[(list a b c)
'two])
'two))

54
graph-lib/graph/cond-abort.rkt
View File

@ -93,57 +93,3 @@
(begin
(set! result-list (cons result result-list))
(set! l (cdr l))))))))))]))
(module* test typed/racket
(require typed/rackunit)
(require (submod ".."))
;; Type Checker: Incomplete case coverage in: (cond-abort)
;(cond-abort)
(check-equal? (cond-abort [else 1]) 1)
(check-equal? (cond-abort [#f 0] [else 1]) 1)
(check-equal? (cond-abort [#t 2]) 2)
(check-equal? (cond-abort [#f 0] [#t 2]) 2)
(check-equal? (cond-abort [#t 'continue]
[#f (typecheck-fail #'"We should never get here")]
[#t 3])
3)
(check-equal?
(cond-abort
[#t 'continue]
[#t (let ([ret (cond-abort
[#t 'continue]
[#f (typecheck-fail #'"We should never get here")]
[#t 'break]
[#t (typecheck-fail #'"We should never get here")]
[#t 'continue]
[#t (typecheck-fail #'"We should never get here")])])
(ann ret 'continue))]
[#t 4])
4)
(check-equal?
(ann (let ([f (λ ([x : Integer])
(cond-abort
[#t (if (< x 3) 'continue x)]
[#f (typecheck-fail #'"We should never get here")]
[#t 4]
[else (typecheck-fail #'"We should never get here")]))])
(list (f 2) (f 7)))
(Listof Positive-Integer))
'(4 7))
(check-equal?
(match-abort '(1 2 3)
[(cons a b)
(match-abort b
[(list x y z) 'one]
[(cons x y) 'break]
[_ (typecheck-fail #'"We should never get here")])]
[(list a b c)
'two])
'two))

35
graph-lib/graph/constructor-test.rkt Normal file
View File

@ -0,0 +1,35 @@
#lang typed/racket
(module test typed/racket
(require "constructor.lp2.rkt"
"../lib/low.rkt"
"../type-expander/type-expander.lp2.rkt")
(check-equal?: (constructor-values
(ann (constructor a 1 "x")
;; TODO: Make a (ConstructorTop …) type expander.
(ConstructorTop (List Number String))))
(list 1 "x"))
(check-equal?: (constructor-values
(ann (constructor a 1 "x")
(ConstructorTop Any)))
(list 1 "x"))
(check-equal?: (constructor-values
(ann (constructor a 1 "x")
(constructor a Number String)))
(list 1 "x")) ;; TODO: test that the tag is 'a
(check-equal?: (constructor-values
(ann (constructor b)
(constructor b)))
(list)) ;; TODO: test that the tag is 'b
(check-equal?: (constructor-values
(ann (constructor c 'd)
(constructor c Symbol)))
'd) ;; TODO: test that the tag is 'c
(check-equal?: (ann (constructor c 2 "y")
(constructor c Number String))
(constructor c 2 "y"))
(check-not-equal?: (constructor d 2 "y")
(constructor d 2 "y" 'z))
(check-not-equal?: (constructor e 2 "y")
(constructor F 2 "y")))

38
graph-lib/graph/constructor.lp2.rkt
View File

@ -144,36 +144,6 @@ instance:
#:match-expander <match-expander>
#:call <make-instance>)]
@chunk[<test-constructor>
(check-equal?: (constructor-values
(ann (constructor a 1 "x")
;; TODO: Make a (ConstructorTop …) type expander.
(ConstructorTop (List Number String))))
(list 1 "x"))
(check-equal?: (constructor-values
(ann (constructor a 1 "x")
(ConstructorTop Any)))
(list 1 "x"))
(check-equal?: (constructor-values
(ann (constructor a 1 "x")
(constructor a Number String)))
(list 1 "x")) ;; TODO: test that the tag is 'a
(check-equal?: (constructor-values
(ann (constructor b)
(constructor b)))
(list)) ;; TODO: test that the tag is 'b
(check-equal?: (constructor-values
(ann (constructor c 'd)
(constructor c Symbol)))
'd) ;; TODO: test that the tag is 'c
(check-equal?: (ann (constructor c 2 "y")
(constructor c Number String))
(constructor c 2 "y"))
(check-not-equal?: (constructor d 2 "y")
(constructor d 2 "y" 'z))
(check-not-equal?: (constructor e 2 "y")
(constructor F 2 "y"))]
@subsection{Type-expander}
@CHUNK[<type-expander>
@ -274,10 +244,4 @@ instance:
(provide declare-constructor-struct)))
(require 'main)
(provide (all-from-out 'main))
(module* test typed/racket
(require (submod "..")
"../lib/low.rkt"
"../type-expander/type-expander.lp2.rkt")
<test-constructor>))]
(provide (all-from-out 'main)))]

191
graph-lib/graph/define-adt-test.rkt Normal file
View File

@ -0,0 +1,191 @@
#lang typed/racket
(module test typed/racket
(require "define-adt.lp2.rkt"
"constructor.lp2.rkt"
"tagged.lp2.rkt"
"../lib/low.rkt"
"../type-expander/type-expander.lp2.rkt")
;; define-tagged
(begin
(define-tagged tagged-s1)
(define-tagged tagged-s2 [f Fixnum] [g String])
(define-tagged tagged-s3 [g String] [f Fixnum])
(define-tagged tagged-s4 [f Fixnum] [g String])
(check-equal?: (match (ann (tagged-s1) (tagged tagged-s1))
[(tagged-s1) #t])
#t)
(check-equal?: (match (ann (tagged-s2 99 "z") tagged-s2)
[(tagged-s2 f g) (cons g f)])
'("z" . 99))
(let ()
(check-equal?: (match (ann (tagged-s2 99 "in-let") tagged-s2)
[(tagged-s2 f g) (cons g f)])
'("in-let" . 99)))
(define (test-match val)
(match val
[(tagged-s2 x y) (list 'found-s2 y x)]
[(tagged-s3 x y) (list 'found-s3 y x)]
[(tagged-s4 x y) (list 'found-s4 y x)]))
(check-equal?:
(test-match (ann (tagged-s2 2 "flob")
(tagged tagged-s2 [f Fixnum] [g String])))
'(found-s2 "flob" 2))
(check-equal?:
(test-match (ann (tagged-s3 "flob" 2)
(tagged tagged-s3 [g String] [f Fixnum])))
'(found-s3 2 "flob"))
;; g and f are inverted in the “ann”
(check-equal?:
(test-match (ann (tagged-s4 2 "flob")
(tagged tagged-s4 [g String] [f Fixnum])))
'(found-s4 "flob" 2))
(define (test-match-verbose val)
(match val
[(tagged tagged-s2 g [f y]) (list 'found-s2 g y)]
[(tagged tagged-s3 [g y] f) (list 'found-s2 f y)]
[(tagged tagged-s4 [f y] g) (list 'found-s2 g y)]))
(check-equal?:
(test-match (ann (tagged-s2 3 "flob")
(tagged tagged-s2 [f Fixnum] [g String])))
'(found-s2 "flob" 3))
;; g and f are inverted in the “ann”
(check-equal?:
(test-match (ann (tagged-s3 "flob" 3)
(tagged tagged-s3 [f Fixnum] [g String])))
'(found-s3 3 "flob"))
(check-equal?:
(test-match (ann (tagged-s4 3 "flob")
(tagged tagged-s4 [f Fixnum] [g String])))
'(found-s4 "flob" 3))
(check-not-equal?: (tagged-s2 4 "flob")
(tagged-s3 "flob" 4))
(check-not-equal?: (tagged-s2 4 "flob")
(tagged-s4 4 "flob")))
;; define-constructor
(begin
(define-constructor c1)
(define-constructor c2 Fixnum String)
(define-constructor c3 Fixnum String)
(check-equal?: (match (ann (c1) (constructor c1))
[(c1) #t])
#t)
(check-equal?: (match (ann (c2 99 "z") c2)
[(c2 f g) (cons g f)])
'("z" . 99))
(let ()
(check-equal?: (match (ann (c2 99 "in-let") c2)
[(c2 f g) (cons g f)])
'("in-let" . 99)))
(define (test-c-match val)
(match val
[(c1) (list 'found-c1)]
[(constructor c2 x y z) (list 'found-c2-xyz z y x)]
[(c2 x y) (list 'found-c2 y x)]
[(c3 x y) (list 'found-c3 y x)]))
(check-equal?:
(test-c-match (ann (c2 2 "flob")
(constructor c2 Fixnum String)))
'(found-c2 "flob" 2))
(check-equal?:
(test-c-match (ann (c3 2 "flob")
(constructor c3 Fixnum String)))
'(found-c3 "flob" 2)))
;; define-tagged #:private
(begin
(define-syntax-rule (defp make mt)
(begin
(define-tagged txyz #:private #:? txyz?
[a Number]
[b String])
(define (make) (txyz 1 "b"))
(define (mt v)
(match v
((txyz x y) (list 'macro y x))
(_ #f)))))
(defp make mt)
(define-tagged txyz #:private #:? txyz?
[a Number]
[b String])
(check-equal?: (match (make)
((tagged txyz x y) (list 'out y x))
(_ #f))
#f)
(check-equal?: (mt (tagged txyz [x 1] [y "b"]))
#f)
(check-equal?: (mt (make))
'(macro "b" 1))
(check-not-equal?: (make) (txyz 1 "b"))
(check-equal?: (match (make)
((txyz x y) (list 'out y x))
(_ #f))
#f)
(check-equal?: (mt (txyz 1 "b"))
#f))
;; define-constructor #:private
(begin
(define-syntax-rule (defpc makec mtc)
(begin
(define-constructor cxyz #:private #:? cxyz? Number String)
(define (makec) (cxyz 1 "b"))
(define (mtc v)
(match v
((cxyz x y) (list 'macro y x))
(_ #f)))))
(defpc makec mtc)
(define-constructor cxyz #:private #:? cxyz? Number String)
(check-equal?: (match (makec)
((constructor cxyz e f) (list 'out f e))
(_ #f))
#f)
(check-equal?: (mtc (constructor cxyz 1 "b"))
#f)
(check-equal?: (mtc (makec))
'(macro "b" 1))
(check-not-equal?: (makec) (cxyz 1 "b"))
(check-equal?: (match (makec)
((cxyz e f) (list 'out f e))
(_ #f))
#f)
(check-equal?: (mtc (cxyz 1 "b"))
#f)))

195
graph-lib/graph/define-adt.lp2.rkt
View File

@ -117,187 +117,6 @@ used. The macro's expansion will use this to declare
(?? (?@ #:with-struct with-struct))
field …)))))]
@section{Tests}
@chunk[<test-define-tagged>
(define-tagged tagged-s1)
(define-tagged tagged-s2 [f Fixnum] [g String])
(define-tagged tagged-s3 [g String] [f Fixnum])
(define-tagged tagged-s4 [f Fixnum] [g String])
(check-equal?: (match (ann (tagged-s1) (tagged tagged-s1))
[(tagged-s1) #t])
#t)
(check-equal?: (match (ann (tagged-s2 99 "z") tagged-s2)
[(tagged-s2 f g) (cons g f)])
'("z" . 99))
(let ()
(check-equal?: (match (ann (tagged-s2 99 "in-let") tagged-s2)
[(tagged-s2 f g) (cons g f)])
'("in-let" . 99)))
(define (test-match val)
(match val
[(tagged-s2 x y) (list 'found-s2 y x)]
[(tagged-s3 x y) (list 'found-s3 y x)]
[(tagged-s4 x y) (list 'found-s4 y x)]))
(check-equal?:
(test-match (ann (tagged-s2 2 "flob")
(tagged tagged-s2 [f Fixnum] [g String])))
'(found-s2 "flob" 2))
(check-equal?:
(test-match (ann (tagged-s3 "flob" 2)
(tagged tagged-s3 [g String] [f Fixnum])))
'(found-s3 2 "flob"))
;; g and f are inverted in the “ann”
(check-equal?:
(test-match (ann (tagged-s4 2 "flob")
(tagged tagged-s4 [g String] [f Fixnum])))
'(found-s4 "flob" 2))
(define (test-match-verbose val)
(match val
[(tagged tagged-s2 g [f y]) (list 'found-s2 g y)]
[(tagged tagged-s3 [g y] f) (list 'found-s2 f y)]
[(tagged tagged-s4 [f y] g) (list 'found-s2 g y)]))
(check-equal?:
(test-match (ann (tagged-s2 3 "flob")
(tagged tagged-s2 [f Fixnum] [g String])))
'(found-s2 "flob" 3))
;; g and f are inverted in the “ann”
(check-equal?:
(test-match (ann (tagged-s3 "flob" 3)
(tagged tagged-s3 [f Fixnum] [g String])))
'(found-s3 3 "flob"))
(check-equal?:
(test-match (ann (tagged-s4 3 "flob")
(tagged tagged-s4 [f Fixnum] [g String])))
'(found-s4 "flob" 3))
(check-not-equal?: (tagged-s2 4 "flob")
(tagged-s3 "flob" 4))
(check-not-equal?: (tagged-s2 4 "flob")
(tagged-s4 4 "flob"))]
@chunk[<test-define-constructor>
(define-constructor c1)
(define-constructor c2 Fixnum String)
(define-constructor c3 Fixnum String)
(check-equal?: (match (ann (c1) (constructor c1))
[(c1) #t])
#t)
(check-equal?: (match (ann (c2 99 "z") c2)
[(c2 f g) (cons g f)])
'("z" . 99))
(let ()
(check-equal?: (match (ann (c2 99 "in-let") c2)
[(c2 f g) (cons g f)])
'("in-let" . 99)))
(define (test-c-match val)
(match val
[(c1) (list 'found-c1)]
[(constructor c2 x y z) (list 'found-c2-xyz z y x)]
[(c2 x y) (list 'found-c2 y x)]
[(c3 x y) (list 'found-c3 y x)]))
(check-equal?:
(test-c-match (ann (c2 2 "flob")
(constructor c2 Fixnum String)))
'(found-c2 "flob" 2))
(check-equal?:
(test-c-match (ann (c3 2 "flob")
(constructor c3 Fixnum String)))
'(found-c3 "flob" 2))]
@chunk[<test-private-tagged>
(define-syntax-rule (defp make mt)
(begin
(define-tagged txyz #:private #:? txyz?
[a Number]
[b String])
(define (make) (txyz 1 "b"))
(define (mt v)
(match v
((txyz x y) (list 'macro y x))
(_ #f)))))
(defp make mt)
(define-tagged txyz #:private #:? txyz?
[a Number]
[b String])
(check-equal?: (match (make)
((tagged txyz x y) (list 'out y x))
(_ #f))
#f)
(check-equal?: (mt (tagged txyz [x 1] [y "b"]))
#f)
(check-equal?: (mt (make))
'(macro "b" 1))
(check-not-equal?: (make) (txyz 1 "b"))
(check-equal?: (match (make)
((txyz x y) (list 'out y x))
(_ #f))
#f)
(check-equal?: (mt (txyz 1 "b"))
#f)]
@chunk[<test-private-constructor>
(define-syntax-rule (defpc makec mtc)
(begin
(define-constructor cxyz #:private #:? cxyz? Number String)
(define (makec) (cxyz 1 "b"))
(define (mtc v)
(match v
((cxyz x y) (list 'macro y x))
(_ #f)))))
(defpc makec mtc)
(define-constructor cxyz #:private #:? cxyz? Number String)
(check-equal?: (match (makec)
((constructor cxyz e f) (list 'out f e))
(_ #f))
#f)
(check-equal?: (mtc (constructor cxyz 1 "b"))
#f)
(check-equal?: (mtc (makec))
'(macro "b" 1))
(check-not-equal?: (makec) (cxyz 1 "b"))
(check-equal?: (match (makec)
((cxyz e f) (list 'out f e))
(_ #f))
#f)
(check-equal?: (mtc (cxyz 1 "b"))
#f)]
@section{Conclusion}
@chunk[<*>
@ -323,16 +142,4 @@ used. The macro's expansion will use this to declare
<define-tagged>)
(require 'main)
(provide (all-from-out 'main))
(module* test typed/racket
(require (submod "..")
"constructor.lp2.rkt"
"tagged.lp2.rkt"
"../lib/low.rkt"
"../type-expander/type-expander.lp2.rkt")
<test-define-constructor>
<test-define-tagged>
<test-private-constructor>
<test-private-tagged>))]
(provide (all-from-out 'main)))]

58
graph-lib/graph/dotlang-test.rkt Normal file
View File

@ -0,0 +1,58 @@
#lang typed/racket
(module test "dotlang.rkt"
(require typed/rackunit
"../lib/low.rkt"
"get.lp2.rkt"
(submod "graph-test.rkt" test)
"map.rkt")
(let ((foo..bar 42))
(check-equal?: foo..bar 42))
(check-equal?: 'foo.bar '(get foo bar))
;; Srcloc tests:
;(let .a b) ;; Error on the first .
;(let .a.b b) ;; Error on the first .
;(let a.b b) ;; Error on the whole a.b
(check-equal?: g.streets…houses…owner.name
: (Listof (Listof String))
(list (list "Amy" "Anabella") (list "Jack")))
(check-equal?: (map: (curry map .owner.name) g.streets…houses)
: (Listof (Listof String))
(list (list "Amy" "Anabella") (list "Jack")))
(define (slen [n : Index] [str : String])
(check-equal?: (string-length str) n)
(string->symbol str))
(check-equal?: '(a . b) (cons 'a 'b))
(check-equal?: '(a . b.c) (list 'a 'get 'b 'c))
(check-equal?: '(a . b.c.d) (list 'a 'get 'b 'c 'd))
(check-equal?: '(a.c . b) (cons (list 'get 'a 'c) 'b))
(check-equal?: '(a.c.d . b) (cons (list 'get 'a 'c 'd) 'b))
(check-equal?: '.aa.bb..cc.d (list 'λget 'aa (slen 5 "bb.cc") 'd))
(check-equal?: '…aa...bb..cc.d (list 'λget '… (slen 9 "aa..bb.cc") 'd))
(check-equal?: '…aa.….bb..cc.d (list 'λget '… 'aa '… (slen 5 "bb.cc") 'd))
(check-equal?: '.aa.….bb..cc.d (list 'λget 'aa '… (slen 5 "bb.cc") 'd))
(check-equal?: '.aa.….bb.cc.d (list 'λget 'aa '… 'bb 'cc 'd))
(check-equal?: '…aa.….bb.cc.d (list 'λget '… 'aa '… 'bb 'cc 'd))
(check-equal?: 'aa.bb..cc.d (list 'get 'aa (slen 5 "bb.cc") 'd))
(check-equal?: 'aa...bb..cc.d (list 'get (slen 9 "aa..bb.cc") 'd))
(check-equal?: 'aa…bb..cc.d (list 'get 'aa '… (slen 5 "bb.cc") 'd))
(check-equal?: 'aa.….bb..cc.d (list 'get 'aa '… (slen 5 "bb.cc") 'd))
(check-equal?: 'aa.….bb.cc.d (list 'get 'aa '… 'bb 'cc 'd))
(check-equal?: 'aa…bb (list 'get 'aa '… 'bb))
(check-equal?: 'aa… (slen 3 "aa…"))
(check-equal?: '… (slen 1 "…"))
#|
(check-equal?: '…aa.…bb..cc.d) ;; TODO: should cause error
(check-equal?: '…aa….bb..cc.d) ;; TODO: should cause error
|#)

58
graph-lib/graph/dotlang.rkt
View File

@ -1,5 +1,7 @@
#lang typed/racket
;; The module needs to be defined using racket, as typed/racket doesn't support
;; provide `for-meta` nor `for-syntax`.
(module dotlang racket
(require typed/racket)
@ -105,59 +107,3 @@
(require 'dotlang)
(provide (all-from-out 'dotlang))
(module test (submod ".." dotlang)
(require typed/rackunit
"../lib/low.rkt"
"get.lp2.rkt"
(submod "graph.lp2.rkt" test)
"map.rkt")
(let ((foo..bar 42))
(check-equal?: foo..bar 42))
(check-equal?: 'foo.bar '(get foo bar))
;; Srcloc tests:
;(let .a b) ;; Error on the first .
;(let .a.b b) ;; Error on the first .
;(let a.b b) ;; Error on the whole a.b
(check-equal?: g.streets…houses…owner.name
: (Listof (Listof String))
(list (list "Amy" "Anabella") (list "Jack")))
(check-equal?: (map: (curry map .owner.name) g.streets…houses)
: (Listof (Listof String))
(list (list "Amy" "Anabella") (list "Jack")))
(define (slen [n : Index] [str : String])
(check-equal?: (string-length str) n)
(string->symbol str))
(check-equal?: '(a . b) (cons 'a 'b))
(check-equal?: '(a . b.c) (list 'a 'get 'b 'c))
(check-equal?: '(a . b.c.d) (list 'a 'get 'b 'c 'd))
(check-equal?: '(a.c . b) (cons (list 'get 'a 'c) 'b))
(check-equal?: '(a.c.d . b) (cons (list 'get 'a 'c 'd) 'b))
(check-equal?: '.aa.bb..cc.d (list 'λget 'aa (slen 5 "bb.cc") 'd))
(check-equal?: '…aa...bb..cc.d (list 'λget '… (slen 9 "aa..bb.cc") 'd))
(check-equal?: '…aa.….bb..cc.d (list 'λget '… 'aa '… (slen 5 "bb.cc") 'd))
(check-equal?: '.aa.….bb..cc.d (list 'λget 'aa '… (slen 5 "bb.cc") 'd))
(check-equal?: '.aa.….bb.cc.d (list 'λget 'aa '… 'bb 'cc 'd))
(check-equal?: '…aa.….bb.cc.d (list 'λget '… 'aa '… 'bb 'cc 'd))
(check-equal?: 'aa.bb..cc.d (list 'get 'aa (slen 5 "bb.cc") 'd))
(check-equal?: 'aa...bb..cc.d (list 'get (slen 9 "aa..bb.cc") 'd))
(check-equal?: 'aa…bb..cc.d (list 'get 'aa '… (slen 5 "bb.cc") 'd))
(check-equal?: 'aa.….bb..cc.d (list 'get 'aa '… (slen 5 "bb.cc") 'd))
(check-equal?: 'aa.….bb.cc.d (list 'get 'aa '… 'bb 'cc 'd))
(check-equal?: 'aa…bb (list 'get 'aa '… 'bb))
(check-equal?: 'aa… (slen 3 "aa…"))
(check-equal?: '… (slen 1 "…"))
#|
(check-equal?: '…aa.…bb..cc.d) ;; TODO: should cause error
(check-equal?: '…aa….bb..cc.d) ;; TODO: should cause error
|#)

11
graph-lib/graph/fold-queues.lp2.rkt
View File

@ -234,19 +234,10 @@ position in the vector equal to the index associated to it in the hash table:
<fold-queue-multi-sets-immutable-tags>)]
@chunk[<module-test>
(module* test typed/racket
(require (submod "..")
typed/rackunit)
#| TODO: tests |#)]
@chunk[<*>
(begin
<module-main>
(require 'main)
(provide (all-from-out 'main))
<module-test>)]
(provide (all-from-out 'main)))]

2
graph-lib/graph/get-test.rkt
View File

@ -1,7 +1,7 @@
#lang typed/racket
(module test typed/racket
(require (submod "graph.lp2.rkt" test))
(require (submod "graph-test.rkt" test))
(require "get.lp2.rkt")
(require "adt.lp2.rkt")
(require "../lib/low.rkt")

12
graph-lib/graph/graph-4.5-types.rkt
View File

@ -1,12 +0,0 @@
#lang typed/racket
(require "graph.lp2.rkt")
(require "../type-expander/multi-id.lp2.rkt")
(require "../type-expander/type-expander.lp2.rkt")
(define-graph g2 [a [v : Number] ((ma) (a 1))])
(define-multi-id g3
#:type-expander (λ (stx) #'(List 'x))
#:else-id g2)
(λ ([x : g3]) x)

22
graph-lib/graph/graph-test.rkt Normal file
View File

@ -0,0 +1,22 @@
#lang typed/racket
(module test typed/racket
(require (for-syntax (submod "graph.lp2.rkt" test-syntax)
syntax/strip-context))
(provide g gr gr-simple)
(define-syntax (insert-tests stx)
(replace-context stx tests))
(require "graph.lp2.rkt"
(only-in "../lib/low.rkt" cars cdrs check-equal?:)
(only-in "adt.lp2.rkt" uniform-get)
"../type-expander/type-expander.lp2.rkt")
(insert-tests)
(define-graph gr-simple
[Fountain [water : (Listof Symbol)]
[(m-fountain [mountain : Symbol])
(Fountain (list mountain mountain))]]))

36
graph-lib/graph/graph.lp2.rkt
View File

@ -770,14 +770,13 @@ We will be able to use this type expander in function types, for example:
(define (type-example [x : (gr Street)])
: (gr Street)
x)
(check-equal?:
(let* ([v1 (car
(uniform-get g streets))]
[v2 (ann (type-example v1) (gr Street))]
[v3 (uniform-get v2 sname)])
v3)
: String
"Ada Street")]
(check-equal?: (let* ([v1 (car
(uniform-get g streets))]
[v2 (ann (type-example v1) (gr Street))]
[v3 (uniform-get v2 sname)])
v3)
: String
"Ada Street")]
@section{Putting it all together}
@ -815,20 +814,13 @@ therefore the @tc[:] bound in the @tc[graph] macro with @tc[:colon] would
not match the one from @tc[typed/racket]
@chunk[<module-test>
(module* test typed/racket
(require (submod "..")
(only-in "../lib/low.rkt" cars cdrs check-equal?:)
(only-in "adt.lp2.rkt" uniform-get)
"../type-expander/type-expander.lp2.rkt")
(provide g gr gr-simple)
<use-example>
<type-example>
(define-graph gr-simple
[Fountain [water : (Listof Symbol)]
[(m-fountain [mountain : Symbol])
(Fountain (list mountain mountain))]]))]
(module test-syntax racket
(provide tests)
(define tests
(quote-syntax
(begin
<use-example>
<type-example>))))]
The whole file, finally:

2
graph-lib/graph/map-test.rkt
View File

@ -3,7 +3,7 @@
(module test typed/racket
(require "map.rkt"
(submod "map.rkt" private-tests))
(require (submod "graph.lp2.rkt" test)
(require (submod "graph-test.rkt" test)
"get.lp2.rkt"
"map.rkt"
"../lib/low.rkt"