* use version/utils instead of a private copy of the same code
* removed planet/private/test.ss which was testing that code * changed angle brackets used in syntax renderings (got lumped in this commit by mistake) svn: r10759
This commit is contained in:
parent
e4d9cfb557
commit
91eb4687da
|
@ -9,6 +9,7 @@ Various common pieces of code that both the client and server need to access
|
|||
scheme/path
|
||||
scheme/port
|
||||
scheme/list
|
||||
version/utils
|
||||
"../config.ss"
|
||||
"data.ss")
|
||||
|
||||
|
@ -254,50 +255,12 @@ Various common pieces of code that both the client and server need to access
|
|||
;; Converts a string into mz-version. We need to account
|
||||
;; for the change in numbering style from the 372 era to the 4.0 era.
|
||||
(define (string->mz-version str)
|
||||
(define (minor+maint-chunks->minor chunks)
|
||||
(+ (* (string->number (car chunks)) 1000)
|
||||
(if (> (length chunks) 1)
|
||||
(string->number (cadr chunks))
|
||||
0)))
|
||||
|
||||
(cond
|
||||
;; Old style numbering with three digits in front. The first digit
|
||||
;; goes up to three.
|
||||
[(regexp-match #rx"^([0-3][0-9][0-9])\\.?([.0-9]*)$" str)
|
||||
=>
|
||||
(lambda (ver)
|
||||
(let ([major (string->number (list-ref ver 1))])
|
||||
(cond
|
||||
[(= (string-length (list-ref ver 2)) 0)
|
||||
(make-mz-version major 0)]
|
||||
[else
|
||||
(let* ([minor+maint (regexp-split #rx"\\." (list-ref ver 2))]
|
||||
[minor (minor+maint-chunks->minor minor+maint)])
|
||||
(make-mz-version major minor))])))]
|
||||
;; New style numbering
|
||||
[(regexp-match #rx"^([0-9]+)(\\.([.0-9]+))?$" str)
|
||||
=>
|
||||
(lambda (ver)
|
||||
(cond [(list-ref ver 3)
|
||||
(let* ([chunks (regexp-split #rx"\\." (list-ref ver 3))])
|
||||
(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)
|
||||
0)]))]
|
||||
(cond [(version->integer str)
|
||||
=> (lambda (v)
|
||||
(let-values ([(q r) (quotient/remainder v 1000000)])
|
||||
(make-mz-version q r)))]
|
||||
[else #f]))
|
||||
|
||||
|
||||
|
||||
;; version<= : mz-version mz-version -> boolean
|
||||
;; determines if a is the version string of an earlier mzscheme release than b
|
||||
;; [n.b. this relies on a guarantee from Matthew that mzscheme version
|
||||
|
|
|
@ -1,38 +0,0 @@
|
|||
#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")
|
|
@ -22,6 +22,8 @@
|
|||
setup/getinfo
|
||||
setup/unpack
|
||||
|
||||
version/utils
|
||||
|
||||
(prefix-in srfi1: srfi/1)
|
||||
|
||||
(for-syntax scheme/base))
|
||||
|
@ -664,8 +666,7 @@
|
|||
;; core-version : string -> boolean
|
||||
;; determines if the given string is something that (version) could've produced
|
||||
(define (core-version? s)
|
||||
(and (string? s)
|
||||
(string->mz-version s)))
|
||||
(and (version->integer s) #t))
|
||||
|
||||
;; checkinfo: syntax
|
||||
;; given an info.ss function, a failure function, and a bunch of fields to check,
|
||||
|
|
|
@ -1011,8 +1011,16 @@
|
|||
`(span ([class "mywbr"]) " "))
|
||||
(render-other (substring i (cdar m)) part ri))
|
||||
(ascii-ize i)))]
|
||||
[(eq? i 'mdash) `(" " ndash " ")]
|
||||
[(symbol? i) (list i)]
|
||||
[(symbol? i)
|
||||
(case i
|
||||
[(mdash) '(" " ndash " ")]
|
||||
;; use "single left/right-pointing angle quotation mark"
|
||||
;; -- it's not a correct choice, but works best for now
|
||||
;; (see the "Fonts with proper angle brackets"
|
||||
;; discussion on the mailing list from June 2008)
|
||||
[(lang) '(8249)]
|
||||
[(rang) '(8250)]
|
||||
[else (list i)])]
|
||||
[else (list (format "~s" i))]))
|
||||
|
||||
(define/private (ascii-ize s)
|
||||
|
|
Loading…
Reference in New Issue
Block a user