Changeset 34425 in project


Ignore:
Timestamp:
08/27/17 21:42:45 (4 weeks ago)
Author:
kon
Message:

add range

Location:
release/4/check-errors/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/4/check-errors/trunk/tests/run.scm

    r34403 r34425  
    4646  (test-error (check-half-closed-interval 'test 1.2 1.1 1.2))
    4747  (test-error (check-half-closed-interval 'test 1.3 1.1 1.2))
     48  (test-error (check-range 'test 0 -1))
    4849)
    4950
     
    8990(check-half-open-interval 'test 1.11 1.1 1.2)
    9091(check-half-closed-interval 'test 1.11 1.1 1.2)
     92(check-range 'test 0 1)
    9193
    9294(define-syntax capture-error
  • release/4/check-errors/trunk/type-checks.scm

    r34403 r34425  
    4747  check-closed-interval check-open-interval
    4848  check-half-closed-interval check-half-open-interval
     49  check-range
    4950  ;
    5051  check-cardinal-fixnum
     
    6061;;
    6162
    62 ; maybe a problem with expansion environment namespace pollution
     63;maybe a problem with expansion environment namespace pollution
    6364(define-for-syntax (symbolize . elts)
    6465  (string->symbol (apply conc (map strip-syntax elts))) )
     
    7879              `(,_define (,nam loc obj . _) obj) ) ) ) ) )
    7980
    80     ;; Backwards
     81    ;;Backwards
    8182    (define (check-cardinal-fixnum loc obj . _) obj)
    8283    (define (check-cardinal-integer loc obj . _) obj)
     
    107108  (else
    108109
    109     ;; These are weak predicates. Only check for structure.
     110    ;;These are weak predicates. Only check for structure.
    110111
    111112    (export alist? plist?)
     
    127128    ;;
    128129
    129     ; <symbol>          : <pred> is '<symbol>?'
    130     ; <symbol> <symbol> : <pred> is <symbol>
    131     ; ->
    132     ; (define (check-<symbol> loc obj . args)
    133     ;   (unless (<pred> obj)
    134     ;     (error-<symbol> loc obj (optional args)))
    135     ;   obj )
     130    ;<symbol>          : <pred> is '<symbol>?'
     131    ;<symbol> <symbol> : <pred> is <symbol>
     132    ;->
     133    ;(define (check-<symbol> loc obj . args)
     134    ;  (unless (<pred> obj)
     135    ;    (error-<symbol> loc obj (optional args)))
     136    ;  obj )
    136137
    137138    (define-syntax define-check-type
     
    152153                 obj ) ) ) ) ) )
    153154
    154     ;; Is the object non-void?
     155    ;;Is the object non-void?
    155156
    156157    (define (defined-value? obj) (not (eq? (void) obj)))
    157158
    158     ;; Is the object bound to value?
    159 
    160     ; is obj the value from the de-ref of an unbound variable.
    161     ; could only occur in a rather unsafe calling environnment.
     159    ;;Is the object bound to value?
     160
     161    ;is obj the value from the de-ref of an unbound variable.
     162    ;could only occur in a rather unsafe calling environnment.
    162163
    163164    (define (bound-value? obj) (##core#inline "C_unboundvaluep" obj))
     
    276277(define-check-type alist)
    277278
    278 ; closed interval
     279;closed interval
    279280(define (check-closed-interval loc num min max . args)
    280281  (unless (and (<= min num) (<= num max))
     
    282283  num )
    283284
    284 ; open interval
     285;open interval
    285286(define (check-open-interval loc num min max . args)
    286287  (unless (and (< min num) (< num max))
     
    288289  num )
    289290
    290 ; closed+open interval
     291;closed+open interval
    291292(define (check-half-open-interval loc num min max . args)
    292293  (unless (and (< min num) (<= num max))
     
    294295  num )
    295296
    296 ; open+closed interval
     297;open+closed interval
    297298(define (check-half-closed-interval loc num min max . args)
    298299  (unless (and (<= min num) (< num max))
     
    300301  num)
    301302
     303;check half-closed-interval itself
     304(define (check-range loc start end . args)
     305  (unless (<= start end)
     306    (apply error-range loc start end args) )
     307  (void) )
     308
    302309(define (check-minimum-argument-count loc argc minargc)
    303310  (unless (fx<= minargc argc)
     
    312319;;
    313320
    314 ; <type-symbol> [<type-predicate> [<message-string>]]
     321;<type-symbol> [<type-predicate> [<message-string>]]
    315322
    316323(define-syntax define-check+error-type
  • release/4/check-errors/trunk/type-errors.scm

    r34403 r34425  
    1616
    1717(;export
     18  ;
    1819  make-bad-argument-message
    1920  make-type-name-message
    2021  make-error-type-message
    21   signal-type-error
     22  ;
     23  signal-bounds-error signal-type-error
     24  ;
    2225  error-argument-type
    2326  warning-argument-type
    2427  (define-error-type error-argument-type)
     28  ;
    2529  error-bound-value
    2630  error-defined-value
     
    5660  error-minimum-argument-count
    5761  error-argument-count
     62  error-range
    5863  error-interval
    5964  error-closed-interval error-open-interval
    6065  error-half-open-interval error-half-closed-interval
    61   ;
     66  ;DEPRECATED
    6267  error-cardinal-fixnum
    6368  error-cardinal-integer
     
    8287
    8388(define (->boolean obj)
    84   (and
    85     obj
    86     #t ) )
     89  (and obj #t ) )
    8790
    8891;(maybe a problem with expansion environment namespace pollution)
     
    110113;;
    111114
    112 (define (signal-type-error loc msg . objs)
    113   (apply ##sys#signal-hook #:type-error loc msg objs) )
     115(define (signal-bounds-error loc . objs)
     116  (apply ##sys#signal-hook #:bounds-error loc objs) )
     117
     118(define (signal-type-error loc . objs)
     119  (apply ##sys#signal-hook #:type-error loc objs) )
    114120
    115121;;
     
    211217        (*error-structure loc obj "record-type" tag argnam) )
    212218
     219(define (error-range loc start end #!optional argnam)
     220  (signal-bounds-error loc
     221    (make-bad-argument-message argnam)
     222    start end) )
     223
    213224(define (error-interval loc num lft min max rgt #!optional argnam)
    214   (##sys#signal-hook #:bounds-error loc
     225  (signal-bounds-error loc
    215226    (conc (make-bad-argument-message argnam) " must be in " lft min #\space max rgt)
    216227    num) )
Note: See TracChangeset for help on using the changeset viewer.