1#lang racket/base 2 3(provide all-match-tests) 4 5(require rackunit 6 deinprogramm/DMdA/define-record-procedures 7 (only-in deinprogramm/DMdA/private/primitives match empty make-pair)) 8 9(define-record-procedures pare 10 kons pare? 11 (kar kdr)) 12 13(define-record-procedures bare 14 gons bare? 15 (gar gdr)) 16 17(define-record-procedures nullary 18 make-nullary nullary? 19 ()) 20 21(define all-match-tests 22 (test-suite 23 "Tests for DeinProgramm match form." 24 25 (test-case 26 "literals" 27 (define foo 28 (lambda (x) 29 (match x 30 (#t 'true) 31 (#f 'false) 32 ('() 'nil) 33 ('(foo bar) 'foobar) 34 ("foo" 'foo) 35 ("bar" 'bar) 36 (5 'five) 37 (2 'two)))) 38 39 (check-equal? (foo #t) 'true) 40 (check-equal? (foo #f) 'false) 41 (check-equal? (foo '()) 'nil) 42 (check-equal? (foo '(foo bar)) 'foobar) 43 (check-equal? (foo "foo") 'foo) 44 (check-equal? (foo "bar") 'bar) 45 (check-equal? (foo 5) 'five) 46 (check-equal? (foo 2) 'two)) 47 48 49 (test-case 50 "variables" 51 (define foo 52 (lambda (x) 53 (match x 54 (#t 'true) 55 (foo (list 'foo foo))))) 56 (check-equal? (foo #t) 'true) 57 (check-equal? (foo "foo") '(foo "foo"))) 58 59 (test-case 60 "lists" 61 (define foo 62 (lambda (x) 63 (match x 64 (empty 'empty) 65 ((make-pair 'foo empty) 'fooempty) 66 ((list 'foo 'bar) 'listfoobar) 67 ((list 'bar 'foo) 'listbarfoo) 68 ((list a b c) (list 'list a b c)) 69 ((make-pair 5 b) (list 'make-pair5 b)) 70 ((make-pair a (make-pair b c)) (list 'make-pair a b c)) 71 ((make-pair a b) (list 'make-pair a b)) 72 (x (list 'x x))))) 73 74 (check-equal? (foo empty) 'empty) 75 (check-equal? (foo "empty") '(x "empty")) 76 (check-equal? (foo (list 1 2 3)) '(list 1 2 3)) 77 (check-equal? (foo (make-pair 'foo empty)) 'fooempty) 78 (check-equal? (foo (make-pair 1 empty)) '(make-pair 1 ())) 79 (check-equal? (foo (make-pair 5 empty)) '(make-pair5 ())) 80 (check-equal? (foo (list 1 2)) '(make-pair 1 2 ())) 81 (check-equal? (match empty ((list) 'bingo)) 'bingo) 82 (check-equal? (match (list 1) ((list) 'bingo) (foo foo)) (list 1)) 83 (check-equal? (foo (list 'foo 'bar)) 'listfoobar) 84 (check-equal? (foo (list 'bar 'foo)) 'listbarfoo)) 85 86 (test-case 87 "anything" 88 (check-equal? (match 5 (_ 7)) 7) 89 (check-equal? (match '(1 2) (_ 7)) 7) 90 (check-equal? (match #f (_ 7)) 7) 91 (check-equal? (let ((_ 5)) (match #f (_ _))) 5) 92 (check-equal? (match #f 93 ((kons _ _) 7) 94 (_ 5)) 95 5) 96 (check-equal? (match (kons 1 2) 97 ((kons _ _) 7) 98 (_ 5)) 99 7)) 100 101 (test-case 102 "records" 103 (define foo 104 (lambda (x) 105 (match x 106 ((make-pair foo empty) 'pairfoo) 107 ((make-nullary) 'nullary) 108 ((kons a b) (list 'kons a b)) 109 ((gons a b) (list 'gons a b))))) 110 111 (check-equal? (foo (make-pair foo empty)) 'pairfoo) 112 (check-equal? (foo (make-nullary)) 'nullary) 113 (check-equal? (foo (kons 1 2)) '(kons 1 2)) 114 (check-equal? (foo (gons 1 2)) '(gons 1 2))))) 115