Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-05-24 20:45:06 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Updated tests

Browse source
This commit is contained in:
Justin Ethier 2018-01-28 19:00:38 -05:00
parent 958ad75e78
commit 641794cfa4
2 changed files with 17 additions and 20 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

29
match-test.scm
View file

@ -13,7 +13,7 @@
(chibi test))) (chibi test)))
) )
(display #;(display
;(match "test" ((? string? s) s) (else #f)) ;(match "test" ((? string? s) s) (else #f))
; ;
;(let ((v "test")) ;(let ((v "test"))
@ -53,7 +53,7 @@
;; Something funny going on here... ;; Something funny going on here...
; (match-one "test" (and s) ("test" (set! "test")) (match-drop-ids (begin s)) (failure) ()) ; (match-one "test" (and s) ("test" (set! "test")) (match-drop-ids (begin s)) (failure) ())
; (match 1 ((and x) x)) ; (match 1 ((and x) x))
(match-two 1 (and x) (1 (set! 1)) (match-drop-ids (begin . x)) (begin) ()) (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) ()) ; (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 ;; I think there is some kind of interaction going on here with the "and" macro, where it
@ -74,16 +74,15 @@
;(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-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) ()))*/ ;(expand (match-two$267 v$1 (and$262 s) ("test" (set! "test")) (match-drop-ids$9 (begin s)) (failure$5) ()))*/
#;(test-group (test-group
"predicates" "predicates"
;; Fails on cyclone, works on chibi (test "test" (match "test" ((? string? s) s) (else #f)))
;(test "test" (match "test" ((? string? s) s) (else #f)))
(test #(fromlist 1 2) (match '(1 2) ((a b) (vector 'fromlist a b)))) (test #(fromlist 1 2) (match '(1 2) ((a b) (vector 'fromlist a b))))
(test #f (match 42 (X #f))) (test #f (match 42 (X #f)))
) )
#;(test-group (test-group
"official tests" "official tests"
(test 2 (match (list 1 2 3) ((a b c) b)) ) (test 2 (match (list 1 2 3) ((a b c) b)) )
@ -91,8 +90,7 @@
(test 1 (match (list 1 2 1) ((_ _ b) 1) ((a b a) 2)) ) (test 1 (match (list 1 2 1) ((_ _ b) 1) ((a b a) 2)) )
(test 2 (match 'a ('b 1) ('a 2)) ) (test 2 (match 'a ('b 1) ('a 2)) )
;; fails on cyclone, works in chibi (test '(2 3) (match (list 1 2 3) (`(1 ,b ,c) (list b c))))
;(display (match (list 1 2 3) (`(1 ,b ,c) (list b c))) )(newline)
(test #t (match (list 1 2) ((1 2 3 ...) #t)) ) (test #t (match (list 1 2) ((1 2 3 ...) #t)) )
(test #t (match (list 1 2 3) ((1 2 3 ...) #t)) ) (test #t (match (list 1 2 3) ((1 2 3 ...) #t)) )
@ -108,23 +106,22 @@
;;; Pattern not matched ;;; Pattern not matched
;(display (match (list 1 2) ((a b c ..1) c)) )(newline) ;(display (match (list 1 2) ((a b c ..1) c)) )(newline)
;;; Should have matched?? ;;; Should have matched??
;(display (match (list 1 2 3) ((a b c ..1) c)) )(newline) (test '(3) (match (list 1 2 3) ((a b c ..1) c)))
;; Next 3 fail on cyclone but pass on chibi (test #t (match 1 ((and) #t)))
;(display (match 1 ((and) #t)) )(newline) (test 1 (match 1 ((and x) x)))
;(display (match 1 ((and x) x)) )(newline) (test 1 (match 1 ((and x 1) x)))
;(display (match 1 ((and x 1) x)) )(newline)
(test #f (match 1 ((or) #t) (else #f)) ) (test #f (match 1 ((or) #t) (else #f)) )
;; Next 2 fail on cyclone but pass on chibi (test 1 (match 1 ((or x) x)))
;(display (match 1 ((or x) x)) )(newline) ;; Next fails on cyclone but pass on chibi
;(display (match 1 ((or x 2) x)) )(newline) ;(display (match 1 ((or x 2) x)) )(newline)
(test #t (match 1 ((not 2) #t)) ) (test #t (match 1 ((not 2) #t)) )
;; Fails on cyclone but passes on chibi ;; Fails on cyclone but passes on chibi
;(display (match 1 ((? odd? x) x)) )(newline) (test 1 (match 1 ((? odd? x) x)))
(test 1 (match '(1 . 2) ((= car x) x)) ) (test 1 (match '(1 . 2) ((= car x) x)) )
(test 16 (match 4 ((= square x) x)) ) (test 16 (match 4 ((= square x) x)) )
) )

8
match-test2.scm
View file

@ -27,7 +27,7 @@
;; Go directly to MATCH-TWO. ;; Go directly to MATCH-TWO.
((match-one . x) ((match-one . x)
(match-two . x)))) (match-two . x))))
#;(define-syntax match-two (define-syntax match-two
(syntax-rules (_ ___ ..1 *** quote quasiquote ? $ struct @ object = and or not set! get!) (syntax-rules (_ ___ ..1 *** quote quasiquote ? $ struct @ object = and or not set! get!)
((match-two v () g+s (sk ...) fk i) ((match-two v () g+s (sk ...) fk i)
(if (null? v) (sk ... i) fk)) (if (null? v) (sk ... i) fk))
@ -115,7 +115,7 @@
(if (equal? v x) (sk ... (id ...)) fk))) (if (equal? v x) (sk ... (id ...)) fk)))
(if (equal? v x) (sk ... (id ...)) fk))) (if (equal? v x) (sk ... (id ...)) fk)))
)) ))
(define-syntax match-two #;(define-syntax match-two
(syntax-rules (_ ___ ..1 *** quote quasiquote ? $ struct @ object = my-and or not set! get!) (syntax-rules (_ ___ ..1 *** quote quasiquote ? $ struct @ object = my-and or not set! get!)
((match-two v () g+s (sk ...) fk i) ((match-two v () g+s (sk ...) fk i)
(if (null? v) (sk ... i) fk)) (if (null? v) (sk ... i) fk))
@ -211,7 +211,7 @@
(display (display
;; Works fine with my-and, but change back to and (and above in match-two) and it is broken ;; Works fine with my-and, but change back to and (and above in match-two) and it is broken
(match-two 1 (my-and x) (1 (set! 1)) (match-drop-ids (begin x)) (begin) ()) ;(match-two 1 (my-and x) (1 (set! 1)) (match-drop-ids (begin x)) (begin) ())
;; With my-and the initial expansions are: ;; With my-and the initial expansions are:
;/* (expand (match-two 1 (my-and x) (1 (set! 1)) (match-drop-ids (begin x)) (begin) ()))*/ ;/* (expand (match-two 1 (my-and x) (1 (set! 1)) (match-drop-ids (begin x)) (begin) ()))*/
;/* (expand (match-one$2095 1 x (1 (set! 1)) (match-one$2095 1 (my-and$2094) (1 (set! 1)) (match-drop-ids (begin x)) (begin)) (begin) ()))*/ ;/* (expand (match-one$2095 1 x (1 (set! 1)) (match-one$2095 1 (my-and$2094) (1 (set! 1)) (match-drop-ids (begin x)) (begin)) (begin) ()))*/
@ -219,7 +219,7 @@
;/* (expand (match-check-identifier$2105 x (let-syntax ((new-sym?$2100 (syntax-rules$2104 () ((new-sym?$2100 x sk2$2102 fk2$2101) sk2$2102) ((new-sym?$2100 y$2103 sk2$2102 fk2$2101) fk2$2101)))) (new-sym?$2100 random-sym-to-match$2099 (let$2098 ((x 1)) (match-one$2095 1 (my-and$2094) (1 (set! 1)) (match-drop-ids (begin x)) (begin) (x))) (if (equal? 1 x) (match-one$2095 1 (my-and$2094) (1 (set! 1)) (match-drop-ids (begin x)) (begin) ()) (begin)))) (if (equal? 1 x) (match-one$2095 1 (my-and$2094) (1 (set! 1)) (match-drop-ids (begin x)) (begin) ()) (begin))))*/ ;/* (expand (match-check-identifier$2105 x (let-syntax ((new-sym?$2100 (syntax-rules$2104 () ((new-sym?$2100 x sk2$2102 fk2$2101) sk2$2102) ((new-sym?$2100 y$2103 sk2$2102 fk2$2101) fk2$2101)))) (new-sym?$2100 random-sym-to-match$2099 (let$2098 ((x 1)) (match-one$2095 1 (my-and$2094) (1 (set! 1)) (match-drop-ids (begin x)) (begin) (x))) (if (equal? 1 x) (match-one$2095 1 (my-and$2094) (1 (set! 1)) (match-drop-ids (begin x)) (begin) ()) (begin)))) (if (equal? 1 x) (match-one$2095 1 (my-and$2094) (1 (set! 1)) (match-drop-ids (begin x)) (begin) ()) (begin))))*/
;; Alternatively, with and the initial expansions are: ;; Alternatively, with and the initial expansions are:
; (match-two 1 (and x) (1 (set! 1)) (match-drop-ids (begin x)) (begin) ()) (match-two 1 (and x) (1 (set! 1)) (match-drop-ids (begin x)) (begin) ())
;/* (expand (match-two 1 (and x) (1 (set! 1)) (match-drop-ids (begin x)) (begin) ()))*/ ;/* (expand (match-two 1 (and x) (1 (set! 1)) (match-drop-ids (begin x)) (begin) ()))*/
;/* (expand (if (pair? 1) (let$2108 ((w$2107 (car 1)) (x$2105 (cdr 1))) (match-one$2106 w$2107 and ((car 1) (set-car! 1)) (match-one$2106 x$2105 (x) ((cdr 1) (set-cdr! 1)) (match-drop-ids (begin x)) (begin)) (begin) ())) (begin)))*/ ;/* (expand (if (pair? 1) (let$2108 ((w$2107 (car 1)) (x$2105 (cdr 1))) (match-one$2106 w$2107 and ((car 1) (set-car! 1)) (match-one$2106 x$2105 (x) ((cdr 1) (set-cdr! 1)) (match-drop-ids (begin x)) (begin)) (begin) ())) (begin)))*/
;/* (expand (pair? 1))*/ ;/* (expand (pair? 1))*/