From 8cc2e27ca7b777725d9a83298ea260257f3d22bf Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Sat, 28 Nov 2015 16:25:21 -0600 Subject: [PATCH] improve error checking in version/utils closes #1152 --- pkgs/racket-doc/version/version.scrbl | 8 +- racket/collects/version/utils.rkt | 110 +++++++++++++++++++++++--- 2 files changed, 104 insertions(+), 14 deletions(-) diff --git a/pkgs/racket-doc/version/version.scrbl b/pkgs/racket-doc/version/version.scrbl index 112d108235..e6c7f05eab 100644 --- a/pkgs/racket-doc/version/version.scrbl +++ b/pkgs/racket-doc/version/version.scrbl @@ -76,12 +76,12 @@ indicates the current state of the curent installation: utilities for dealing with version strings. Unless explicitly noted, these functions do not handle legacy versions of Racket.} -@defproc[(valid-version? [str string?]) boolean?]{ - Returns @racket[#t] if @racket[str] is a valid Racket version +@defproc[(valid-version? [v any/c]) boolean?]{ + Returns @racket[#t] if @racket[v] is a valid Racket version string, @racket[#f] otherwise.} @defproc[(version->list [str valid-version?]) - (list integer? integer? integer? integer?)]{ + (list/c integer? integer? integer? integer?)]{ Returns a list of four numbers that the given version string represent. @racket[str] is assumed to be a valid version.} @@ -99,7 +99,7 @@ indicates the current state of the curent installation: Returns @racket[#t] if the version that @racket[str] represents is an alpha version. @racket[str] is assumed to be a valid version.} -@defproc[(version->integer [str string?]) (or/c integer? false/c)]{ +@defproc[(version->integer [str string?]) (or/c integer? #f)]{ Converts the version string into an integer. For version @racket["X.YY.ZZZ.WWW"], the result will be @racketvalfont{XYYZZZWWW}. This function works also for legacy Racket versions, by diff --git a/racket/collects/version/utils.rkt b/racket/collects/version/utils.rkt index 001e2e2b68..9b702785d8 100644 --- a/racket/collects/version/utils.rkt +++ b/racket/collects/version/utils.rkt @@ -1,7 +1,5 @@ #lang racket/base - -(provide valid-version? version->list versioninteger) +(require (for-syntax racket/base)) (define rx:version ;; (this restricts the last component to be below 999 too, which is @@ -13,10 +11,21 @@ (define (valid-version? s) (and (string? s) (regexp-match? rx:version s))) -;; the following functions assume valid version string inputs +(define-syntax (define/version-inputs stx) + (syntax-case stx () + [(_ (f x ...) body ...) + #'(define (f x ...) + (check-version-inputs 'f (list x ...)) + body ...)])) +(define (check-version-inputs fn args) + (for ([arg (in-list args)] + [i (in-naturals)]) + (unless (valid-version? arg) + (apply raise-argument-error fn "valid-version?" i args)))) + ;; returns a list of 4 integers (see src/racket/src/schvers.h) -(define (version->list str) +(define/version-inputs (version->list str) (define ver (map string->number (regexp-split #rx"[.]" str))) (case (length ver) [(2) (append ver '(0 0))] @@ -24,17 +33,20 @@ [(4) ver] [else (error 'version->list "bad version: ~e" str)])) -(define (versionlist a)] [b (version->list b)]) (cond [(null? a) #f] [(< (car a) (car b)) #t] [(> (car a) (car b)) #f] [else (loop (cdr a) (cdr b))]))) -(define (version<=? a b) - (or (equal? a b) (versionlist v)) (or ((list-ref l 1) . >= . 90) ((list-ref l 2) . >= . 900) @@ -69,3 +81,81 @@ (and v (valid-version? v) (foldl (λ (ver mul acc) (+ ver (* mul acc))) 0 (version->list v) '(0 100 1000 1000)))) + +(define-syntax-rule + (provide+save-in-list exported-functions (x p?) ...) + (begin + (provide x ...) + (module+ test (define exported-functions (list (cons x p?) ...))))) + +(provide+save-in-list + exported-functions + (valid-version? boolean?) + (version->list (λ (x) (and (list? x) (= (length x) 4) (andmap integer? x)))) + (versioninteger (λ (x) (or (integer? x) (not x))))) + +(module+ test + (require racket/list) + + (define (random-argument) + (case (random 10) + [(1) + ;; random string of digits, periods lowercase letters, and greek letters + (define candidates + (append (build-list 10 (λ (x) (integer->char (+ x (char->integer #\a))))) + (build-list 10 (λ (x) (integer->char (+ x (char->integer #\0))))) + (build-list 10 (λ (x) (integer->char (+ x (char->integer #\α))))) + '(#\.))) + (apply + string + (for/list ([i (in-range (random 100))]) + (list-ref candidates (random (length candidates)))))] + [(0) + ;; kind of versionish (periods and digits in 100 chars) + (apply + string + (for/list ([i (in-range (random 100))]) + (case (random 4) + [(0) #\.] + [else (integer->char (+ (random 10) (char->integer #\0)))])))] + [else + ;; much closer to a version; + ;; at most 6 fields of digits that are + ;; between 1 and 4 chars in length + (apply + string-append + (add-between + (for/list ([i (in-range (+ 1 (random 5)))]) + (apply + string + (for/list ([i (in-range (random 4))]) + (integer->char (+ (random 10) (char->integer #\0)))))) + "."))])) + + (define (trial f+p) + (define f (car f+p)) + (define p (cdr f+p)) + (define args (for/list ([i (in-range (procedure-arity f))]) + (random-argument))) + (define (check-exn exn) + (define m (regexp-match #rx"^([^:]*):" (exn-message exn))) + (if (equal? (string->symbol (list-ref m 1)) + (object-name f)) + #f + args)) + (with-handlers ([exn:fail? check-exn]) + (if (p (apply f args)) + #f + args))) + + (time + (let/ec give-up + (for ([f+p (in-list exported-functions)]) + (for ([_ (in-range 100)]) + (define trial-result (trial f+p)) + (when trial-result + (eprintf "failed: ~s\n" (cons (object-name (car f+p)) trial-result)) + (give-up)))))))