Changeset 31306 in project


Ignore:
Timestamp:
08/29/14 18:15:40 (5 years ago)
Author:
Kon Lovett
Message:

exn message property must always have a value

Location:
release/4/condition-utils
Files:
4 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/4/condition-utils/tags/1.0.4/condition-utils.scm

    r31298 r31306  
    11;;;; condition-utils.scm
     2;;;; Kon Lovett, Aug '14
    23;;;; Kon Lovett, Jun '13
    34;;;; Kon Lovett, Aug '10
     
    7273      (apply make-composite-condition ls) ) ) )
    7374
    74 ;;
     75;; memeoized condition-predicate ctor
    7576
    7677(define condition-predicate*
     
    8485              pred ) ) ) ) ) )
    8586
    86 ;;
     87;; create composite condition-predicate
    8788
     89;should this be a procedure?
    8890(define-syntax make-condition-predicate
    8991  (syntax-rules ()
     
    9193      (lambda (obj) (and ((condition-predicate* '?kind0) obj) ...) ) ) ) )
    9294
    93 ;;
     95;; memeoized condition-property-accessor ctor
    9496
    9597(define condition-property-accessor*
     
    105107              getter ) ) ) ) ) )
    106108
    107 ;;
     109;; create condition-property-accessor w/ "default" default
    108110
     111;should this be a procedure?
    109112(define-syntax make-condition-property-accessor
    110113  (syntax-rules ()
     
    120123;;
    121124
    122 (define (make-exn-condition #!optional (loc #f) (msg #f) (args #f) (calls #f))
     125(define (make-exn-condition #!optional (loc #f) (msg "unknown") (args #f) (calls #f))
     126  (define (incl tag val) (if val `(,tag ,val) '()) )
    123127  (apply make-property-condition 'exn
    124128    (append!
    125       (list 'location loc)
    126       (list 'message (or msg ""))
    127       (list 'arguments (or args '()))
    128       (if calls (list 'call-chain calls) '()))) )
     129      (incl 'location loc)
     130      `(message ,(or msg "unknown"))
     131      (incl 'arguments args)
     132      (incl 'call-chain calls))) )
    129133
    130134;;
     
    140144                  (car cnds))))
    141145    (apply make-composite-condition
    142            (apply make-exn-condition loc msg args (or chn '()))
     146           (make-exn-condition loc msg args chn)
    143147           (expand-property-conditions (if chn (cdr cnds) cnds))) ) )
    144148
  • release/4/condition-utils/tags/1.0.4/condition-utils.setup

    r31298 r31306  
    55(verify-extension-name "condition-utils")
    66
    7 (setup-shared-extension-module 'condition-utils (extension-version "1.0.3")
     7(setup-shared-extension-module 'condition-utils (extension-version "1.0.4")
    88  #:inline? #t
    99  #:types? #t
     
    1414    -no-procedure-checks))
    1515
    16 (setup-shared-extension-module 'standard-conditions (extension-version "1.0.3")
     16(setup-shared-extension-module 'standard-conditions (extension-version "1.0.4")
    1717  #:inline? #t
    1818  #:types? #t
     
    2323    -no-procedure-checks))
    2424
    25 (setup-shared-extension-module 'http-client-conditions (extension-version "1.0.3")
     25(setup-shared-extension-module 'http-client-conditions (extension-version "1.0.4")
    2626  #:inline? #t
    2727  #:types? #t
     
    3232    -no-procedure-checks))
    3333
    34 (setup-shared-extension-module 'intarweb-conditions (extension-version "1.0.3")
     34(setup-shared-extension-module 'intarweb-conditions (extension-version "1.0.4")
    3535  #:inline? #t
    3636  #:types? #t
  • release/4/condition-utils/trunk/condition-utils.scm

    r31298 r31306  
    11;;;; condition-utils.scm
     2;;;; Kon Lovett, Aug '14
    23;;;; Kon Lovett, Jun '13
    34;;;; Kon Lovett, Aug '10
     
    7273      (apply make-composite-condition ls) ) ) )
    7374
    74 ;;
     75;; memeoized condition-predicate ctor
    7576
    7677(define condition-predicate*
     
    8485              pred ) ) ) ) ) )
    8586
    86 ;;
     87;; create composite condition-predicate
    8788
     89;should this be a procedure?
    8890(define-syntax make-condition-predicate
    8991  (syntax-rules ()
     
    9193      (lambda (obj) (and ((condition-predicate* '?kind0) obj) ...) ) ) ) )
    9294
    93 ;;
     95;; memeoized condition-property-accessor ctor
    9496
    9597(define condition-property-accessor*
     
    105107              getter ) ) ) ) ) )
    106108
    107 ;;
     109;; create condition-property-accessor w/ "default" default
    108110
     111;should this be a procedure?
    109112(define-syntax make-condition-property-accessor
    110113  (syntax-rules ()
     
    120123;;
    121124
    122 (define (make-exn-condition #!optional (loc #f) (msg #f) (args #f) (calls #f))
     125(define (make-exn-condition #!optional (loc #f) (msg "unknown") (args #f) (calls #f))
     126  (define (incl tag val) (if val `(,tag ,val) '()) )
    123127  (apply make-property-condition 'exn
    124128    (append!
    125       (list 'location loc)
    126       (list 'message (or msg ""))
    127       (list 'arguments (or args '()))
    128       (if calls (list 'call-chain calls) '()))) )
     129      (incl 'location loc)
     130      `(message ,(or msg "unknown"))
     131      (incl 'arguments args)
     132      (incl 'call-chain calls))) )
    129133
    130134;;
     
    140144                  (car cnds))))
    141145    (apply make-composite-condition
    142            (apply make-exn-condition loc msg args (or chn '()))
     146           (make-exn-condition loc msg args chn)
    143147           (expand-property-conditions (if chn (cdr cnds) cnds))) ) )
    144148
  • release/4/condition-utils/trunk/condition-utils.setup

    r31298 r31306  
    55(verify-extension-name "condition-utils")
    66
    7 (setup-shared-extension-module 'condition-utils (extension-version "1.0.3")
     7(setup-shared-extension-module 'condition-utils (extension-version "1.0.4")
    88  #:inline? #t
    99  #:types? #t
     
    1414    -no-procedure-checks))
    1515
    16 (setup-shared-extension-module 'standard-conditions (extension-version "1.0.3")
     16(setup-shared-extension-module 'standard-conditions (extension-version "1.0.4")
    1717  #:inline? #t
    1818  #:types? #t
     
    2323    -no-procedure-checks))
    2424
    25 (setup-shared-extension-module 'http-client-conditions (extension-version "1.0.3")
     25(setup-shared-extension-module 'http-client-conditions (extension-version "1.0.4")
    2626  #:inline? #t
    2727  #:types? #t
     
    3232    -no-procedure-checks))
    3333
    34 (setup-shared-extension-module 'intarweb-conditions (extension-version "1.0.3")
     34(setup-shared-extension-module 'intarweb-conditions (extension-version "1.0.4")
    3535  #:inline? #t
    3636  #:types? #t
Note: See TracChangeset for help on using the changeset viewer.