72 lines
		
	
	
		
			2.3 KiB
		
	
	
	
		
			Scheme
		
	
	
	
			
		
		
	
	
			72 lines
		
	
	
		
			2.3 KiB
		
	
	
	
		
			Scheme
		
	
	
	
(define-record-type <foo> (foo bar) foo? (bar foo-bar))
 | 
						|
 | 
						|
(define (run-tests/implementation-specific)
 | 
						|
    (define (foo-lookup obj name found not-found)
 | 
						|
      (cond
 | 
						|
        ((not (foo? obj)) (not-found))
 | 
						|
        ((string=? "bar" name) (found (foo-bar obj)))
 | 
						|
        (else (not-found))))
 | 
						|
 | 
						|
    (define alist+foo (compose-lookups alist-lookup foo-lookup))
 | 
						|
 | 
						|
    (define (write-foo obj out)
 | 
						|
      (write-string "(foo " out)
 | 
						|
      (display (foo-bar obj) out)
 | 
						|
      (write-string ")" out))
 | 
						|
 | 
						|
    (define-record-type <num-lst> (num-lst count) num-lst? (count num-lst-count))
 | 
						|
    (define num-lst-collection
 | 
						|
      (collection
 | 
						|
        num-lst?
 | 
						|
        (lambda (obj) (= 0 (num-lst-count obj)))
 | 
						|
        (lambda (proc obj)
 | 
						|
          (define target (num-lst-count obj))
 | 
						|
          (let loop ((i 0))
 | 
						|
           (when (< i target)
 | 
						|
             (begin
 | 
						|
               (proc i)
 | 
						|
               (loop (+ 1 i))))))))
 | 
						|
 | 
						|
    (parameterize
 | 
						|
      ((current-writer (lambda (obj out)
 | 
						|
                         (cond
 | 
						|
                           ((not obj) #t)
 | 
						|
                           ((foo? obj) (write-foo obj out))
 | 
						|
                           (else (display obj out))))))
 | 
						|
      (test-mustache "Custom writer"
 | 
						|
                     `((obj . ,(foo "baz")))
 | 
						|
                     "Test {{obj}}"
 | 
						|
                     "Test (foo baz)"))
 | 
						|
 | 
						|
    (parameterize
 | 
						|
      ((current-lookup alist+foo))
 | 
						|
      (test-mustache "Custom lookup"
 | 
						|
                     `((a . ((bar . "baz1")))
 | 
						|
                       (b . ,(foo "baz2")))
 | 
						|
                     "{{a.bar}}, {{b.bar}}"
 | 
						|
                     "baz1, baz2"))
 | 
						|
 | 
						|
    (parameterize
 | 
						|
      ((current-collection num-lst-collection))
 | 
						|
      (test-mustache "Custom collection"
 | 
						|
                     `((a . ,(num-lst 3)))
 | 
						|
                     "{{#a}}{{.}};{{/a}}"
 | 
						|
                     "0;1;2;"))
 | 
						|
 | 
						|
    (parameterize
 | 
						|
      ((current-collection list-collection)
 | 
						|
       (current-lookup foo-lookup))
 | 
						|
      (test-mustache "List collection"
 | 
						|
                     (foo '(0 1 2))
 | 
						|
                     "{{#bar}}{{.}};{{/bar}}"
 | 
						|
                     "0;1;2;"))
 | 
						|
 | 
						|
    (parameterize
 | 
						|
      ((current-collection stream-collection)
 | 
						|
       (current-lookup foo-lookup))
 | 
						|
      (test-mustache "Stream collection"
 | 
						|
                     (foo (list->stream '(0 1 2)))
 | 
						|
                     "{{#bar}}{{.}};{{/bar}}"
 | 
						|
                     "0;1;2;")))
 | 
						|
 |