Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-07-12 23:37:38 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Record type fixes

Browse source
This commit is contained in:
Justin Ethier 2018-01-31 19:09:01 -05:00
parent aafe5f0d68
commit f3d2cd8176
2 changed files with 23 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
test-record-types.scm
View file

@ -20,4 +20,11 @@
;; Why is name false after this, instead of 'employee?? ;; Why is name false after this, instead of 'employee??
(newline)(display ((make-constructor "make-employee" employee))) (newline)(display ((make-constructor "make-employee" employee)))
(newline)(display employee) (newline)(display employee)
(newline)(display (is-a? e employee))
(newline)(display (is-a? e employee2))
) )
(define (is-a? obj rtype)
(and (record? obj)
(record? rtype)
(equal? (vector-ref obj 1) rtype)))

23
tests/match-tests.scm
View file

@ -79,7 +79,7 @@
;;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... ;;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 ;; 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 (match 1 ((or x 2) x)) )(newline)
#;(display (display
(let () (let ()
(define-record-type employee (define-record-type employee
(make-employee name title) (make-employee name title)
@ -90,7 +90,19 @@
(($ employee n t) (list t n)))) (($ employee n t) (list t n))))
) )
#;(test-group ;; 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 3) ((a b c) b)) )
@ -132,9 +144,7 @@
(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)) )
;; TODO: Fails on cyclone but passes on chibi (test '("Doctor" "Bob")
;; expect '("Doctor" "Bob")
#;(display
(let () (let ()
(define-record-type employee (define-record-type employee
(make-employee name title) (make-employee name title)
@ -142,8 +152,7 @@
(name get-name) (name get-name)
(title get-title)) (title get-title))
(match (make-employee "Bob" "Doctor") (match (make-employee "Bob" "Doctor")
(($ employee n t) (list t n)))) (($ employee n t) (list t n)))))
)
(test '(1 . 3) (let ((x (cons 1 2))) (match x ((1 . (set! s)) (s 3) x)))) (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 2 (match '(1 . 2) ((1 . (get! g)) (g))))