Cleanup, add both record type tests from docs

This commit is contained in:
Justin Ethier 2018-02-01 13:31:31 -05:00
parent 1d91ace450
commit ba3b016c43

View file

@ -14,96 +14,8 @@
(chibi test)))
)
;; Temporary test section
;; #;(display
;; ;(match "test" ((? string? s) s) (else #f))
;; ;
;; ;(let ((v "test"))
;; ; (match-next v ("test" (set! "test")) ((? string? s) s) (else #f)))
;; ;
;; ;(let ((v "test"))
;; ; (let ((failure (lambda () (match-next v ("test" (set! "test")) (else #f)))))
;; ; (match-one v ((? string? s) s) ("test" (set! "test")) (match-drop-ids (begin . s)) (failure) ())))
;; ;
;; ;(let ((v "test"))
;; ; (let ((failure (lambda () (match-next v ("test" (set! "test")) (else #f)))))
;; ; (match-check-ellipsis
;; ; s
;; ; (match-extract-vars (? string? s) (match-gen-ellipsis v (? string? s) () ("test" (set! "test")) (match-drop-ids (begin . s)) (failure) ()) () ())
;; ; (match-two v ((? string? s) s) ("test" (set! "test")) (match-drop-ids (begin . s)) (failure) ()))))
;; ;
;; ;(let ((v "test"))
;; ; (let ((failure (lambda () (match-next v ("test" (set! "test")) (else #f)))))
;; ; (match-check-ellipsis
;; ; s
;; ; (match-extract-vars (? string? s) (match-gen-ellipsis v (? string? s) () ("test" (set! "test")) (match-drop-ids (begin . s)) (failure) ()) () ())
;; ; (match-two v ((? string? s) s) ("test" (set! "test")) (match-drop-ids (begin . s)) (failure) ()))))
;; ;
;; ;(let ((v "test"))
;; ; (let ((failure (lambda () (match-next v ("test" (set! "test")) (else #f)))))
;; ; (match-two v ((? string? s) s) ("test" (set! "test")) (match-drop-ids (begin . s)) (failure) ())))
;; ; END expansions we are sure about, below is just WIP:
;;
;; ; (let ((v "test"))
;; ; (let ((failure (lambda () (match-next v ("test" (set! "test")) (else #f)))))
;; ; (if (string? v)
;; ; (match-one v (and s) ("test" (set! "test")) (match-drop-ids (begin s)) (failure) ())
;; ; (failure))))
;;
;; ;; Following two are broken when using "and" but if we replace "and" with "my-and" in
;; ;; the lib's match-two macro and recompile, the following both work here with "my-and".
;; ;; Something funny going on here...
;; ; (match-one "test" (and s) ("test" (set! "test")) (match-drop-ids (begin s)) (failure) ())
;; ; (match 1 ((and x) x))
;; (match-two 1 (and x) (1 (set! 1)) (match-drop-ids (begin x)) (begin) ())
;; ; (match-two "test" ((? string? s) s) ("test" (set! "test")) (match-drop-ids (begin . s)) (begin) ())
;;
;; ;; I think there is some kind of interaction going on here with the "and" macro, where it
;; ;; is being expanded even though it is part of the syntax-rules literals and should not be.
;; ;; Just a guess, need to prove it, but it could explain why we fall into this case even though
;; ;; pattern should have been (and p) - though not 100% sure, just a guess at this point
;; ; ((match-two v (p) g+s sk fk i)
;; ; (if (and (pair? v) (null? (cdr v)))
;; ; (let ((w (car v)))
;; ; (match-one w p ((car v) (set-car! v)) sk fk i))
;; ; fk))
;;
;; )
;;
;; ;(expand (match "test" ((? string? s) s) (else #f)))*/
;; ;(expand (match-two$171 v$1 (? string? s) ("test" (set! "test")) (match-drop-ids$9 (begin s)) (failure$5) ()))*/
;; ;(expand (match-one$266 v$1 (and$262 s) ("test" (set! "test")) (match-drop-ids$9 (begin s)) (failure$5) ()))*/
;; ;(expand (match-check-ellipsis$270 s (match-extract-vars$269 and$262 (match-gen-ellipsis$268 v$1 and$262 () ("test" (set! "test")) (match-drop-ids$9 (begin s)) (failure$5) ()) () ()) (match-two$267 v$1 (and$262 s) ("test" (set! "test")) (match-drop-ids$9 (begin s)) (failure$5) ())))*/
;; ;(expand (match-two$267 v$1 (and$262 s) ("test" (set! "test")) (match-drop-ids$9 (begin s)) (failure$5) ()))*/
;;TODO: this does not work, try expanding it manually like we did with the other failing macros. maybe we can discover what's going wrong...
;; NOTE there is a warning in chibi on this one. maybe this is not a big deal
;(display (match 1 ((or x 2) x)) )(newline)
(display
(let ()
(define-record-type employee
(make-employee name title)
employee?
(name get-name)
(title get-title))
(match (make-employee "Bob" "Doctor")
(($ employee n t) (list t n))))
)
;; TODO: slot-ref needs to be extended to support this
#;(display
(let ()
(define-record-type employee
(make-employee name title)
employee?
(name get-name)
(title get-title))
(match (make-employee "Bob" "Doctor")
((@ employee (title t) (name n)) (list t n))))
)
(test-group
"official tests"
"Official tests"
(test 2 (match (list 1 2 3) ((a b c) b)) )
(test 2 (match (list 1 2 1) ((a a b) 1) ((a b a) 2)))
@ -154,6 +66,16 @@
(match (make-employee "Bob" "Doctor")
(($ employee n t) (list t n)))))
(test '("Doctor" "Bob")
(let ()
(define-record-type employee
(make-employee name title)
employee?
(name get-name)
(title get-title))
(match (make-employee "Bob" "Doctor")
((@ employee (title t) (name n)) (list t n)))))
(test '(1 . 3) (let ((x (cons 1 2))) (match x ((1 . (set! s)) (s 3) x))))
(test 2 (match '(1 . 2) ((1 . (get! g)) (g))))
(test '(a a a) (match '(a (a (a b))) ((x *** 'b) x)))
@ -161,8 +83,8 @@
)
#;(test-group
"predicates"
(test-group
"Predicates"
(test "test" (match "test" ((? string? s) s) (else #f)))
(test #(fromlist 1 2) (match '(1 2) ((a b) (vector 'fromlist a b))))
@ -190,7 +112,7 @@
))
(test-group
"example"
"Demo"
(test (+ (* 5 60) 10) (calc-time '(5 min 10 sec)))
(test (+ (* 24 60 60) (* 60 5) 10) (calc-time '(1 day 5 min 10 sec)))
(test (+ (* 24 60 60) (* 60 60) (* 60 5) 10) (calc-time '(0 weeks 1 day 1 h 5 min 10 sec)))