forked from schwers-zz/RedRacket
-
Notifications
You must be signed in to change notification settings - Fork 0
/
retest.rkt
121 lines (93 loc) · 4.24 KB
/
retest.rkt
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
;; Test Suite and test DFA's
(module retest racket
(require "red.rkt"
"tester.rkt"
racket/unsafe/ops
(for-syntax "red.rkt"
racket
racket/unsafe/ops))
(provide (all-defined-out))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; .*[email protected].*
(define-for-syntax *email*-stx
(dfa-expand
(build-test-dfa
'((concatenation (repetition 0 +inf.0 (char-complement))
#\s #\c #\h #\w #\e #\r #\s #\. #\r
#\@ #\g #\m #\a #\i #\l #\. #\c #\o #\m
(repetition 0 +inf.0 (char-complement)))))))
(define-syntax (bench-*email* stx)
(syntax-case stx ()
[(_) *email*-stx]))
(define *email* (bench-*email*))
(define (as n) (build-by-twos "a" n))
(define email "[email protected]")
(define (aemaila n) (let ((s (as n))) (string-append s email s)))
(define *email*-desc ".*[email protected].*")
(define (*email*-regex str) (regexp-match? #rx"[email protected]" str))
(test *email* *email*-regex aemaila *email*-desc #t)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; a* , (a+)
(define-for-syntax a*-only-stx
(dfa-expand (build-test-dfa '((repetition 0 +inf.0 #\a)))))
(define-syntax (bench-a*-only stx)
(syntax-case stx ()
[(_) a*-only-stx]))
(define a*-only (bench-a*-only))
(define (a*-regex str) (regexp-match? #rx"a*" str))
(test a*-only a*-regex as "a* -- should pass" #t)
(define-for-syntax a+paren-stx
(dfa-expand (build-test-dfa '((concatenation #\( (repetition 1 +inf.0 #\a) #\))))))
(define-syntax (bench-a+paren stx)
(syntax-case stx ()
[(_) a+paren-stx]))
(define (a+paren-regx str) (regexp-match? #rx"\\(a+\\)" str))
(define a+paren (bench-a+paren))
(define (a+paren-str n) (let ((s (build-by-twos "a" n))) (string-append "(" s ")")))
(test a+paren a+paren-regx a+paren-str "(a+) -- should pass" #t)
(define (a+paren-fail n) (let ((s (build-by-twos "a" n))) (string-append "(" s "Z)")))
(test a+paren a+paren-regx a+paren-fail "(a+) -- should fail" #f)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; validating email
(define-for-syntax valid-email-stx
(dfa-expand
(build-test-dfa
'((concatenation (repetition 1 +inf.0 (union (char-range #\a #\z)
(char-range #\0 #\9)
#\. #\_ #\% #\+ #\-))
#\@
(repetition 1 +inf.0 (union (char-range #\a #\z)
(char-range #\0 #\9)
#\. #\-))
(repetition 2 4 (char-range #\a #\z)))))))
(define-syntax (bench-valid-email stx)
(syntax-case stx ()
[(_) valid-email-stx]))
(define valid-email (bench-valid-email))
(define em1 (lambda (n) "[email protected]"))
(define em2 "this.is.a.test.right.")
(define (email-str n) (let ((s (build-by-twos em2 n))) (string-append s "@yup.com")))
(define (email-regex str)
(regexp-match? #rx"[a-z0-9\\.\\_\\%\\+\\-]+@[a-z0-9\\.\\-]+\\.([a-z][a-z]|[a-z][a-z][a-z]|[a-z][a-z][a-z][a-z])"
str))
(define email-desc "validate email test, should match")
(test valid-email email-regex email-str "validate email -- should pass" #t)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; web address
(define-for-syntax *web-stx*
(dfa-expand
(build-test-dfa
'((concatenation
#\w #\w #\w #\.
(repetition 1 +inf.0 (char-range #\a #\z))
#\.
(repetition 2 4 (char-range #\a #\z)))))))
(define-syntax (bench-web stx)
(syntax-case stx ()
[(_) *web-stx*]))
(define web (bench-web))
(define (webfiller n) (string-append "www." (build-by-twos "lambdafxxfxoiasdf" n) ".com"))
(define (web-regex str) (regexp-match? #rx"^www\\.[a-z]+\\.([a-z][a-z]|[a-z][a-z]|[a-z][a-z][a-z][a-z])" str))
(test web web-regex webfiller "website url -- should pass" #t)
(log-to "red-10_4_11_11.csv")
)