Cleanup, add both record type tests from docs

tests/match-tests.scm

@@ -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
+(test-group
-  "predicates"
+  "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)))