suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

started a test suite, PR 9545

Browse Source 
svn: r10451
This commit is contained in:
Robby Findler 2008-06-25 14:31:02 +00:00
parent 17ab6f6345
commit 2528523a1f
2 changed files with 49 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
collects/planet/private/planet-shared.ss
View File

@ -247,7 +247,7 @@ Various common pieces of code that both the client and server need to access
(define (make-assoc-table-row name path maj min dir required-version type)
(list name path maj min dir required-version type))
(define-struct mz-version (major minor))
(define-struct mz-version (major minor) #:inspector #f)
;; string->mz-version : string -> mz-version | #f
@ -280,14 +280,16 @@ Various common pieces of code that both the client and server need to access
(lambda (ver)
(cond [(list-ref ver 3)
(let* ([chunks (regexp-split #rx"\\." (list-ref ver 3))])
(make-mz-version (+ (* (string->number (list-ref ver 1))
100)
(if (> (length chunks) 0)
(string->number (car chunks))
0))
(if (> (length (cdr chunks)) 0)
(minor+maint-chunks->minor (cdr chunks))
0)))]
(and (andmap (λ (x) (not (equal? x ""))) chunks)
(make-mz-version (+ (* (string->number (list-ref ver 1))
100)
(if (> (length chunks) 0)
(begin
(string->number (car chunks)))
0))
(if (> (length (cdr chunks)) 0)
(minor+maint-chunks->minor (cdr chunks))
0))))]
[else
(make-mz-version (* (string->number (list-ref ver 1))
100)

38
collects/planet/private/test.ss Normal file
View File

@ -0,0 +1,38 @@
#lang scheme
(require "planet-shared.ss")
(define-syntax (test stx)
(syntax-case stx ()
[(_ a b)
(with-syntax ([line (syntax-line stx)]
[file (let ([s (syntax-source stx)])
(if (string? s)
s
"<<unknown file>>"))])
#`(test/proc file line a b))]))
(define (test/proc file line got expected)
(unless (equal? got expected)
(error 'test.ss "FAILED ~a: ~s\n got ~s\nexpected ~s" file line got expected)))
(test (string->mz-version "372")
(make-mz-version 372 0))
(test (string->mz-version "372.2")
(make-mz-version 372 2000))
(test (string->mz-version "4.0")
(make-mz-version 400 0))
(test (string->mz-version "4.1")
(make-mz-version 401 0))
(test (string->mz-version "4.0.1")
(make-mz-version 400 1000))
(test (string->mz-version "4..1")
#f)
(printf "tests passed\n")